* [Ada] Expansion in _postconditions confusing CodePeer
@ 2021-05-03 9:29 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-05-03 9:29 UTC (permalink / raw)
To: gcc-patches; +Cc: Justin Squirek
[-- Attachment #1: Type: text/plain, Size: 748 bytes --]
This patch fixes an issue in the compiler whereby extra flags and tests
added to the internally generated _postconditions procedure confused and
caused issues with CodePeer due to it treating the procedure as coming
from source.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* contracts.adb (Build_Postconditions_Procedure): Remove
internally generated if statement used to control finalization
actions.
* exp_ch6.adb (Add_Return, Expand_Non_Function_Return,
Expand_Simple_Function_Return): Add if statement around
_postconditions to control finalization.
* exp_ch7.adb (Build_Finalizer): Likewise.
* sem_prag.adb (Find_Related_Declaration_Or_Body): Add case to
handle Context itself being a handled sequence of statements.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 10420 bytes --]
diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -2367,6 +2367,10 @@ package body Contracts is
-- postconditions until finalization has been performed when cleanup
-- actions are present.
+ -- NOTE: This flag could be made into a predicate since we should be
+ -- able at compile time to recognize when finalization and cleanup
+ -- actions occur, but in practice this is not possible ???
+
-- Generate:
--
-- Postcond_Enabled : Boolean := True;
@@ -2405,16 +2409,16 @@ package body Contracts is
-- the postconditions: this would cause confusing debug info to be
-- produced, interfering with coverage-analysis tools.
- -- Also, wrap the postcondition checks in a conditional which can be
- -- used to delay their evaluation when clean-up actions are present.
+ -- NOTE: Coverage-analysis and static-analysis tools rely on the
+ -- postconditions procedure being free of internally generated code
+ -- since some of these tools, like CodePeer, treat _postconditions
+ -- as original source.
-- Generate:
--
-- procedure _postconditions is
-- begin
- -- if Postcond_Enabled and then Return_Success_For_Postcond then
- -- [Stmts];
- -- end if;
+ -- [Stmts];
-- end;
Proc_Bod :=
@@ -2425,19 +2429,7 @@ package body Contracts is
Handled_Statement_Sequence =>
Make_Handled_Sequence_Of_Statements (Loc,
End_Label => Make_Identifier (Loc, Chars (Proc_Id)),
- Statements => New_List (
- Make_If_Statement (Loc,
- Condition =>
- Make_And_Then (Loc,
- Left_Opnd =>
- New_Occurrence_Of
- (Defining_Identifier
- (Postcond_Enabled_Decl), Loc),
- Right_Opnd =>
- New_Occurrence_Of
- (Defining_Identifier
- (Return_Success_Decl), Loc)),
- Then_Statements => Stmts))));
+ Statements => Stmts));
Insert_After_And_Analyze (Last_Decl, Proc_Bod);
end Build_Postconditions_Procedure;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6246,7 +6246,8 @@ package body Exp_Ch6 is
-- has contract assertions that need to be verified on exit.
-- Also, mark the successful return to signal that postconditions
- -- need to be evaluated when finalization occurs.
+ -- need to be evaluated when finalization occurs by setting
+ -- Return_Success_For_Postcond to be True.
if Ekind (Spec_Id) = E_Procedure
and then Present (Postconditions_Proc (Spec_Id))
@@ -6254,19 +6255,30 @@ package body Exp_Ch6 is
-- Generate:
--
-- Return_Success_For_Postcond := True;
- -- _postconditions;
+ -- if Postcond_Enabled then
+ -- _postconditions;
+ -- end if;
Insert_Action (Stmt,
Make_Assignment_Statement (Loc,
Name =>
New_Occurrence_Of
- (Get_Return_Success_For_Postcond (Spec_Id), Loc),
+ (Get_Return_Success_For_Postcond (Spec_Id), Loc),
Expression => New_Occurrence_Of (Standard_True, Loc)));
+ -- Wrap the call to _postconditions within a test of the
+ -- Postcond_Enabled flag to delay postcondition evaluation
+ -- until after finalization when required.
+
Insert_Action (Stmt,
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (Postconditions_Proc (Spec_Id), Loc)));
+ Make_If_Statement (Loc,
+ Condition =>
+ New_Occurrence_Of (Get_Postcond_Enabled (Spec_Id), Loc),
+ Then_Statements => New_List (
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Occurrence_Of
+ (Postconditions_Proc (Spec_Id), Loc)))));
end if;
-- Ada 2020 (AI12-0279): append the call to 'Yield unless this is
@@ -6699,7 +6711,9 @@ package body Exp_Ch6 is
-- Generate:
--
-- Return_Success_For_Postcond := True;
- -- _postconditions;
+ -- if Postcond_Enabled then
+ -- _postconditions;
+ -- end if;
Insert_Action (N,
Make_Assignment_Statement (Loc,
@@ -6708,9 +6722,19 @@ package body Exp_Ch6 is
(Get_Return_Success_For_Postcond (Scope_Id), Loc),
Expression => New_Occurrence_Of (Standard_True, Loc)));
+ -- Wrap the call to _postconditions within a test of the
+ -- Postcond_Enabled flag to delay postcondition evaluation until
+ -- after finalization when required.
+
Insert_Action (N,
- Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (Postconditions_Proc (Scope_Id), Loc)));
+ Make_If_Statement (Loc,
+ Condition =>
+ New_Occurrence_Of (Get_Postcond_Enabled (Scope_Id), Loc),
+ Then_Statements => New_List (
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Occurrence_Of
+ (Postconditions_Proc (Scope_Id), Loc)))));
end if;
-- Ada 2020 (AI12-0279)
@@ -7621,6 +7645,9 @@ package body Exp_Ch6 is
-- Generate:
--
-- Return_Success_For_Postcond := True;
+ -- if Postcond_Enabled then
+ -- _Postconditions ([exp]);
+ -- end if;
Insert_Action (Exp,
Make_Assignment_Statement (Loc,
@@ -7629,13 +7656,20 @@ package body Exp_Ch6 is
(Get_Return_Success_For_Postcond (Scope_Id), Loc),
Expression => New_Occurrence_Of (Standard_True, Loc)));
- -- Generate call to _Postconditions
+ -- Wrap the call to _postconditions within a test of the
+ -- Postcond_Enabled flag to delay postcondition evaluation until
+ -- after finalization when required.
Insert_Action (Exp,
- Make_Procedure_Call_Statement (Loc,
- Name =>
- New_Occurrence_Of (Postconditions_Proc (Scope_Id), Loc),
- Parameter_Associations => New_List (New_Copy_Tree (Exp))));
+ Make_If_Statement (Loc,
+ Condition =>
+ New_Occurrence_Of (Get_Postcond_Enabled (Scope_Id), Loc),
+ Then_Statements => New_List (
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Occurrence_Of
+ (Postconditions_Proc (Scope_Id), Loc),
+ Parameter_Associations => New_List (New_Copy_Tree (Exp))))));
end if;
-- Ada 2005 (AI-251): If this return statement corresponds with an
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -3795,7 +3795,9 @@ package body Exp_Ch7 is
-- -- Perform postcondition checks after general finalization, but
-- -- before finalization of 'Old related objects.
--
- -- if not Raised_Finalization_Exception then
+ -- if not Raised_Finalization_Exception
+ -- and then Return_Success_For_Postcond
+ -- then
-- begin
-- -- Re-enable postconditions and check them
--
@@ -3973,7 +3975,9 @@ package body Exp_Ch7 is
-- Generate:
--
- -- if not Raised_Finalization_Exception then
+ -- if not Raised_Finalization_Exception
+ -- and then Return_Success_For_Postcond
+ -- then
-- begin
-- Postcond_Enabled := True;
-- _postconditions [(Result_Obj_For_Postcond[.all])];
@@ -3988,10 +3992,15 @@ package body Exp_Ch7 is
Append_To (Fin_Controller_Stmts,
Make_If_Statement (Loc,
Condition =>
- Make_Op_Not (Loc,
+ Make_And_Then (Loc,
+ Left_Opnd =>
+ Make_Op_Not (Loc,
+ Right_Opnd =>
+ New_Occurrence_Of
+ (Raised_Finalization_Exception_Id, Loc)),
Right_Opnd =>
New_Occurrence_Of
- (Raised_Finalization_Exception_Id, Loc)),
+ (Get_Return_Success_For_Postcond (Def_Ent), Loc)),
Then_Statements => New_List (
Make_Block_Statement (Loc,
Handled_Statement_Sequence =>
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -30689,14 +30689,19 @@ package body Sem_Prag is
elsif Nkind (Context) = N_Entry_Body then
return Context;
- -- The pragma appears inside the statements of a subprogram body. This
- -- placement is the result of subprogram contract expansion.
+ -- The pragma appears inside the statements of a subprogram body at
+ -- some nested level.
elsif Is_Statement (Context)
and then Present (Enclosing_HSS (Context))
then
return Parent (Enclosing_HSS (Context));
+ -- The pragma appears directly in the statements of a subprogram body
+
+ elsif Nkind (Context) = N_Handled_Sequence_Of_Statements then
+ return Parent (Context);
+
-- The pragma appears inside the declarative part of a package body
elsif Nkind (Context) = N_Package_Body then
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-05-03 9:29 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-05-03 9:29 [Ada] Expansion in _postconditions confusing CodePeer Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).