[multiple changes]

2009-04-20  Arnaud Charlet  <charlet@adacore.com>

	* switch-c.adb (Scan_Front_End_Switches): Disable front-end inlining
	in inspector mode.

2009-04-20  Javier Miranda  <miranda@adacore.com>

	* sem_ch6.adb (New_Overloaded_Entity): Minor reformating.

	* sem_ch6.ads (Subtype_Conformant, Type_Conformant): Add missing
	documentation.

	* exp_aggr.adb (Build_Record_Aggr_Code): Code cleanup.

	* sem_disp.adb
	(Check_Dispatching_Operation): Set attribute Is_Dispatching_Operation
	in internally built overriding subprograms.

2009-04-20  Doug Rupp  <rupp@adacore.com>

	* s-auxdec-vms_64.ads (Integer_{8,16,32,64}_Array): New array types.

	* s-auxdec.ads: Likewise

2009-04-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Find_Type_Name): Reject the completion of a private
	type by an interface.

	* exp_ch6.adb (Expand_Call): Inline To_Address unconditionally, to
	minimze difference in expanded tree when compiled as spec of the main
	unit, or as a spec in the context of another unit.

From-SVN: r146370

10 files changed, 190 insertions, 82 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b9463f6..447a783 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,36 @@
+2009-04-20  Arnaud Charlet  <charlet@adacore.com>
+
+	* switch-c.adb (Scan_Front_End_Switches): Disable front-end inlining
+	in inspector mode.
+
+2009-04-20  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch6.adb (New_Overloaded_Entity): Minor reformating.
+
+	* sem_ch6.ads (Subtype_Conformant, Type_Conformant): Add missing
+	documentation.
+
+	* exp_aggr.adb (Build_Record_Aggr_Code): Code cleanup.
+
+	* sem_disp.adb
+	(Check_Dispatching_Operation): Set attribute Is_Dispatching_Operation
+	in internally built overriding subprograms.
+
+2009-04-20  Doug Rupp  <rupp@adacore.com>
+
+	* s-auxdec-vms_64.ads (Integer_{8,16,32,64}_Array): New array types.
+
+	* s-auxdec.ads: Likewise
+
+2009-04-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Find_Type_Name): Reject the completion of a private
+	type by an interface.
+
+	* exp_ch6.adb (Expand_Call): Inline To_Address unconditionally, to
+	minimze difference in expanded tree when compiled as spec of the main
+	unit, or as a spec in the context of another unit.
+
 2009-04-20  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* a-calend.adb: Remove types char_Pointer, int, tm and tm_Pointer.
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index bd9fb0d..471a3ae 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -2439,12 +2439,8 @@ package body Exp_Aggr is
       --  to the actual type of the aggregate, so that the proper components
       --  are visible. We know already that the types are compatible.
 
-      --  There should also be a comment here explaining why the conversion
-      --  is needed in the case of interfaces.???
-
       if Present (Etype (Lhs))
-        and then (Is_Interface (Etype (Lhs))
-                   or else Is_Class_Wide_Type (Etype (Lhs)))
+        and then Is_Class_Wide_Type (Etype (Lhs))
       then
          Target := Unchecked_Convert_To (Typ, Lhs);
       else
@@ -2555,11 +2551,9 @@ package body Exp_Aggr is
             --  of one such.
 
             elsif Is_Limited_Type (Etype (A))
-              and then Nkind (Unqualify (A)) /= N_Function_Call --  aggregate?
-              and then
-                (Nkind (Unqualify (A)) /= N_Unchecked_Type_Conversion
-                   or else
-                 Nkind (Expression (Unqualify (A))) /= N_Function_Call)
+              and then (Nkind (Unqualify (A)) = N_Aggregate
+                          or else
+                        Nkind (Unqualify (A)) = N_Extension_Aggregate)
               and then Nkind (Unqualify (A)) /= N_Explicit_Dereference
             then
                Ancestor_Is_Expression := True;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 17332f2..82311e1 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -2891,10 +2891,26 @@ package body Exp_Ch6 is
       if Ekind (Subp) = E_Function
         or else Ekind (Subp) = E_Procedure
       then
-         --  A simple optimization: always replace calls to null procedures
-         --  with a null statement.
+         --  We perform two simple optimization on calls:
 
-         if Is_Null_Procedure (Subp)  then
+         --  a) replace calls to null procedures unconditionally,
+
+         --  b) For To_Address, just do an unchecked conversion. Not only is
+         --  this efficient, but it also avoids order of elaboration problems
+         --  when address clauses are inlined (address expression elaborated
+         --  at the wrong point).
+
+         --  We perform these optimization regardless of whether we are in the
+         --  main unit or in a unit in the context of the main unit, to ensure
+         --  that tree generated is the same in both cases, for Inspector use.
+
+         if Is_RTE (Subp, RE_To_Address) then
+            Rewrite (N,
+              Unchecked_Convert_To
+                (RTE (RE_Address), Relocate_Node (First_Actual (N))));
+            return;
+
+         elsif Is_Null_Procedure (Subp)  then
             Rewrite (N, Make_Null_Statement (Loc));
             return;
          end if;
@@ -2908,9 +2924,9 @@ package body Exp_Ch6 is
                Scop        : constant Entity_Id := Scope (Subp);
 
                function In_Unfrozen_Instance return Boolean;
-               --  If the subprogram comes from an instance in the same
-               --  unit, and the instance is not yet frozen, inlining might
-               --  trigger order-of-elaboration problems in gigi.
+               --  If the subprogram comes from an instance in the same unit,
+               --  and the instance is not yet frozen, inlining might trigger
+               --  order-of-elaboration problems in gigi.
 
                --------------------------
                -- In_Unfrozen_Instance --
@@ -2953,9 +2969,9 @@ package body Exp_Ch6 is
                then
                   Must_Inline := False;
 
-               --  If this an inherited function that returns a private
-               --  type, do not inline if the full view is an unconstrained
-               --  array, because such calls cannot be inlined.
+               --  If this an inherited function that returns a private type,
+               --  do not inline if the full view is an unconstrained array,
+               --  because such calls cannot be inlined.
 
                elsif Present (Orig_Subp)
                  and then Is_Array_Type (Etype (Orig_Subp))
@@ -3013,22 +3029,20 @@ package body Exp_Ch6 is
                     and then In_Same_Extended_Unit (Sloc (Spec), Loc)
                   then
                      Cannot_Inline
-                      ("cannot inline& (body not seen yet)?",
-                       N, Subp);
+                      ("cannot inline& (body not seen yet)?", N, Subp);
                   end if;
                end if;
             end Inlined_Subprogram;
          end if;
       end if;
 
-      --  Check for a protected subprogram. This is either an intra-object
-      --  call, or a protected function call. Protected procedure calls are
-      --  rewritten as entry calls and handled accordingly.
+      --  Check for protected subprogram. This is either an intra-object call,
+      --  or a protected function call. Protected procedure calls are rewritten
+      --  as entry calls and handled accordingly.
 
-      --  In Ada 2005, this may be an indirect call to an access parameter
-      --  that is an access_to_subprogram. In that case the anonymous type
-      --  has a scope that is a protected operation, but the call is a
-      --  regular one.
+      --  In Ada 2005, this may be an indirect call to an access parameter that
+      --  is an access_to_subprogram. In that case the anonymous type has a
+      --  scope that is a protected operation, but the call is a regular one.
 
       Scop := Scope (Subp);
 
@@ -3036,14 +3050,14 @@ package body Exp_Ch6 is
         and then Is_Protected_Type (Scop)
         and then Ekind (Subp) /= E_Subprogram_Type
       then
-         --  If the call is an internal one, it is rewritten as a call to
-         --  to the corresponding unprotected subprogram.
+         --  If the call is an internal one, it is rewritten as a call to the
+         --  corresponding unprotected subprogram.
 
          Expand_Protected_Subprogram_Call (N, Subp, Scop);
       end if;
 
-      --  Functions returning controlled objects need special attention
-      --  If the return type is limited the context is an initialization
+      --  Functions returning controlled objects need special attention:
+      --  if the return type is limited, the context is an initialization
       --  and different processing applies.
 
       if Needs_Finalization (Etype (Subp))
@@ -3053,9 +3067,9 @@ package body Exp_Ch6 is
          Expand_Ctrl_Function_Call (N);
       end if;
 
-      --  Test for First_Optional_Parameter, and if so, truncate parameter
-      --  list if there are optional parameters at the trailing end.
-      --  Note we never delete procedures for call via a pointer.
+      --  Test for First_Optional_Parameter, and if so, truncate parameter list
+      --  if there are optional parameters at the trailing end.
+      --  Note: we never delete procedures for call via a pointer.
 
       if (Ekind (Subp) = E_Procedure or else Ekind (Subp) = E_Function)
         and then Present (First_Optional_Parameter (Subp))
@@ -3064,14 +3078,14 @@ package body Exp_Ch6 is
             Last_Keep_Arg : Node_Id;
 
          begin
-            --  Last_Keep_Arg will hold the last actual that should be
-            --  retained. If it remains empty at the end, it means that
-            --  all parameters are optional.
+            --  Last_Keep_Arg will hold the last actual that should be kept.
+            --  If it remains empty at the end, it means that all parameters
+            --  are optional.
 
             Last_Keep_Arg := Empty;
 
-            --  Find first optional parameter, must be present since we
-            --  checked the validity of the parameter before setting it.
+            --  Find first optional parameter, must be present since we checked
+            --  the validity of the parameter before setting it.
 
             Formal := First_Formal (Subp);
             Actual := First_Actual (N);
@@ -3225,23 +3239,25 @@ package body Exp_Ch6 is
       Is_Unc : constant Boolean :=
                     Is_Array_Type (Etype (Subp))
                       and then not Is_Constrained (Etype (Subp));
-      --  If the type returned by the function is unconstrained and the
-      --  call can be inlined, special processing is required.
+      --  If the type returned by the function is unconstrained and the call
+      --  can be inlined, special processing is required.
 
       procedure Make_Exit_Label;
-      --  Build declaration for exit label to be used in Return statements
+      --  Build declaration for exit label to be used in Return statements,
+      --  sets Exit_Lab (the label node) and Lab_Decl (corresponding implcit
+      --  declaration).
 
       function Process_Formals (N : Node_Id) return Traverse_Result;
-      --  Replace occurrence of a formal with the corresponding actual, or
-      --  the thunk generated for it.
+      --  Replace occurrence of a formal with the corresponding actual, or the
+      --  thunk generated for it.
 
       function Process_Sloc (Nod : Node_Id) return Traverse_Result;
-      --  If the call being expanded is that of an internal subprogram,
-      --  set the sloc of the generated block to that of the call itself,
-      --  so that the expansion is skipped by the -next- command in gdb.
+      --  If the call being expanded is that of an internal subprogram, set the
+      --  sloc of the generated block to that of the call itself, so that the
+      --  expansion is skipped by the "next" command in gdb.
       --  Same processing for a subprogram in a predefined file, e.g.
-      --  Ada.Tags. If Debug_Generated_Code is true, suppress this change
-      --  to simplify our own development.
+      --  Ada.Tags. If Debug_Generated_Code is true, suppress this change to
+      --  simplify our own development.
 
       procedure Rewrite_Function_Call (N : Node_Id; Blk : Node_Id);
       --  If the function body is a single expression, replace call with
@@ -3576,19 +3592,6 @@ package body Exp_Ch6 is
 
    begin
 
-      --  For To_Address, just do an unchecked conversion . Not only is this
-      --  efficient, but it also avoids problem with order of elaboration
-      --  when address clauses are inlined (address expression elaborated
-      --  at the wrong point).
-
-      if Subp = RTE (RE_To_Address) then
-         Rewrite (N,
-           Unchecked_Convert_To
-            (RTE (RE_Address),
-             Relocate_Node (First_Actual (N))));
-         return;
-      end if;
-
       --  Check for an illegal attempt to inline a recursive procedure. If the
       --  subprogram has parameters this is detected when trying to supply a
       --  binding for parameters that already have one. For parameterless
diff --git a/gcc/ada/s-auxdec-vms_64.ads b/gcc/ada/s-auxdec-vms_64.ads
index e9d8762..b36341c 100644
--- a/gcc/ada/s-auxdec-vms_64.ads
+++ b/gcc/ada/s-auxdec-vms_64.ads
@@ -63,15 +63,23 @@ package System.Aux_DEC is
    type Integer_8  is range -2 **  (8 - 1) .. +2 **  (8 - 1) - 1;
    for Integer_8'Size  use  8;
 
+   type Integer_8_Array is array (Integer range <>) of Integer_8;
+
    type Integer_16 is range -2 ** (16 - 1) .. +2 ** (16 - 1) - 1;
    for Integer_16'Size use 16;
 
+   type Integer_16_Array is array (Integer range <>) of Integer_16;
+
    type Integer_32 is range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1;
    for Integer_32'Size use 32;
 
+   type Integer_32_Array is array (Integer range <>) of Integer_32;
+
    type Integer_64 is range -2 ** (64 - 1) .. +2 ** (64 - 1) - 1;
    for Integer_64'Size use 64;
 
+   type Integer_64_Array is array (Integer range <>) of Integer_64;
+
    type Largest_Integer is range Min_Int .. Max_Int;
 
    type AST_Handler is private;
diff --git a/gcc/ada/s-auxdec.ads b/gcc/ada/s-auxdec.ads
index a709956..3748bee 100644
--- a/gcc/ada/s-auxdec.ads
+++ b/gcc/ada/s-auxdec.ads
@@ -53,15 +53,23 @@ package System.Aux_DEC is
    type Integer_8  is range -2 **  (8 - 1) .. +2 **  (8 - 1) - 1;
    for Integer_8'Size  use  8;
 
+   type Integer_8_Array is array (Integer range <>) of Integer_8;
+
    type Integer_16 is range -2 ** (16 - 1) .. +2 ** (16 - 1) - 1;
    for Integer_16'Size use 16;
 
+   type Integer_16_Array is array (Integer range <>) of Integer_16;
+
    type Integer_32 is range -2 ** (32 - 1) .. +2 ** (32 - 1) - 1;
    for Integer_32'Size use 32;
 
+   type Integer_32_Array is array (Integer range <>) of Integer_32;
+
    type Integer_64 is range -2 ** (64 - 1) .. +2 ** (64 - 1) - 1;
    for Integer_64'Size use 64;
 
+   type Integer_64_Array is array (Integer range <>) of Integer_64;
+
    type Largest_Integer is range Min_Int .. Max_Int;
 
    type AST_Handler is private;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index e80c662..b4e57b2 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5568,15 +5568,17 @@ package body Sem_Ch3 is
 
                Install_Private_Declarations (Par_Scope);
                Install_Visible_Declarations (Par_Scope);
-               Insert_Before (N, Decl);
+               Insert_After (N, Decl);
                Analyze (Decl);
                Uninstall_Declarations (Par_Scope);
 
                --  Freeze the underlying record view, to prevent generation
                --  of useless dispatching information, which is simply shared
-               --  with the real derived type.
+               --  with the real derived type. The underlying view must be
+               --  treated as an itype by the back-end.
 
                Set_Is_Frozen (Full_Der);
+               Set_Is_Itype (Full_Der);
                Set_Underlying_Record_View (Derived_Type, Full_Der);
             end;
 
@@ -13495,6 +13497,15 @@ package body Sem_Ch3 is
                         ("completion of tagged private type must be tagged",
                            N);
                   end if;
+
+               elsif Nkind (N) = N_Full_Type_Declaration
+                 and then
+                   Nkind (Type_Definition (N)) = N_Record_Definition
+                 and then Interface_Present (Type_Definition (N))
+               then
+                  Error_Msg_N
+                    ("completion of private type canot be an interface",
+                       N);
                end if;
 
             --  Ada 2005 (AI-251): Private extension declaration of a task
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index c51f843..17103e1 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7388,9 +7388,9 @@ package body Sem_Ch6 is
 
                   return;
 
-                  --  Within an instance, the renaming declarations for
-                  --  actual subprograms may become ambiguous, but they do
-                  --  not hide each other.
+               --  Within an instance, the renaming declarations for actual
+               --  subprograms may become ambiguous, but they do not hide each
+               --  other.
 
                elsif Ekind (E) /= E_Entry
                  and then not Comes_From_Source (E)
@@ -7402,8 +7402,8 @@ package body Sem_Ch6 is
                             or else Nkind (Unit_Declaration_Node (E)) /=
                                       N_Subprogram_Renaming_Declaration)
                then
-                  --  A subprogram child unit is not allowed to override
-                  --  an inherited subprogram (10.1.1(20)).
+                  --  A subprogram child unit is not allowed to override an
+                  --  inherited subprogram (10.1.1(20)).
 
                   if Is_Child_Unit (S) then
                      Error_Msg_N
diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads
index 543f01b..5752c21 100644
--- a/gcc/ada/sem_ch6.ads
+++ b/gcc/ada/sem_ch6.ads
@@ -57,8 +57,8 @@ package Sem_Ch6 is
 
    procedure Check_Conventions (Typ : Entity_Id);
    --  Ada 2005 (AI-430): Check that the conventions of all inherited and
-   --  overridden dispatching operations of type Typ are consistent with
-   --  their respective counterparts.
+   --  overridden dispatching operations of type Typ are consistent with their
+   --  respective counterparts.
 
    procedure Check_Delayed_Subprogram (Designator : Entity_Id);
    --  Designator can be a E_Subprogram_Type, E_Procedure or E_Function. If a
@@ -69,10 +69,10 @@ package Sem_Ch6 is
      (N        : Node_Id;
       Prev     : Entity_Id;
       Prev_Loc : Node_Id);
-   --  Check that the discriminants of a full type N fully conform to
-   --  the discriminants of the corresponding partial view Prev.
-   --  Prev_Loc indicates the source location of the partial view,
-   --  which may be different than Prev in the case of private types.
+   --  Check that the discriminants of a full type N fully conform to the
+   --  discriminants of the corresponding partial view Prev. Prev_Loc indicates
+   --  the source location of the partial view, which may be different than
+   --  Prev in the case of private types.
 
    procedure Check_Fully_Conformant
      (New_Id  : Entity_Id;
@@ -230,15 +230,21 @@ package Sem_Ch6 is
      (New_Id                   : Entity_Id;
       Old_Id                   : Entity_Id;
       Skip_Controlling_Formals : Boolean := False) return Boolean;
-   --  Determine whether two callable entities (subprograms, entries,
-   --  literals) are subtype conformant (RM6.3.1(16)).
+   --  Determine whether two callable entities (subprograms, entries, literals)
+   --  are subtype conformant (RM6.3.1(16)).  Skip_Controlling_Formals is True
+   --  when checking the conformance of a subprogram that implements an
+   --  interface operation. In that case, only the non-controlling formals
+   --  can (and must) be examined.
 
    function Type_Conformant
      (New_Id                   : Entity_Id;
       Old_Id                   : Entity_Id;
       Skip_Controlling_Formals : Boolean := False) return Boolean;
-   --  Determine whether two callable entities (subprograms, entries,
-   --  literals) are type conformant (RM6.3.1(14)).
+   --  Determine whether two callable entities (subprograms, entries, literals)
+   --  are type conformant (RM6.3.1(14)). Skip_Controlling_Formals is True when
+   --  checking the conformance of a subprogram that implements an interface
+   --  operation. In that case, only the non-controlling formals can (and must)
+   --  be examined.
 
    procedure Valid_Operator_Definition (Designator : Entity_Id);
    --  Verify that an operator definition has the proper number of formals
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index fc3db82..d6799bc 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -42,6 +42,7 @@ with Restrict; use Restrict;
 with Rident;   use Rident;
 with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
+with Sem_Ch3;  use Sem_Ch3;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Elim; use Sem_Elim;
 with Sem_Eval; use Sem_Eval;
@@ -711,12 +712,41 @@ package body Sem_Disp is
          return;
 
       --  The subprograms build internally after the freezing point (such as
-      --  the Init procedure) are not primitives
+      --  init procs, interface thunks, type support subprograms, and Offset
+      --  to top functions for accessing interface components in variable
+      --  size tagged types) are not primitives.
 
       elsif Is_Frozen (Tagged_Type)
         and then not Comes_From_Source (Subp)
         and then not Has_Dispatching_Parent
       then
+         --  Complete decoration if internally built subprograms that override
+         --  a dispatching primitive. These entities correspond with the
+         --  following cases:
+
+         --  1. Ada 2005 (AI-391): Wrapper functions built by the expander
+         --     to override functions of nonabstract null extensions. These
+         --     primitives were added to the list of primitives of the tagged
+         --     type by Make_Controlling_Function_Wrappers. However, attribute
+         --     Is_Dispatching_Operation must be set to true.
+
+         --  2. Subprograms associated with stream attributes (built by
+         --     New_Stream_Subprogram)
+
+         if Present (Old_Subp)
+           and then Is_Overriding_Operation (Subp)
+           and then Is_Dispatching_Operation (Old_Subp)
+         then
+            pragma Assert
+             ((Ekind (Subp) = E_Function
+                 and then Is_Dispatching_Operation (Old_Subp)
+                 and then Is_Null_Extension (Base_Type (Etype (Subp))))
+               or else Get_TSS_Name (Subp) = TSS_Stream_Read
+               or else Get_TSS_Name (Subp) = TSS_Stream_Write);
+
+            Set_Is_Dispatching_Operation (Subp);
+         end if;
+
          return;
 
       --  The operation may be a child unit, whose scope is the defining
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index 8178afc..6c79b94 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -256,6 +256,14 @@ package body Switch.C is
                      if Dot then
                         Set_Dotted_Debug_Flag (C);
                         Store_Compilation_Switch ("-gnatd." & C);
+
+                        --  Disable front-end inlining in inspector mode
+                        --  ??? Change this when we use a non debug flag to
+                        --  enable inspector mode.
+
+                        if C = 'I' then
+                           Front_End_Inlining := False;
+                        end if;
                      else
                         Set_Debug_Flag (C);
                         Store_Compilation_Switch ("-gnatd" & C);
@@ -632,7 +640,14 @@ package body Switch.C is
             when 'N' =>
                Ptr := Ptr + 1;
                Inline_Active := True;
-               Front_End_Inlining := True;
+
+               --  Do not enable front-end inlining in inspector mode, to
+               --  generate trees that can be converted to SCIL. We still
+               --  enable back-end inlining which is fine.
+
+               if not Inspector_Mode then
+                  Front_End_Inlining := True;
+               end if;
 
             --  Processing for o switch