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
This commit is contained in:
Bob Duff
Arnaud Charlet
parent
701b7fbbff
commit
5334d18ffa
|
|
@ -1,3 +1,11 @@
|
|||
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>
|
||||
|
||||
* sem_ch6.adb: Minor code clean up.
|
||||
|
|
|
|||
|
|
@ -3581,14 +3581,21 @@ package body Exp_Ch5 is
|
|||
Lab_Node : Node_Id;
|
||||
|
||||
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
|
||||
and then Has_Postconditions (Scope_Id)
|
||||
then
|
||||
pragma Assert (Present (Postcondition_Proc (Scope_Id)));
|
||||
Insert_Action (N,
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name => Make_Identifier (Loc, Name_uPostconditions)));
|
||||
Name => New_Reference_To (Postcondition_Proc (Scope_Id), Loc)));
|
||||
end if;
|
||||
|
||||
-- If it is a return from a procedure do no extra steps
|
||||
|
|
|
|||
|
|
@ -4080,7 +4080,34 @@ package body Exp_Ch6 is
|
|||
Loc := Sloc (Last_Stm);
|
||||
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 Add_Return;
|
||||
|
||||
|
|
@ -4282,8 +4309,7 @@ package body Exp_Ch6 is
|
|||
end;
|
||||
|
||||
-- For a procedure, we add a return for all possible syntactic ends
|
||||
-- of the subprogram. Note that reanalysis is not necessary in this
|
||||
-- case since it would require a lot of work and accomplish nothing.
|
||||
-- of the subprogram.
|
||||
|
||||
if Ekind (Spec_Id) = E_Procedure
|
||||
or else Ekind (Spec_Id) = E_Generic_Procedure
|
||||
|
|
|
|||
|
|
@ -270,9 +270,10 @@ package body Sem_Ch6 is
|
|||
Push_Scope (Stm_Entity);
|
||||
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);
|
||||
end if;
|
||||
|
||||
|
|
@ -1936,7 +1937,7 @@ package body Sem_Ch6 is
|
|||
end;
|
||||
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
|
||||
Spec_Decl := Unit_Declaration_Node (Spec_Id);
|
||||
|
|
@ -7850,40 +7851,12 @@ package body Sem_Ch6 is
|
|||
Subp : Entity_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;
|
||||
-- Prag contains an analyzed precondition or postcondition pragma.
|
||||
-- This function copies the pragma, changes it to the corresponding
|
||||
-- Check pragma and returns the Check pragma as the result. The
|
||||
-- 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 --
|
||||
--------------
|
||||
|
|
@ -8062,10 +8035,7 @@ package body Sem_Ch6 is
|
|||
Make_Defining_Identifier (Loc,
|
||||
Chars => Name_uPostconditions);
|
||||
-- The entity for the _Postconditions procedure
|
||||
HSS : constant Node_Id := Handled_Statement_Sequence (N);
|
||||
Handler : Node_Id;
|
||||
begin
|
||||
|
||||
Prepend_To (Declarations (N),
|
||||
Make_Subprogram_Body (Loc,
|
||||
Specification =>
|
||||
|
|
@ -8079,22 +8049,10 @@ package body Sem_Ch6 is
|
|||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => Plist)));
|
||||
|
||||
-- If this is a procedure, add a call to _postconditions to every
|
||||
-- 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 this is a procedure, set the Postcondition_Proc attribute
|
||||
|
||||
if Etype (Subp) = Standard_Void_Type then
|
||||
Add_Post_Call (Statements (HSS), 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;
|
||||
Set_Postcondition_Proc (Spec_Id, Post_Proc);
|
||||
end if;
|
||||
end;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue