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
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;
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
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;
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);
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 --
--------------
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 =>
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;
projects / thirdparty / gcc.git / commitdiff
