===================================================================
@@ -3806,9 +3806,9 @@
---------
when Attribute_Old => Old : declare
- Tnn : constant Entity_Id := Make_Temporary (Loc, 'T', Pref);
+ Asn_Stm : Node_Id;
Subp : Node_Id;
- Asn_Stm : Node_Id;
+ Temp : Entity_Id;
begin
-- If assertions are disabled, no need to create the declaration
@@ -3818,42 +3818,47 @@
return;
end if;
- -- Find the nearest subprogram body, ignoring _Preconditions
+ Temp := Make_Temporary (Loc, 'T', Pref);
+ -- Climb the parent chain looking for subprogram _Postconditions
+
Subp := N;
- loop
+ while Present (Subp) loop
+ exit when Nkind (Subp) = N_Subprogram_Body
+ and then Chars (Defining_Entity (Subp)) = Name_uPostconditions;
+
Subp := Parent (Subp);
- exit when Nkind (Subp) = N_Subprogram_Body
- and then Chars (Defining_Entity (Subp)) /= Name_uPostconditions;
end loop;
- -- Insert the initialized object declaration at the start of the
- -- subprogram's declarations.
+ -- 'Old can only appear in a postcondition, the generated body of
+ -- _Postconditions must be in the tree.
+ pragma Assert (Present (Subp));
+
+ -- Generate:
+ -- Temp : constant <Pref type> := <Pref>;
+
Asn_Stm :=
Make_Object_Declaration (Loc,
- Defining_Identifier => Tnn,
+ Defining_Identifier => Temp,
Constant_Present => True,
Object_Definition => New_Occurrence_Of (Etype (N), Loc),
Expression => Pref);
- -- Push the subprogram's scope, so that the object will be analyzed
- -- in that context (rather than the context of the Precondition
- -- subprogram) and will have its Scope set properly.
+ -- Push the scope of the related subprogram where _Postcondition
+ -- resides as this ensures that the object will be analyzed in the
+ -- proper context.
- if Present (Corresponding_Spec (Subp)) then
- Push_Scope (Corresponding_Spec (Subp));
- else
- Push_Scope (Defining_Entity (Subp));
- end if;
+ Push_Scope (Scope (Defining_Entity (Subp)));
- if Is_Empty_List (Declarations (Subp)) then
- Set_Declarations (Subp, New_List (Asn_Stm));
- Analyze (Asn_Stm);
- else
- Insert_Action (First (Declarations (Subp)), Asn_Stm);
- end if;
+ -- The object declaration is inserted before the body of subprogram
+ -- _Postconditions. This ensures that any precondition-like actions
+ -- are still executed before any parameter values are captured and
+ -- the multiple 'Old occurrences appear in order of declaration.
+ Insert_Before_And_Analyze (Subp, Asn_Stm);
+ Pop_Scope;
+
-- Ensure that the prefix of attribute 'Old is valid. The check must
-- be inserted after the expansion of the attribute has taken place
-- to reflect the new placement of the prefix.
@@ -3862,9 +3867,7 @@
Ensure_Valid (Pref);
end if;
- Pop_Scope;
-
- Rewrite (N, New_Occurrence_Of (Tnn, Loc));
+ Rewrite (N, New_Occurrence_Of (Temp, Loc));
end Old;
----------------------
===================================================================
@@ -8911,27 +8911,47 @@
Stmts : List_Id;
Result : Entity_Id)
is
- procedure Insert_After_Last_Declaration (Stmt : Node_Id);
- -- Insert node Stmt after the last declaration of the subprogram body
+ procedure Insert_Before_First_Source_Declaration (Stmt : Node_Id);
+ -- Insert node Stmt before the first source declaration of the
+ -- related subprogram's body. If no such declaration exists, Stmt
+ -- becomes the last declaration.
- -----------------------------------
- -- Insert_After_Last_Declaration --
- -----------------------------------
+ --------------------------------------------
+ -- Insert_Before_First_Source_Declaration --
+ --------------------------------------------
- procedure Insert_After_Last_Declaration (Stmt : Node_Id) is
- Decls : List_Id := Declarations (N);
+ procedure Insert_Before_First_Source_Declaration (Stmt : Node_Id) is
+ Decls : constant List_Id := Declarations (N);
+ Decl : Node_Id;
begin
+ -- Inspect the declarations of the related subprogram body looking
+ -- for the first source declaration.
+
+ if Present (Decls) then
+ Decl := First (Decls);
+ while Present (Decl) loop
+ if Comes_From_Source (Decl) then
+ Insert_Before (Decl, Stmt);
+ return;
+ end if;
+
+ Next (Decl);
+ end loop;
+
+ -- If we get there, then the subprogram body lacks any source
+ -- declarations. The body of _Postconditions now acts as the
+ -- last declaration.
+
+ Append (Stmt, Decls);
+
-- Ensure that the body has a declaration list
- if No (Decls) then
- Decls := New_List;
- Set_Declarations (N, Decls);
+ else
+ Set_Declarations (N, New_List (Stmt));
end if;
+ end Insert_Before_First_Source_Declaration;
- Append_To (Decls, Stmt);
- end Insert_After_Last_Declaration;
-
-- Local variables
Loc : constant Source_Ptr := Sloc (N);
@@ -8965,9 +8985,9 @@
New_Reference_To (Etype (Result), Loc)));
end if;
- -- Insert _Postconditions after the last declaration of the body.
- -- This ensures that the body will not cause any premature freezing
- -- as it may mention types:
+ -- Insert _Postconditions before the first source declaration of the
+ -- body. This ensures that the body will not cause any premature
+ -- freezing as it may mention types:
-- procedure Proc (Obj : Array_Typ) is
-- procedure _postconditions is
@@ -8983,7 +9003,7 @@
-- order reference. The body of _Postconditions must be placed after
-- the declaration of Temp to preserve correct visibility.
- Insert_After_Last_Declaration (
+ Insert_Before_First_Source_Declaration (
Make_Subprogram_Body (Loc,
Specification =>
Make_Procedure_Specification (Loc,