Commit 5334d18f by Bob Duff Committed by Arnaud Charlet

exp_ch5.adb, [...]: Move the code that creates a call to the _Postconditions…

exp_ch5.adb, [...]: Move the code that creates a call to the _Postconditions procedure in the case...

2009-04-10  Bob Duff  <duff@adacore.com>

	* exp_ch5.adb, exp_ch6.adb, sem_ch6.adb: Move the code that creates a
	call to the _Postconditions procedure in the case of implicit returns
	from analysis to expansion. This eliminates some duplicated code. Use
	the Postcondition_Proc to find the identity of this procedure during
	expansion.

From-SVN: r145906
parent 701b7fbb
2009-04-10 Bob Duff <duff@adacore.com>
* exp_ch5.adb, exp_ch6.adb, sem_ch6.adb: Move the code that creates a
call to the _Postconditions procedure in the case of implicit returns
from analysis to expansion. This eliminates some duplicated code. Use
the Postcondition_Proc to find the identity of this procedure during
expansion.
2009-04-10 Robert Dewar <dewar@adacore.com> 2009-04-10 Robert Dewar <dewar@adacore.com>
* sem_ch6.adb: Minor code clean up. * sem_ch6.adb: Minor code clean up.
...@@ -3581,14 +3581,21 @@ package body Exp_Ch5 is ...@@ -3581,14 +3581,21 @@ package body Exp_Ch5 is
Lab_Node : Node_Id; Lab_Node : Node_Id;
begin begin
-- Call postconditions procedure if procedure with active postconditions -- Call _Postconditions procedure if procedure with active
-- postconditions. Here, we use the Postcondition_Proc attribute, which
-- is needed for implicitly-generated returns. Functions never
-- have implicitly-generated returns, and there's no room for
-- Postcondition_Proc in E_Function, so we look up the identifier
-- Name_uPostconditions for function returns (see
-- Expand_Simple_Function_Return).
if Ekind (Scope_Id) = E_Procedure if Ekind (Scope_Id) = E_Procedure
and then Has_Postconditions (Scope_Id) and then Has_Postconditions (Scope_Id)
then then
pragma Assert (Present (Postcondition_Proc (Scope_Id)));
Insert_Action (N, Insert_Action (N,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => Make_Identifier (Loc, Name_uPostconditions))); Name => New_Reference_To (Postcondition_Proc (Scope_Id), Loc)));
end if; end if;
-- If it is a return from a procedure do no extra steps -- If it is a return from a procedure do no extra steps
......
...@@ -4080,7 +4080,34 @@ package body Exp_Ch6 is ...@@ -4080,7 +4080,34 @@ package body Exp_Ch6 is
Loc := Sloc (Last_Stm); Loc := Sloc (Last_Stm);
end if; end if;
Append_To (S, Make_Simple_Return_Statement (Loc)); declare
Rtn : constant Node_Id := Make_Simple_Return_Statement (Loc);
begin
-- Append return statement, and set analyzed manually. We
-- can't call Analyze on this return since the scope is wrong.
-- Note: it almost works to push the scope and then do the
-- analyze call, but something goes wrong in some weird cases
-- and it is not worth worrying about ???
Append_To (S, Rtn);
Set_Analyzed (Rtn);
-- Call _Postconditions procedure if appropriate. We need to
-- do this explicitly because we did not analyze the generated
-- return statement above, so the call did not get inserted.
if Ekind (Spec_Id) = E_Procedure
and then Has_Postconditions (Spec_Id)
then
pragma Assert (Present (Postcondition_Proc (Spec_Id)));
Insert_Action (Rtn,
Make_Procedure_Call_Statement (Loc,
Name =>
New_Reference_To (Postcondition_Proc (Spec_Id), Loc)));
end if;
end;
end if; end if;
end Add_Return; end Add_Return;
...@@ -4282,8 +4309,7 @@ package body Exp_Ch6 is ...@@ -4282,8 +4309,7 @@ package body Exp_Ch6 is
end; end;
-- For a procedure, we add a return for all possible syntactic ends -- For a procedure, we add a return for all possible syntactic ends
-- of the subprogram. Note that reanalysis is not necessary in this -- of the subprogram.
-- case since it would require a lot of work and accomplish nothing.
if Ekind (Spec_Id) = E_Procedure if Ekind (Spec_Id) = E_Procedure
or else Ekind (Spec_Id) = E_Generic_Procedure or else Ekind (Spec_Id) = E_Generic_Procedure
......
...@@ -270,9 +270,10 @@ package body Sem_Ch6 is ...@@ -270,9 +270,10 @@ package body Sem_Ch6 is
Push_Scope (Stm_Entity); Push_Scope (Stm_Entity);
end if; end if;
-- Check that pragma No_Return is obeyed -- Check that pragma No_Return is obeyed. Don't complain about the
-- implicitly-generated return that is placed at the end.
if No_Return (Scope_Id) then if No_Return (Scope_Id) and then Comes_From_Source (N) then
Error_Msg_N ("RETURN statement not allowed (No_Return)", N); Error_Msg_N ("RETURN statement not allowed (No_Return)", N);
end if; end if;
...@@ -1936,7 +1937,7 @@ package body Sem_Ch6 is ...@@ -1936,7 +1937,7 @@ package body Sem_Ch6 is
end; end;
end if; end if;
-- If a sep[arate spec is present, then deal with freezing issues -- If a separate spec is present, then deal with freezing issues
if Present (Spec_Id) then if Present (Spec_Id) then
Spec_Decl := Unit_Declaration_Node (Spec_Id); Spec_Decl := Unit_Declaration_Node (Spec_Id);
...@@ -7850,40 +7851,12 @@ package body Sem_Ch6 is ...@@ -7850,40 +7851,12 @@ package body Sem_Ch6 is
Subp : Entity_Id; Subp : Entity_Id;
Parms : List_Id; Parms : List_Id;
procedure Add_Post_Call (Stms : List_Id; Post_Proc : Entity_Id);
-- Add a call to Post_Proc at the end of the statement list
function Grab_PPC (Nam : Name_Id) return Node_Id; function Grab_PPC (Nam : Name_Id) return Node_Id;
-- Prag contains an analyzed precondition or postcondition pragma. -- Prag contains an analyzed precondition or postcondition pragma.
-- This function copies the pragma, changes it to the corresponding -- This function copies the pragma, changes it to the corresponding
-- Check pragma and returns the Check pragma as the result. The -- Check pragma and returns the Check pragma as the result. The
-- argument Nam is either Name_Precondition or Name_Postcondition. -- argument Nam is either Name_Precondition or Name_Postcondition.
-------------------
-- Add_Post_Call --
-------------------
procedure Add_Post_Call (Stms : List_Id; Post_Proc : Entity_Id) is
Last_Stm : Node_Id;
begin
-- Get last statement, ignoring irrelevant nodes
Last_Stm := Last (Stms);
while Nkind (Last_Stm) in N_Pop_xxx_Label loop
Prev (Last_Stm);
end loop;
-- Append the call to the list. This is unnecessary (but harmless) if
-- the end of the list is unreachable, so we do a simple check for
-- Is_Transfer here.
if not Is_Transfer (Last_Stm) then
Append_To (Stms,
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (Post_Proc, Loc)));
end if;
end Add_Post_Call;
-------------- --------------
-- Grab_PPC -- -- Grab_PPC --
-------------- --------------
...@@ -8062,10 +8035,7 @@ package body Sem_Ch6 is ...@@ -8062,10 +8035,7 @@ package body Sem_Ch6 is
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => Name_uPostconditions); Chars => Name_uPostconditions);
-- The entity for the _Postconditions procedure -- The entity for the _Postconditions procedure
HSS : constant Node_Id := Handled_Statement_Sequence (N);
Handler : Node_Id;
begin begin
Prepend_To (Declarations (N), Prepend_To (Declarations (N),
Make_Subprogram_Body (Loc, Make_Subprogram_Body (Loc,
Specification => Specification =>
...@@ -8079,22 +8049,10 @@ package body Sem_Ch6 is ...@@ -8079,22 +8049,10 @@ package body Sem_Ch6 is
Make_Handled_Sequence_Of_Statements (Loc, Make_Handled_Sequence_Of_Statements (Loc,
Statements => Plist))); Statements => Plist)));
-- If this is a procedure, add a call to _postconditions to every -- If this is a procedure, set the Postcondition_Proc attribute
-- place where it could return implicitly (not via a return
-- statement, which are handled elsewhere). This is not necessary
-- for functions, since functions always return via a return
-- statement, or raise an exception.
if Etype (Subp) = Standard_Void_Type then if Etype (Subp) = Standard_Void_Type then
Add_Post_Call (Statements (HSS), Post_Proc); Set_Postcondition_Proc (Spec_Id, Post_Proc);
if Present (Exception_Handlers (HSS)) then
Handler := First_Non_Pragma (Exception_Handlers (HSS));
while Present (Handler) loop
Add_Post_Call (Statements (Handler), Post_Proc);
Next_Non_Pragma (Handler);
end loop;
end if;
end if; end if;
end; end;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment