[multiple changes]

2011-11-07  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_alfa.adb: Remove with and use clause for
	Exp_Ch8. Add with and use clause for Exp_Util.
	Remove local constant Disable_Processing_Of_Renamings.
	(Expand_Alfa_N_Object_Renaming_Declaration): The expansion of
	object renamings has been reenabled.
	(Expand_Possible_Renaming):
	The expansion of identifier and expanded names has been
	reenabled. Perform the substitutions only for entities that
	denote an object.
	* exp_ch8.ads, exp_ch8.adb (Evaluate_Name): Moved to Exp_Util.
	* exp_util.adb (Evaluate_Name): Moved from Exp_Ch8.
	(Remove_Side_Effects): Alphabetize local variables. Add a guard
	to avoid the infinite expansion of an expression in Alfa mode. Add
	processing for function calls in Alfa mode.
	* exp_util.ads (Evaliate_Name): Moved from Exp_Ch8.

2011-11-07  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Freeze_Entity): If the entity is an access to
	subprogram whose designated type is itself a subprogram type,
	its own return type must be decorated with size information.

From-SVN: r181091

7 files changed, 193 insertions, 133 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a6f30bf..dce0797 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2011-11-07  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_alfa.adb: Remove with and use clause for
+	Exp_Ch8. Add with and use clause for Exp_Util.
+	Remove local constant Disable_Processing_Of_Renamings.
+	(Expand_Alfa_N_Object_Renaming_Declaration): The expansion of
+	object renamings has been reenabled.
+	(Expand_Possible_Renaming):
+	The expansion of identifier and expanded names has been
+	reenabled. Perform the substitutions only for entities that
+	denote an object.
+	* exp_ch8.ads, exp_ch8.adb (Evaluate_Name): Moved to Exp_Util.
+	* exp_util.adb (Evaluate_Name): Moved from Exp_Ch8.
+	(Remove_Side_Effects): Alphabetize local variables. Add a guard
+	to avoid the infinite expansion of an expression in Alfa mode. Add
+	processing for function calls in Alfa mode.
+	* exp_util.ads (Evaliate_Name): Moved from Exp_Ch8.
+
+2011-11-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* freeze.adb (Freeze_Entity): If the entity is an access to
+	subprogram whose designated type is itself a subprogram type,
+	its own return type must be decorated with size information.
+
 2011-11-04  Arnaud Charlet  <charlet@adacore.com>
 
 	* gcc-interface/Make-lang.in: Update dependencies.
diff --git a/gcc/ada/exp_alfa.adb b/gcc/ada/exp_alfa.adb
index 844fe89..e2424da 100644
--- a/gcc/ada/exp_alfa.adb
+++ b/gcc/ada/exp_alfa.adb
@@ -28,8 +28,8 @@ with Einfo;    use Einfo;
 with Exp_Attr; use Exp_Attr;
 with Exp_Ch4;  use Exp_Ch4;
 with Exp_Ch6;  use Exp_Ch6;
-with Exp_Ch8;  use Exp_Ch8;
 with Exp_Dbug; use Exp_Dbug;
+with Exp_Util; use Exp_Util;
 with Nlists;   use Nlists;
 with Rtsfind;  use Rtsfind;
 with Sem_Aux;  use Sem_Aux;
@@ -42,8 +42,6 @@ with Tbuild;   use Tbuild;
 
 package body Exp_Alfa is
 
-   Disable_Processing_Of_Renamings : constant Boolean := True;
-
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -211,10 +209,6 @@ package body Exp_Alfa is
 
    procedure Expand_Alfa_N_Object_Renaming_Declaration (N : Node_Id) is
    begin
-      if Disable_Processing_Of_Renamings then
-         return;
-      end if;
-
       --  Unconditionally remove all side effects from the name
 
       Evaluate_Name (Name (N));
@@ -303,13 +297,11 @@ package body Exp_Alfa is
       T : constant Entity_Id := Etype (N);
 
    begin
-      if Disable_Processing_Of_Renamings then
-         return;
-      end if;
-
       --  Substitute a reference to a renaming with the actual renamed object
 
-      if Present (Renamed_Object (E)) then
+      if Ekind (E) in Object_Kind
+        and then Present (Renamed_Object (E))
+      then
          Rewrite (N, New_Copy_Tree (Renamed_Object (E)));
 
          Reset_Analyzed_Flags (N);
diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb
index c1fc7e8..f6f62d7 100644
--- a/gcc/ada/exp_ch8.adb
+++ b/gcc/ada/exp_ch8.adb
@@ -44,100 +44,6 @@ with Tbuild;   use Tbuild;
 
 package body Exp_Ch8 is
 
-   -------------------
-   -- Evaluate_Name --
-   -------------------
-
-   procedure Evaluate_Name (Nam : Node_Id) is
-      K : constant Node_Kind := Nkind (Nam);
-
-   begin
-      --  For an explicit dereference, we simply force the evaluation of the
-      --  name expression. The dereference provides a value that is the address
-      --  for the renamed object, and it is precisely this value that we want
-      --  to preserve.
-
-      if K = N_Explicit_Dereference then
-         Force_Evaluation (Prefix (Nam));
-
-      --  For a selected component, we simply evaluate the prefix
-
-      elsif K = N_Selected_Component then
-         Evaluate_Name (Prefix (Nam));
-
-      --  For an indexed component, or an attribute reference, we evaluate the
-      --  prefix, which is itself a name, recursively, and then force the
-      --  evaluation of all the subscripts (or attribute expressions).
-
-      elsif Nkind_In (K, N_Indexed_Component, N_Attribute_Reference) then
-         Evaluate_Name (Prefix (Nam));
-
-         declare
-            E : Node_Id;
-
-         begin
-            E := First (Expressions (Nam));
-            while Present (E) loop
-               Force_Evaluation (E);
-
-               if Original_Node (E) /= E then
-                  Set_Do_Range_Check (E, Do_Range_Check (Original_Node (E)));
-               end if;
-
-               Next (E);
-            end loop;
-         end;
-
-      --  For a slice, we evaluate the prefix, as for the indexed component
-      --  case and then, if there is a range present, either directly or as the
-      --  constraint of a discrete subtype indication, we evaluate the two
-      --  bounds of this range.
-
-      elsif K = N_Slice then
-         Evaluate_Name (Prefix (Nam));
-
-         declare
-            DR     : constant Node_Id := Discrete_Range (Nam);
-            Constr : Node_Id;
-            Rexpr  : Node_Id;
-
-         begin
-            if Nkind (DR) = N_Range then
-               Force_Evaluation (Low_Bound (DR));
-               Force_Evaluation (High_Bound (DR));
-
-            elsif Nkind (DR) = N_Subtype_Indication then
-               Constr := Constraint (DR);
-
-               if Nkind (Constr) = N_Range_Constraint then
-                  Rexpr := Range_Expression (Constr);
-
-                  Force_Evaluation (Low_Bound (Rexpr));
-                  Force_Evaluation (High_Bound (Rexpr));
-               end if;
-            end if;
-         end;
-
-      --  For a type conversion, the expression of the conversion must be the
-      --  name of an object, and we simply need to evaluate this name.
-
-      elsif K = N_Type_Conversion then
-         Evaluate_Name (Expression (Nam));
-
-      --  For a function call, we evaluate the call
-
-      elsif K = N_Function_Call then
-         Force_Evaluation (Nam);
-
-      --  The remaining cases are direct name, operator symbol and character
-      --  literal. In all these cases, we do nothing, since we want to
-      --  reevaluate each time the renamed object is used.
-
-      else
-         return;
-      end if;
-   end Evaluate_Name;
-
    ---------------------------------------------
    -- Expand_N_Exception_Renaming_Declaration --
    ---------------------------------------------
diff --git a/gcc/ada/exp_ch8.ads b/gcc/ada/exp_ch8.ads
index b5056ab..d5dd37c 100644
--- a/gcc/ada/exp_ch8.ads
+++ b/gcc/ada/exp_ch8.ads
@@ -33,8 +33,4 @@ package Exp_Ch8 is
    procedure Expand_N_Package_Renaming_Declaration    (N : Node_Id);
    procedure Expand_N_Subprogram_Renaming_Declaration (N : Node_Id);
 
-   procedure Evaluate_Name (Nam : Node_Id);
-   --  Remove the all side effects from a name except for the outermost
-   --  construct.
-
 end Exp_Ch8;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 2045201..e675da8 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1759,6 +1759,100 @@ package body Exp_Util is
           and then not Restriction_Active (No_Local_Allocators);
    end Entry_Names_OK;
 
+   -------------------
+   -- Evaluate_Name --
+   -------------------
+
+   procedure Evaluate_Name (Nam : Node_Id) is
+      K : constant Node_Kind := Nkind (Nam);
+
+   begin
+      --  For an explicit dereference, we simply force the evaluation of the
+      --  name expression. The dereference provides a value that is the address
+      --  for the renamed object, and it is precisely this value that we want
+      --  to preserve.
+
+      if K = N_Explicit_Dereference then
+         Force_Evaluation (Prefix (Nam));
+
+      --  For a selected component, we simply evaluate the prefix
+
+      elsif K = N_Selected_Component then
+         Evaluate_Name (Prefix (Nam));
+
+      --  For an indexed component, or an attribute reference, we evaluate the
+      --  prefix, which is itself a name, recursively, and then force the
+      --  evaluation of all the subscripts (or attribute expressions).
+
+      elsif Nkind_In (K, N_Indexed_Component, N_Attribute_Reference) then
+         Evaluate_Name (Prefix (Nam));
+
+         declare
+            E : Node_Id;
+
+         begin
+            E := First (Expressions (Nam));
+            while Present (E) loop
+               Force_Evaluation (E);
+
+               if Original_Node (E) /= E then
+                  Set_Do_Range_Check (E, Do_Range_Check (Original_Node (E)));
+               end if;
+
+               Next (E);
+            end loop;
+         end;
+
+      --  For a slice, we evaluate the prefix, as for the indexed component
+      --  case and then, if there is a range present, either directly or as the
+      --  constraint of a discrete subtype indication, we evaluate the two
+      --  bounds of this range.
+
+      elsif K = N_Slice then
+         Evaluate_Name (Prefix (Nam));
+
+         declare
+            DR     : constant Node_Id := Discrete_Range (Nam);
+            Constr : Node_Id;
+            Rexpr  : Node_Id;
+
+         begin
+            if Nkind (DR) = N_Range then
+               Force_Evaluation (Low_Bound (DR));
+               Force_Evaluation (High_Bound (DR));
+
+            elsif Nkind (DR) = N_Subtype_Indication then
+               Constr := Constraint (DR);
+
+               if Nkind (Constr) = N_Range_Constraint then
+                  Rexpr := Range_Expression (Constr);
+
+                  Force_Evaluation (Low_Bound (Rexpr));
+                  Force_Evaluation (High_Bound (Rexpr));
+               end if;
+            end if;
+         end;
+
+      --  For a type conversion, the expression of the conversion must be the
+      --  name of an object, and we simply need to evaluate this name.
+
+      elsif K = N_Type_Conversion then
+         Evaluate_Name (Expression (Nam));
+
+      --  For a function call, we evaluate the call
+
+      elsif K = N_Function_Call then
+         Force_Evaluation (Nam);
+
+      --  The remaining cases are direct name, operator symbol and character
+      --  literal. In all these cases, we do nothing, since we want to
+      --  reevaluate each time the renamed object is used.
+
+      else
+         return;
+      end if;
+   end Evaluate_Name;
+
    ---------------------
    -- Evolve_And_Then --
    ---------------------
@@ -5921,11 +6015,11 @@ package body Exp_Util is
       Exp_Type     : constant Entity_Id      := Etype (Exp);
       Svg_Suppress : constant Suppress_Array := Scope_Suppress;
       Def_Id       : Entity_Id;
+      E            : Node_Id;
+      New_Exp      : Node_Id;
+      Ptr_Typ_Decl : Node_Id;
       Ref_Type     : Entity_Id;
       Res          : Node_Id;
-      Ptr_Typ_Decl : Node_Id;
-      New_Exp      : Node_Id;
-      E            : Node_Id;
 
       function Side_Effect_Free (N : Node_Id) return Boolean;
       --  Determines if the tree N represents an expression that is known not
@@ -6160,7 +6254,7 @@ package body Exp_Util is
 
             --  A binary operator is side effect free if and both operands are
             --  side effect free. For this purpose binary operators include
-            --  membership tests and short circuit forms
+            --  membership tests and short circuit forms.
 
             when N_Binary_Op | N_Membership_Test | N_Short_Circuit =>
                return Side_Effect_Free (Left_Opnd  (N))
@@ -6528,6 +6622,15 @@ package body Exp_Util is
       --  Otherwise we generate a reference to the value
 
       else
+         --  An expression which is in Alfa mode is considered side effect free
+         --  if the resulting value is captured by a variable or a constant.
+
+         if Alfa_Mode
+           and then Nkind (Parent (Exp)) = N_Object_Declaration
+         then
+            return;
+         end if;
+
          --  Special processing for function calls that return a limited type.
          --  We need to build a declaration that will enable build-in-place
          --  expansion of the call. This is not done if the context is already
@@ -6536,10 +6639,10 @@ package body Exp_Util is
          --  This is relevant only in Ada 2005 mode. In Ada 95 programs we have
          --  to accommodate functions returning limited objects by reference.
 
-         if Nkind (Exp) = N_Function_Call
+         if Ada_Version >= Ada_2005
+           and then Nkind (Exp) = N_Function_Call
            and then Is_Immutably_Limited_Type (Etype (Exp))
            and then Nkind (Parent (Exp)) /= N_Object_Declaration
-           and then Ada_Version >= Ada_2005
          then
             declare
                Obj  : constant Entity_Id := Make_Temporary (Loc, 'F', Exp);
@@ -6559,32 +6662,57 @@ package body Exp_Util is
             end;
          end if;
 
-         Ref_Type := Make_Temporary (Loc, 'A');
+         Def_Id := Make_Temporary (Loc, 'R', Exp);
+         Set_Etype (Def_Id, Exp_Type);
+
+         --  The regular expansion of functions with side effects involves the
+         --  generation of an access type to capture the return value found on
+         --  the secondary stack. Since Alfa (and why) cannot process access
+         --  types, use a different approach which ignores the secondary stack
+         --  and "copies" the returned object.
 
-         Ptr_Typ_Decl :=
-           Make_Full_Type_Declaration (Loc,
-             Defining_Identifier => Ref_Type,
-             Type_Definition =>
-               Make_Access_To_Object_Definition (Loc,
-                 All_Present => True,
-                 Subtype_Indication =>
-                   New_Reference_To (Exp_Type, Loc)));
+         if Alfa_Mode then
+            Res := New_Reference_To (Def_Id, Loc);
+            Ref_Type := Exp_Type;
 
-         E := Exp;
-         Insert_Action (Exp, Ptr_Typ_Decl);
+         --  Regular expansion utilizing an access type and 'reference
 
-         Def_Id := Make_Temporary (Loc, 'R', Exp);
-         Set_Etype (Def_Id, Exp_Type);
+         else
+            Res :=
+              Make_Explicit_Dereference (Loc,
+                Prefix => New_Reference_To (Def_Id, Loc));
 
-         Res :=
-           Make_Explicit_Dereference (Loc,
-             Prefix => New_Reference_To (Def_Id, Loc));
+            --  Generate:
+            --    type Ann is access all <Exp_Type>;
 
+            Ref_Type := Make_Temporary (Loc, 'A');
+
+            Ptr_Typ_Decl :=
+              Make_Full_Type_Declaration (Loc,
+                Defining_Identifier => Ref_Type,
+                Type_Definition     =>
+                  Make_Access_To_Object_Definition (Loc,
+                    All_Present        => True,
+                    Subtype_Indication =>
+                      New_Reference_To (Exp_Type, Loc)));
+
+            Insert_Action (Exp, Ptr_Typ_Decl);
+         end if;
+
+         E := Exp;
          if Nkind (E) = N_Explicit_Dereference then
             New_Exp := Relocate_Node (Prefix (E));
          else
             E := Relocate_Node (E);
-            New_Exp := Make_Reference (Loc, E);
+
+            --  Do not generate a 'reference in Alfa mode since the access type
+            --  is not created in the first place.
+
+            if Alfa_Mode then
+               New_Exp := E;
+            else
+               New_Exp := Make_Reference (Loc, E);
+            end if;
          end if;
 
          if Is_Delayed_Aggregate (E) then
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 94512b6..f293b8f 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -351,6 +351,10 @@ package Exp_Util is
    --  which represent entry [family member] names. These strings are created
    --  by the compiler and used by GDB.
 
+   procedure Evaluate_Name (Nam : Node_Id);
+   --  Remove the all side effects from a name which appears as part of an
+   --  object renaming declaration.
+
    procedure Evolve_And_Then (Cond : in out Node_Id; Cond1 : Node_Id);
    --  Rewrites Cond with the expression: Cond and then Cond1. If Cond is
    --  Empty, then simply returns Cond1 (this allows the use of Empty to
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 8c42fed..b1a33d5 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -4063,6 +4063,16 @@ package body Freeze is
             Layout_Type (E);
          end if;
 
+         --  If this is an access to subprogram whose designated type is itself
+         --  a subprogram type, the return type of this anonymous subprogram
+         --  type must be decorated as well.
+
+         if Ekind (E) = E_Anonymous_Access_Subprogram_Type
+           and then Ekind (Designated_Type (E)) = E_Subprogram_Type
+         then
+            Layout_Type (Etype (Designated_Type (E)));
+         end if;
+
          --  If the type has a Defaut_Value/Default_Component_Value aspect,
          --  this is where we analye the expression (after the type is frozen,
          --  since in the case of Default_Value, we are analyzing with the