[Ada] Implement AI12-0280 Making 'Old more flexible

gcc/ada/

	* sem_util.ads: Declare a new package, Old_Attr_Util, which in
	turn declares two more packages, Conditional_Evaluation and
	Indirect_Temps. Conditional_Evaluation provides a predicate for
	deciding whether a given 'Old attribute reference is eligible
	for conditional evaluation and, in the case where it is
	eligible, a function that constructs the Boolean-valued
	condition that is to be evaluated at run time in deciding
	whether to evaluate the attribute prefix.  Indirect_Temps
	provides support for declaring a temporary which is only
	initialized conditionally; more specifically, an access type and
	a variable of that type are declared (unconditionally) and then
	the variable is (conditionally) initialized with an allocator.
	The existence of the access type and the pointer variable is
	hidden from clients, except that a predicate,
	Is_Access_Type_For_Indirect_Temp, is provided for identifying
	such access types. This is needed because we want such an access
	type to be treated like a "normal" access type (specifically
	with respect to finalization of allocated objects). Other parts
	of the compiler treat access types differently if
	Comes_From_Source is False, or if the secondary stack storage
	pool is used; this predicate is used to disable this special
	treatment.
	* sem_attr.adb (Uneval_Old_Msg): Improve message text to reflect
	Ada202x changes.
	(Analyze_Attribute): A previously-illegal 'Old attribute
	reference is accepted in Ada2020 if it is eligible for
	conditional evaluation.
	* sem_res.adb (Valid_Conversion): Do not treat a rewritten 'Old
	attribute like other rewrite substitutions. This makes a
	difference, for example, in the case where we are generating the
	expansion of a membership test of the form "Saooaaat'Old in
	Named_Access_Type"; in this case Valid_Conversion needs to
	return True (otherwise the expansion will be False - see the
	call site in exp_ch4.adb).
	* exp_attr.adb (Expand_N_Attribute_Reference): When expanding a
	'Old attribute reference, test for the case where the reference
	is eligible for conditional evaluation. In that case, use the
	new "indirect temporary" mechanism provided by Sem_Util.
	* exp_prag.adb
	(Expand_Attributes_In_Consequence.Expand_Attributes): If
	Sem_Util.Indirect_Temp_Needed indicates that there could be
	correctness problems associated with the old expansion scheme
	for dealing with 'Old attributes in contract cases consequences,
	then we use the new "indirect temporary" mechanism provided by
	Sem_Util instead. We do not want to do this unconditionally.
	* sem_util.adb: Provide a body for the new Old_Attr_Util
	package. Further work is needed in several areas for
	correctness:
	- The function Is_Repeatedly_Evaluated does not deal with
	container aggregates yet.
	- The function Is_Known_On_Entry does not deal with interactions
	with the Global aspect.
	Each area where more work is needed is indicated with a "???"
	comment in the code; a more detailed description can be found
	there. Some optimization opportunties are similarly indicated
	with a "???" comment.
	* exp_ch3.adb (Freeze_Type): In deciding whether to generate
	expansion for the list controller of an access type, take the
	predicate Is_Access_Type_For_Indirect_Temp into account. If the
	predicate yields True, then generate the expansion.
	* exp_util.adb (Build_Allocate_Deallocate_Proc): We don't
	normally finalize allocated objects that are allocated on the
	secondary stack. Add an exception to this rule if the predicate
	Is_Access_Type_For_Indirect_Temp yields True.  As a result of
	this exception, we have to deal with the fact that gigi expects
	a different parameter profile if we are using the secondary
	stack pool; the Pool and Alignment parameters must be omitted in
	this case.

1 files changed, 79 insertions, 28 deletions

diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index f4b15fa..050b05c 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -1365,9 +1365,43 @@ package body Exp_Prag is
          -----------------------
 
          function Expand_Attributes (N : Node_Id) return Traverse_Result is
-            Decl : Node_Id;
-            Pref : Node_Id;
-            Temp : Entity_Id;
+            Decl     : Node_Id;
+            Pref     : Node_Id;
+            Temp     : Entity_Id;
+            Indirect : Boolean := False;
+
+            use Sem_Util.Old_Attr_Util.Indirect_Temps;
+
+            procedure Append_For_Indirect_Temp
+              (N : Node_Id; Is_Eval_Stmt : Boolean);
+
+            --  Append either a declaration (which is to be elaborated
+            --  unconditionally) or an evaluation statement (which is
+            --  to be executed conditionally).
+
+            -------------------------------
+            --  Append_For_Indirect_Temp --
+            -------------------------------
+
+            procedure Append_For_Indirect_Temp
+              (N : Node_Id; Is_Eval_Stmt : Boolean)
+            is
+            begin
+               if Is_Eval_Stmt then
+                  Append_To (Eval_Stmts, N);
+               else
+                  Prepend_To (Decls, N);
+                  --  This use of Prepend (as opposed to Append) is why
+                  --  we have the Append_Decls_In_Reverse_Order parameter.
+               end if;
+            end Append_For_Indirect_Temp;
+
+            procedure Declare_Indirect_Temporary is new
+              Declare_Indirect_Temp (
+                Append_Item                   => Append_For_Indirect_Temp,
+                Append_Decls_In_Reverse_Order => True);
+
+         --  Start of processing for Expand_Attributes
 
          begin
             --  Attribute 'Old
@@ -1376,37 +1410,49 @@ package body Exp_Prag is
               and then Attribute_Name (N) = Name_Old
             then
                Pref := Prefix (N);
-               Temp := Make_Temporary (Loc, 'T', Pref);
-               Set_Etype (Temp, Etype (Pref));
 
-               --  Generate a temporary to capture the value of the prefix:
-               --    Temp : <Pref type>;
+               Indirect := Indirect_Temp_Needed (Etype (Pref));
 
-               Decl :=
-                 Make_Object_Declaration (Loc,
-                   Defining_Identifier => Temp,
-                   Object_Definition   =>
-                     New_Occurrence_Of (Etype (Pref), Loc));
+               if Indirect then
+                  if No (Eval_Stmts) then
+                     Eval_Stmts := New_List;
+                  end if;
 
-               --  Place that temporary at the beginning of declarations, to
-               --  prevent anomalies in the GNATprove flow-analysis pass in
-               --  the precondition procedure that follows.
+                  Declare_Indirect_Temporary
+                    (Attr_Prefix   => Pref,
+                     Indirect_Temp => Temp);
 
-               Prepend_To (Decls, Decl);
+               --  Declare a temporary of the prefix type with no explicit
+               --  initial value. If the appropriate contract case is selected
+               --  at run time, then the temporary will be initialized via an
+               --  assignment statement.
 
-               --  If the type is unconstrained, the prefix provides its
-               --  value and constraint, so add it to declaration.
+               else
+                  Temp := Make_Temporary (Loc, 'T', Pref);
+                  Set_Etype (Temp, Etype (Pref));
 
-               if not Is_Constrained (Etype (Pref))
-                 and then Is_Entity_Name (Pref)
-               then
-                  Set_Expression (Decl, Pref);
-                  Analyze (Decl);
+                  --  Generate a temporary to capture the value of the prefix:
+                  --    Temp : <Pref type>;
 
-               --  Otherwise add an assignment statement to temporary using
-               --  prefix as RHS.
+                  Decl :=
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => Temp,
+                      Object_Definition   =>
+                        New_Occurrence_Of (Etype (Pref), Loc));
 
-               else
+                  --  Place that temporary at the beginning of declarations, to
+                  --  prevent anomalies in the GNATprove flow-analysis pass in
+                  --  the precondition procedure that follows.
+
+                  Prepend_To (Decls, Decl);
+
+                  --  Initially Temp is uninitialized (which is required for
+                  --  correctness if default initialization might have side
+                  --  effects). Assign prefix value to temp on Eval_Statement
+                  --  list, so assignment will be executed conditionally.
+
+                  Set_Ekind (Temp, E_Variable);
+                  Set_Suppress_Initialization (Temp);
                   Analyze (Decl);
 
                   if No (Eval_Stmts) then
@@ -1417,7 +1463,6 @@ package body Exp_Prag is
                     Make_Assignment_Statement (Loc,
                       Name       => New_Occurrence_Of (Temp, Loc),
                       Expression => Pref));
-
                end if;
 
                --  Ensure that the prefix is valid
@@ -1429,7 +1474,13 @@ package body Exp_Prag is
                --  Replace the original attribute 'Old by a reference to the
                --  generated temporary.
 
-               Rewrite (N, New_Occurrence_Of (Temp, Loc));
+               if Indirect then
+                  Rewrite (N,
+                    Indirect_Temp_Value
+                      (Temp => Temp, Typ => Etype (Pref), Loc => Loc));
+               else
+                  Rewrite (N, New_Occurrence_Of (Temp, Loc));
+               end if;
 
             --  Attribute 'Result