[Ada] Expansion in _postconditions confusing CodePeer

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.

4 files changed, 78 insertions, 38 deletions

diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index 29557ec..f42a950 100644
--- 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
index 6b14656..cc6c177 100644
--- 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
index 0315458..7b2676d 100644
--- 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
index 7647b6d..6e209d4 100644
--- 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