[multiple changes]

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

	* exp_alfa.adb: Add with and use clauses for Exp_Ch8 and
	Sem_Util.
	(Expand_Alfa): Alphabetize cases on first choice. Add
	processing for object renaming declarations, identifiers and
	expanded names.
	(Expand_Alfa_N_In): Remove useless return.
	(Expand_Alfa_N_Object_Renaming_Declaration): New routine.
	(Expand_Potential_Renaming): New routine.
	* exp_ch8.adb (Evaluate_Name): Moved to the top level.
	(Expand_N_Object_Declaration): Alphabetize local variables. Move
	Evaluate_Name out to the top level.
	* exp_ch8.ads (Evaluate_Name): Moved from body to package spec.
	* exp_util.adb (Remove_Side_Effects): Add processing for
	functions with side effects in Alfa mode.

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

	* gnat_rm.texi: Add entries for
	restrictions No_Relative_Delay, No_Requeue_Statements and
	No_Stream_Optimizations.

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

	* sem_ch4.adb: Set type of entity in prefixed call, for
	completeness in a generic context.

From-SVN: r180951

gcc/ada/ChangeLog

@@ -1,3 +1,31 @@
+2011-11-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_alfa.adb: Add with and use clauses for Exp_Ch8 and
+	Sem_Util.
+	(Expand_Alfa): Alphabetize cases on first choice. Add
+	processing for object renaming declarations, identifiers and
+	expanded names.
+	(Expand_Alfa_N_In): Remove useless return.
+	(Expand_Alfa_N_Object_Renaming_Declaration): New routine.
+	(Expand_Potential_Renaming): New routine.
+	* exp_ch8.adb (Evaluate_Name): Moved to the top level.
+	(Expand_N_Object_Declaration): Alphabetize local variables. Move
+	Evaluate_Name out to the top level.
+	* exp_ch8.ads (Evaluate_Name): Moved from body to package spec.
+	* exp_util.adb (Remove_Side_Effects): Add processing for
+	functions with side effects in Alfa mode.
+
+2011-11-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* gnat_rm.texi: Add entries for
+	restrictions No_Relative_Delay, No_Requeue_Statements and
+	No_Stream_Optimizations.
+
+2011-11-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch4.adb: Set type of entity in prefixed call, for
+	completeness in a generic context.
+
 2011-11-04  Yannick Moy  <moy@adacore.com>
 
 	* sem_prag.adb: Minor refactoring (renaming of a parameter).

gcc/ada/exp_alfa.adb

@@ -28,11 +28,13 @@ 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 Nlists;   use Nlists;
 with Rtsfind;  use Rtsfind;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Res;  use Sem_Res;
+with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Stand;    use Stand;
@@ -56,12 +58,19 @@ package body Exp_Alfa is
    procedure Expand_Alfa_N_In (N : Node_Id);
    --  Expand set membership into individual ones
 
+   procedure Expand_Alfa_N_Object_Renaming_Declaration (N : Node_Id);
+   --  Perform name evaluation for a renamed object
+
    procedure Expand_Alfa_N_Simple_Return_Statement (N : Node_Id);
    --  Insert conversion on function return if necessary
 
    procedure Expand_Alfa_Simple_Function_Return (N : Node_Id);
    --  Expand simple return from function
 
+   procedure Expand_Potential_Renaming (N : Node_Id);
+   --  N denotes a N_Identifier or N_Expanded_Name. If N references a renaming,
+   --  replace N with the renamed object.
+
    -----------------
    -- Expand_Alfa --
    -----------------
@@ -69,22 +78,22 @@ package body Exp_Alfa is
    procedure Expand_Alfa (N : Node_Id) is
    begin
       case Nkind (N) is
+         when N_Attribute_Reference =>
+            Expand_Alfa_N_Attribute_Reference (N);
 
-         when N_Package_Body        |
+         when N_Block_Statement     |
+              N_Package_Body        |
               N_Package_Declaration |
-              N_Subprogram_Body     |
+              N_Subprogram_Body     =>
-              N_Block_Statement     =>
             Qualify_Entity_Names (N);
 
-         when N_Simple_Return_Statement =>
-            Expand_Alfa_N_Simple_Return_Statement (N);
-
          when N_Function_Call            |
               N_Procedure_Call_Statement =>
             Expand_Alfa_Call (N);
 
-         when N_Attribute_Reference =>
+         when N_Expanded_Name |
-            Expand_Alfa_N_Attribute_Reference (N);
+              N_Identifier    =>
+            Expand_Potential_Renaming (N);
 
          when N_In =>
             Expand_Alfa_N_In (N);
@@ -92,6 +101,12 @@ package body Exp_Alfa is
          when N_Not_In =>
             Expand_N_Not_In (N);
 
+         when N_Object_Renaming_Declaration =>
+            Expand_Alfa_N_Object_Renaming_Declaration (N);
+
+         when N_Simple_Return_Statement =>
+            Expand_Alfa_N_Simple_Return_Statement (N);
+
          when others =>
             null;
       end case;
@@ -157,7 +172,6 @@ package body Exp_Alfa is
 
          Set_Entity (Name (Call_Node), Parent_Subp);
       end if;
-
    end Expand_Alfa_Call;
 
    ---------------------------------------
@@ -186,10 +200,20 @@ package body Exp_Alfa is
    begin
       if Present (Alternatives (N)) then
          Expand_Set_Membership (N);
-         return;
       end if;
    end Expand_Alfa_N_In;
 
+   -----------------------------------------------
+   -- Expand_Alfa_N_Object_Renaming_Declaration --
+   -----------------------------------------------
+
+   procedure Expand_Alfa_N_Object_Renaming_Declaration (N : Node_Id) is
+   begin
+      --  Unconditionally remove all side effects from the name
+
+      Evaluate_Name (Name (N));
+   end Expand_Alfa_N_Object_Renaming_Declaration;
+
    -------------------------------------------
    -- Expand_Alfa_N_Simple_Return_Statement --
    -------------------------------------------
@@ -218,7 +242,6 @@ package body Exp_Alfa is
               E_Entry             |
               E_Entry_Family      |
               E_Return_Statement =>
-            --  Expand_Non_Function_Return (N);
             null;
 
          when others =>
@@ -265,4 +288,23 @@ package body Exp_Alfa is
       end if;
    end Expand_Alfa_Simple_Function_Return;
 
+   -------------------------------
+   -- Expand_Potential_Renaming --
+   -------------------------------
+
+   procedure Expand_Potential_Renaming (N : Node_Id) is
+      E : constant Entity_Id := Entity (N);
+      T : constant Entity_Id := Etype (N);
+
+   begin
+      --  Substitute a reference to a renaming with the actual renamed object
+
+      if Present (Renamed_Object (E)) then
+         Rewrite (N, New_Copy_Tree (Renamed_Object (E)));
+
+         Reset_Analyzed_Flags (N);
+         Analyze_And_Resolve (N, T);
+      end if;
+   end Expand_Potential_Renaming;
+
 end Exp_Alfa;

gcc/ada/exp_ch8.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -44,6 +44,100 @@ 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 --
    ---------------------------------------------
@@ -91,114 +185,17 @@ package body Exp_Ch8 is
 
    procedure Expand_N_Object_Renaming_Declaration (N : Node_Id) is
       Nam  : constant Node_Id := Name (N);
-      T    : Entity_Id;
       Decl : Node_Id;
-
+      T    : Entity_Id;
-      procedure Evaluate_Name (Fname : Node_Id);
-      --  A recursive procedure used to freeze a name in the sense described
-      --  above, i.e. any variable references or function calls are removed.
-      --  Of course the outer level variable reference must not be removed.
-      --  For example in A(J,F(K)), A is left as is, but J and F(K) are
-      --  evaluated and removed.
 
       function Evaluation_Required (Nam : Node_Id) return Boolean;
-      --  Determines whether it is necessary to do static name evaluation
+      --  Determines whether it is necessary to do static name evaluation for
-      --  for renaming of Nam. It is considered necessary if evaluating the
+      --  renaming of Nam. It is considered necessary if evaluating the name
-      --  name involves indexing a packed array, or extracting a component
+      --  involves indexing a packed array, or extracting a component of a
-      --  of a record to which a component clause applies. Note that we are
+      --  record to which a component clause applies. Note that we are only
-      --  only interested in these operations if they occur as part of the
+      --  interested in these operations if they occur as part of the name
-      --  name itself, subscripts are just values that are computed as part
+      --  itself, subscripts are just values that are computed as part of the
-      --  of the evaluation, so their form is unimportant.
+      --  evaluation, so their form is unimportant.
-
-      -------------------
-      -- Evaluate_Name --
-      -------------------
-
-      procedure Evaluate_Name (Fname : Node_Id) is
-         K : constant Node_Kind := Nkind (Fname);
-         E : Node_Id;
-
-      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 (Fname));
-
-         --  For a selected component, we simply evaluate the prefix
-
-         elsif K = N_Selected_Component then
-            Evaluate_Name (Prefix (Fname));
-
-         --  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 (Fname));
-
-            E := First (Expressions (Fname));
-            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;
-
-         --  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 (Fname));
-
-            declare
-               DR     : constant Node_Id := Discrete_Range (Fname);
-               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 (Fname));
-
-         --  For a function call, we evaluate the call
-
-         elsif K = N_Function_Call then
-            Force_Evaluation (Fname);
-
-         --  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;
 
       -------------------------
       -- Evaluation_Required --

gcc/ada/exp_ch8.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -32,4 +32,9 @@ package Exp_Ch8 is
    procedure Expand_N_Object_Renaming_Declaration     (N : Node_Id);
    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;

gcc/ada/exp_util.adb

@@ -6531,32 +6531,57 @@ package body Exp_Util is
             end;
          end if;
 
-         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)));
-
-         E := Exp;
-         Insert_Action (Exp, Ptr_Typ_Decl);
-
          Def_Id := Make_Temporary (Loc, 'R', Exp);
          Set_Etype (Def_Id, Exp_Type);
 
-         Res :=
+         --  The regular expansion of functions with side effects involves the
-           Make_Explicit_Dereference (Loc,
+         --  generation of an access type to capture the return value found on
-             Prefix => New_Reference_To (Def_Id, Loc));
+         --  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.
 
+         if Alfa_Mode then
+            Res := New_Reference_To (Def_Id, Loc);
+            Ref_Type := Exp_Type;
+
+         --  Regular expansion utilizing an access type and 'reference
+
+         else
+            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 since the access type is
+            --  not generated.
+
+            if Alfa_Mode then
+               New_Exp := E;
+            else
+               New_Exp := Make_Reference (Loc, E);
+            end if;
          end if;
 
          if Is_Delayed_Aggregate (E) then

gcc/ada/gnat_rm.texi

@@ -9124,6 +9124,17 @@ only declared at the library level.
 This restriction ensures at compile time that there are no allocator
 expressions that attempt to allocate protected objects.
 
+@item No_Relative_Delay
+@findex No_Relative_Delay
+This restriction ensures at compile time that there are no delay relative
+statements and prevents expressions such as @code{delay 1.23;} from appearing
+in source code.
+
+@item No_Requeue_Statements
+@findex No_Requeue_Statements
+This restriction ensures at compile time that no requeue statements are
+permitted and prevents keyword @code{requeue} from being used in source code.
+
 @item No_Secondary_Stack
 @findex No_Secondary_Stack
 This restriction ensures at compile time that the generated code does not
@@ -9145,6 +9156,14 @@ use the standard default storage pool.  Any access type declared must
 have an explicit Storage_Pool attribute defined specifying a
 user-defined storage pool.
 
+@item No_Stream_Optimizations
+@findex No_Stream_Optimizations
+This restriction affects the performance of stream operations on types
+@code{String}, @code{Wide_String} and @code{Wide_Wide_String}. By default, the
+compiler uses block reads and writes when manipulating @code{String} objects
+due to their supperior performance. When this restriction is in effect, the
+compiler performs all IO operations on a per-character basis.
+
 @item No_Streams
 @findex No_Streams
 This restriction ensures at compile/bind time that there are no

gcc/ada/sem_ch4.adb

@@ -6863,7 +6863,8 @@ package body Sem_Ch4 is
          First_Actual := First (Parameter_Associations (Call_Node));
 
          --  For cross-reference purposes, treat the new node as being in
-         --  the source if the original one is.
+         --  the source if the original one is. Set entity and type, even
+         --  though they may be overwritten during resolution if overloaded.
 
          Set_Comes_From_Source (Subprog, Comes_From_Source (N));
          Set_Comes_From_Source (Call_Node, Comes_From_Source (N));
@@ -6872,6 +6873,7 @@ package body Sem_Ch4 is
            and then not Inside_A_Generic
          then
             Set_Entity (Selector_Name (N), Entity (Subprog));
+            Set_Etype  (Selector_Name (N), Etype (Entity (Subprog)));
          end if;
 
          --  If need be, rewrite first actual as an explicit dereference