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

gcc/ada/ChangeLog

+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.

gcc/ada/exp_ch5.adb

@@ -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

gcc/ada/exp_ch6.adb

@@ -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

gcc/ada/sem_ch6.adb

@@ -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;