2014-02-25 Hristian Kirtchev <kirtchev@adacore.com>

	* exp_ch6.adb (Add_Or_Save_Precondition): New routine.
	(Collect_Body_Postconditions_In_Decls): New routine.
	(Collect_Body_Postconditions_Of_Kind): Factor out code. Handle
	postcondition aspects or pragmas that appear on a subprogram
	body stub.
	(Collect_Spec_Preconditions): Factor out code. Handle
	precondition aspects or pragmas that appear on a subprogram
	body stub.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): The analysis of
	aspects that apply to a subprogram body stub is no longer delayed,
	the aspects are analyzed on the spot.
	(SPARK_Aspect_Error):
	Aspects that apply to a subprogram declaration cannot appear in
	a subunit.
	* sem_ch10.adb Remove with and use clause for Sem_Ch13.
	(Analyze_Proper_Body): Add local variable Comp_Unit. Unum
	is now a local variable. Code cleanup. Analysis related to
	the aspects of a subprogram body stub is now carried out by
	Analyze_Subprogram_Body_Helper. Do not propagate the aspects
	and/or pragmas of a subprogram body stub to the proper body
	as this is no longer needed. Do not analyze the aspects of a
	subprogram stub when the corresponding source unit is missing.
	(Analyze_Protected_Body_Stub): Flag the illegal use of aspects
	on a stub.
	(Analyze_Task_Body_Stub): Flag the illegal use of
	aspects on a stub.
	(Optional_Subunit): Add local variable Unum.
	* sem_ch13.adb (Insert_Delayed_Pragma): Do not analyze a generated
	pragma when it applies to a subprogram body stub.
	* sem_prag.adb (Analyze_Pragma): Pragmas Contract_Cases,
	Depends and Global can now apply to a subprogram body stub as
	long as it acts as its own spec.
	(Analyze_Refined_Pragma):
	Code reformatting. Refinement pragmas cannot apply to a subunit.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@208134 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 323 insertions, 170 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ed288b3d053..ad3b82d2086 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,42 @@
 2014-02-25  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* exp_ch6.adb (Add_Or_Save_Precondition): New routine.
+	(Collect_Body_Postconditions_In_Decls): New routine.
+	(Collect_Body_Postconditions_Of_Kind): Factor out code. Handle
+	postcondition aspects or pragmas that appear on a subprogram
+	body stub.
+	(Collect_Spec_Preconditions): Factor out code. Handle
+	precondition aspects or pragmas that appear on a subprogram
+	body stub.
+	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): The analysis of
+	aspects that apply to a subprogram body stub is no longer delayed,
+	the aspects are analyzed on the spot.
+	(SPARK_Aspect_Error):
+	Aspects that apply to a subprogram declaration cannot appear in
+	a subunit.
+	* sem_ch10.adb Remove with and use clause for Sem_Ch13.
+	(Analyze_Proper_Body): Add local variable Comp_Unit. Unum
+	is now a local variable. Code cleanup. Analysis related to
+	the aspects of a subprogram body stub is now carried out by
+	Analyze_Subprogram_Body_Helper. Do not propagate the aspects
+	and/or pragmas of a subprogram body stub to the proper body
+	as this is no longer needed. Do not analyze the aspects of a
+	subprogram stub when the corresponding source unit is missing.
+	(Analyze_Protected_Body_Stub): Flag the illegal use of aspects
+	on a stub.
+	(Analyze_Task_Body_Stub): Flag the illegal use of
+	aspects on a stub.
+	(Optional_Subunit): Add local variable Unum.
+	* sem_ch13.adb (Insert_Delayed_Pragma): Do not analyze a generated
+	pragma when it applies to a subprogram body stub.
+	* sem_prag.adb (Analyze_Pragma): Pragmas Contract_Cases,
+	Depends and Global can now apply to a subprogram body stub as
+	long as it acts as its own spec.
+	(Analyze_Refined_Pragma):
+	Code reformatting. Refinement pragmas cannot apply to a subunit.
+
+2014-02-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* einfo.ads Update the usage of flag
 	Uses_Sec_Stack. Uses_Sec_Stack now applies to E_Loop entities.
 	* exp_ch5.adb (Expand_Iterator_Loop): The temporary for a cursor
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 5ffea6acc3f..4aa43ba10d5 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -8671,58 +8671,100 @@ package body Exp_Ch6 is
 
       procedure Collect_Body_Postconditions (Stmts : in out List_Id) is
          procedure Collect_Body_Postconditions_Of_Kind (Post_Nam : Name_Id);
-         --  Process postconditions of a particular kind denoted by Post_Nam
+         --  Process all postconditions of a particular kind denoted by
+         --  Post_Nam.
 
          -----------------------------------------
          -- Collect_Body_Postconditions_Of_Kind --
          -----------------------------------------
 
          procedure Collect_Body_Postconditions_Of_Kind (Post_Nam : Name_Id) is
-            Check_Prag : Node_Id;
-            Decl       : Node_Id;
+            procedure Collect_Body_Postconditions_In_Decls
+              (First_Decl : Node_Id);
+            --  Process all postconditions found in a declarative list starting
+            --  with declaration First_Decl.
 
-         begin
-            pragma Assert (Nam_In (Post_Nam, Name_Postcondition,
-                                             Name_Refined_Post));
+            ------------------------------------------
+            -- Collect_Body_Postconditions_In_Decls --
+            ------------------------------------------
 
-            --  Inspect the declarations of the subprogram body looking for a
-            --  pragma that matches the desired name.
+            procedure Collect_Body_Postconditions_In_Decls
+              (First_Decl : Node_Id)
+            is
+               Check_Prag : Node_Id;
+               Decl       : Node_Id;
 
-            Decl := First (Declarations (N));
-            while Present (Decl) loop
-               if Nkind (Decl) = N_Pragma then
-                  if Pragma_Name (Decl) = Post_Nam then
-                     Analyze (Decl);
-                     Check_Prag := Build_Pragma_Check_Equivalent (Decl);
+            begin
+               --  Inspect the declarative list looking for a pragma that
+               --  matches the desired name.
 
-                     if Expander_Active then
-                        Append_Enabled_Item
-                          (Item => Check_Prag,
-                           List => Stmts);
+               Decl := First_Decl;
+               while Present (Decl) loop
 
-                     --  When analyzing a generic unit, save the pragma for
-                     --  later.
+                  --  Note that non-matching pragmas are skipped
 
-                     else
-                        Prepend_To_Declarations (Check_Prag);
+                  if Nkind (Decl) = N_Pragma then
+                     if Pragma_Name (Decl) = Post_Nam then
+                        if not Analyzed (Decl) then
+                           Analyze (Decl);
+                        end if;
+
+                        Check_Prag := Build_Pragma_Check_Equivalent (Decl);
+
+                        if Expander_Active then
+                           Append_Enabled_Item
+                             (Item => Check_Prag,
+                              List => Stmts);
+
+                        --  When analyzing a generic unit, save the pragma for
+                        --  later.
+
+                        else
+                           Prepend_To_Declarations (Check_Prag);
+                        end if;
                      end if;
+
+                  --  Skip internally generated code
+
+                  elsif not Comes_From_Source (Decl) then
+                     null;
+
+                  --  Postcondition pragmas are usually grouped together. There
+                  --  is no need to inspect the whole declarative list.
+
+                  else
+                     exit;
                   end if;
 
-               --  Skip internally generated code
+                  Next (Decl);
+               end loop;
+            end Collect_Body_Postconditions_In_Decls;
 
-               elsif not Comes_From_Source (Decl) then
-                  null;
+            --  Local variables
 
-               --  Postconditions in bodies are usually grouped at the top of
-               --  the declarations. There is no point in inspecting the whole
-               --  source list.
+            Unit_Decl : constant Node_Id := Parent (N);
 
-               else
-                  exit;
-               end if;
+         --  Start of processing for Collect_Body_Postconditions_Of_Kind
 
-               Next (Decl);
-            end loop;
+         begin
+            pragma Assert (Nam_In (Post_Nam, Name_Postcondition,
+                                             Name_Refined_Post));
+
+            --  Inspect the declarations of the subprogram body looking for a
+            --  pragma that matches the desired name.
+
+            Collect_Body_Postconditions_In_Decls
+              (First_Decl => First (Declarations (N)));
+
+            --  The subprogram body being processed is actually the proper body
+            --  of a stub with a corresponding spec. The subprogram stub may
+            --  carry a postcondition pragma in which case it must be taken
+            --  into account. The pragma appears after the stub.
+
+            if Present (Spec_Id) and then Nkind (Unit_Decl) = N_Subunit then
+               Collect_Body_Postconditions_In_Decls
+                 (First_Decl => Next (Corresponding_Stub (Unit_Decl)));
+            end if;
          end Collect_Body_Postconditions_Of_Kind;
 
       --  Start of processing for Collect_Body_Postconditions
@@ -8808,11 +8850,45 @@ package body Exp_Ch6 is
       --------------------------------
 
       procedure Collect_Spec_Preconditions (Subp_Id : Entity_Id) is
+         Class_Pre : Node_Id := Empty;
+         --  The sole class-wide precondition pragma that applies to the
+         --  subprogram.
+
+         procedure Add_Or_Save_Precondition (Prag : Node_Id);
+         --  Save a class-wide precondition or add a regulat precondition to
+         --  the declarative list of the body.
+
          procedure Merge_Preconditions (From : Node_Id; Into : Node_Id);
          --  Merge two class-wide preconditions by "or else"-ing them. The
          --  changes are accumulated in parameter Into. Update the error
          --  message of Into.
 
+         ------------------------------
+         -- Add_Or_Save_Precondition --
+         ------------------------------
+
+         procedure Add_Or_Save_Precondition (Prag : Node_Id) is
+            Check_Prag : Node_Id;
+
+         begin
+            Check_Prag := Build_Pragma_Check_Equivalent (Prag);
+
+            --  Save the sole class-wide precondition (if any) for the next
+            --  step where it will be merged with inherited preconditions.
+
+            if Class_Present (Prag) then
+               pragma Assert (No (Class_Pre));
+               Class_Pre := Check_Prag;
+
+            --  Accumulate the corresponding Check pragmas to the top of the
+            --  declarations. Prepending the items ensures that they will be
+            --  evaluated in their original order.
+
+            else
+               Prepend_To_Declarations (Check_Prag);
+            end if;
+         end Add_Or_Save_Precondition;
+
          -------------------------
          -- Merge_Preconditions --
          -------------------------
@@ -8889,8 +8965,9 @@ package body Exp_Ch6 is
 
          Inher_Subps   : constant Subprogram_List :=
                            Inherited_Subprograms (Subp_Id);
+         Subp_Decl     : constant Node_Id := Parent (Parent (Subp_Id));
          Check_Prag    : Node_Id;
-         Class_Pre     : Node_Id := Empty;
+         Decl          : Node_Id;
          Inher_Subp_Id : Entity_Id;
          Prag          : Node_Id;
 
@@ -8902,25 +8979,49 @@ package body Exp_Ch6 is
          Prag := Pre_Post_Conditions (Contract (Subp_Id));
          while Present (Prag) loop
             if Pragma_Name (Prag) = Name_Precondition then
-               Check_Prag := Build_Pragma_Check_Equivalent (Prag);
+               Add_Or_Save_Precondition (Prag);
+            end if;
 
-               --  Save the sole class-wide precondition (if any) for the next
-               --  step where it will be merged with inherited preconditions.
+            Prag := Next_Pragma (Prag);
+         end loop;
 
-               if Class_Present (Prag) then
-                  Class_Pre := Check_Prag;
+         --  The subprogram declaration being processed is actually a body
+         --  stub. The stub may carry a precondition pragma in which case it
+         --  must be taken into account. The pragma appears after the stub.
 
-               --  Accumulate the corresponding Check pragmas to the top of the
-               --  declarations. Prepending the items ensures that they will
-               --  be evaluated in their original order.
+         if Nkind (Subp_Decl) = N_Subprogram_Body_Stub then
+
+            --  Inspect the declarations following the body stub
+
+            Decl := Next (Subp_Decl);
+            while Present (Decl) loop
+
+               --  Note that non-matching pragmas are skipped
+
+               if Nkind (Decl) = N_Pragma then
+                  if Pragma_Name (Decl) = Name_Precondition then
+                     if not Analyzed (Decl) then
+                        Analyze (Decl);
+                     end if;
+
+                     Add_Or_Save_Precondition (Decl);
+                  end if;
+
+               --  Skip internally generated code
+
+               elsif not Comes_From_Source (Decl) then
+                  null;
+
+               --  Preconditions are usually grouped together. There is no need
+               --  to inspect the whole declarative list.
 
                else
-                  Prepend_To_Declarations (Check_Prag);
+                  exit;
                end if;
-            end if;
 
-            Prag := Next_Pragma (Prag);
-         end loop;
+               Next (Decl);
+            end loop;
+         end if;
 
          --  Process the contracts of all inherited subprograms, looking for
          --  class-wide preconditions.
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 7714526ae99..df4aacf6fc6 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -53,7 +53,6 @@ with Sem_Ch3;  use Sem_Ch3;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch7;  use Sem_Ch7;
 with Sem_Ch8;  use Sem_Ch8;
-with Sem_Ch13; use Sem_Ch13;
 with Sem_Dist; use Sem_Dist;
 with Sem_Prag; use Sem_Prag;
 with Sem_Util; use Sem_Util;
@@ -1558,7 +1557,6 @@ package body Sem_Ch10 is
 
    procedure Analyze_Proper_Body (N : Node_Id; Nam : Entity_Id) is
       Subunit_Name : constant Unit_Name_Type := Get_Unit_Name (N);
-      Unum         : Unit_Number_Type;
 
       procedure Optional_Subunit;
       --  This procedure is called when the main unit is a stub, or when we
@@ -1573,6 +1571,7 @@ package body Sem_Ch10 is
 
       procedure Optional_Subunit is
          Comp_Unit : Node_Id;
+         Unum      : Unit_Number_Type;
 
       begin
          --  Try to load subunit, but ignore any errors that occur during the
@@ -1633,7 +1632,8 @@ package body Sem_Ch10 is
 
       --  Local variables
 
-      Stub_Id : Entity_Id;
+      Comp_Unit : Node_Id;
+      Unum      : Unit_Number_Type;
 
    --  Start of processing for Analyze_Proper_Body
 
@@ -1787,86 +1787,45 @@ package body Sem_Ch10 is
                   Write_Eol;
                end if;
 
-               declare
-                  Comp_Unit : constant Node_Id := Cunit (Unum);
-                  Prop_Body : Node_Id;
-
-               begin
-                  --  Check for child unit instead of subunit
-
-                  if Nkind (Unit (Comp_Unit)) /= N_Subunit then
-                     Error_Msg_N
-                       ("expected SEPARATE subunit, found child unit",
-                        Cunit_Entity (Unum));
-
-                  --  OK, we have a subunit
-
-                  else
-                     Prop_Body := Proper_Body (Unit (Comp_Unit));
-
-                     --  Set corresponding stub (even if errors)
+               Comp_Unit := Cunit (Unum);
 
-                     Set_Corresponding_Stub (Unit (Comp_Unit), N);
+               --  Check for child unit instead of subunit
 
-                     --  Collect SCO information for loaded subunit if we are
-                     --  in the main unit.
+               if Nkind (Unit (Comp_Unit)) /= N_Subunit then
+                  Error_Msg_N
+                    ("expected SEPARATE subunit, found child unit",
+                     Cunit_Entity (Unum));
 
-                     if Generate_SCO
-                       and then
-                         In_Extended_Main_Source_Unit
-                           (Cunit_Entity (Current_Sem_Unit))
-                     then
-                        SCO_Record (Unum);
-                     end if;
-
-                     --  Propagate all aspect specifications associated with
-                     --  the stub to the proper body.
-
-                     Move_Or_Merge_Aspects (From => N, To => Prop_Body);
-
-                     --  Move all source pragmas that follow the body stub and
-                     --  apply to it to the declarations of the proper body.
+               --  OK, we have a subunit
 
-                     if Nkind (N) = N_Subprogram_Body_Stub then
-                        Relocate_Pragmas_To_Body (N, Target_Body => Prop_Body);
-                     end if;
-
-                     --  Analyze the unit if semantics active
-
-                     if not Fatal_Error (Unum) or else Try_Semantics then
-                        Analyze_Subunit (Comp_Unit);
-                     end if;
+               else
+                  Set_Corresponding_Stub (Unit (Comp_Unit), N);
+                  Set_Library_Unit (N, Comp_Unit);
 
-                     --  Set the library unit pointer in any case
+                  --  We update the version. Although we are not technically
+                  --  semantically dependent on the subunit, given our approach
+                  --  of macro substitution of subunits, it makes sense to
+                  --  include it in the version identification.
 
-                     Set_Library_Unit (N, Comp_Unit);
+                  Version_Update (Cunit (Main_Unit), Comp_Unit);
 
-                     --  We update the version. Although we are not technically
-                     --  semantically dependent on the subunit, given our
-                     --  approach of macro substitution of subunits, it makes
-                     --  sense to include it in the version identification.
+                  --  Collect SCO information for loaded subunit if we are in
+                  --  the main unit.
 
-                     Version_Update (Cunit (Main_Unit), Comp_Unit);
+                  if Generate_SCO
+                    and then
+                      In_Extended_Main_Source_Unit
+                        (Cunit_Entity (Current_Sem_Unit))
+                  then
+                     SCO_Record (Unum);
                   end if;
-               end;
-
-            --  The unit which should contain the proper subprogram body does
-            --  not exist. Analyze the aspect specifications of the stub (if
-            --  any).
-
-            elsif Nkind (N) = N_Subprogram_Body_Stub
-              and then Has_Aspects (N)
-            then
-               Stub_Id := Defining_Unit_Name (Specification (N));
-
-               --  Restore the proper visibility of the stub and its formals
-
-               Push_Scope (Stub_Id);
-               Install_Formals (Stub_Id);
 
-               Analyze_Aspect_Specifications (N, Stub_Id);
+                  --  Analyze the unit if semantics active
 
-               Pop_Scope;
+                  if not Fatal_Error (Unum) or else Try_Semantics then
+                     Analyze_Subunit (Comp_Unit);
+                  end if;
+               end if;
             end if;
          end if;
 
@@ -1901,6 +1860,17 @@ package body Sem_Ch10 is
          Error_Msg_N ("missing specification for Protected body", N);
 
       else
+         --  Currently there are no language-defined aspects that can apply to
+         --  a protected body stub. Issue an error and remove the aspects to
+         --  prevent cascaded errors.
+
+         if Has_Aspects (N) then
+            Error_Msg_N
+              ("aspects on protected bodies are not allowed",
+               First (Aspect_Specifications (N)));
+            Remove_Aspects (N);
+         end if;
+
          Set_Scope (Defining_Entity (N), Current_Scope);
          Set_Has_Completion (Etype (Nam));
          Set_Corresponding_Spec_Of_Stub (N, Nam);
@@ -2351,7 +2321,19 @@ package body Sem_Ch10 is
 
       if No (Nam) or else not Is_Task_Type (Etype (Nam)) then
          Error_Msg_N ("missing specification for task body", N);
+
       else
+         --  Currently there are no language-defined aspects that can apply to
+         --  a task body stub. Issue an error and remove the aspects to prevent
+         --  cascaded errors.
+
+         if Has_Aspects (N) then
+            Error_Msg_N
+              ("aspects on task bodies are not allowed",
+               First (Aspect_Specifications (N)));
+            Remove_Aspects (N);
+         end if;
+
          Set_Scope (Defining_Entity (N), Current_Scope);
          Generate_Reference (Nam, Defining_Identifier (N), 'b');
          Set_Corresponding_Spec_Of_Stub (N, Nam);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index efa359fdb97..d8c71d778cb 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1234,14 +1234,6 @@ package body Sem_Ch13 is
 
          else
             Insert_After (N, Prag);
-
-            --  Analyze the pragma before analyzing the proper body of a stub.
-            --  This ensures that the pragma will appear on the proper contract
-            --  list (see N_Contract).
-
-            if Nkind (N) = N_Subprogram_Body_Stub then
-               Analyze (Prag);
-            end if;
          end if;
       end Insert_Delayed_Pragma;
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index ff3cbf25c2d..2433b32392d 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2485,8 +2485,17 @@ package body Sem_Ch6 is
 
             if Has_Aspect (Spec_Id, Asp_Id) then
                Error_Msg_Name_1 := Asp_Nam;
-               Error_Msg_Name_2 := Ref_Nam;
-               Error_Msg_N ("aspect % should be %", Asp);
+
+               --  Subunits cannot carry aspects that apply to a subprogram
+               --  declaration.
+
+               if Nkind (Parent (N)) = N_Subunit then
+                  Error_Msg_N ("aspect % cannot apply to a subunit", Asp);
+
+               else
+                  Error_Msg_Name_2 := Ref_Nam;
+                  Error_Msg_N ("aspect % should be %", Asp);
+               end if;
 
             --  Otherwise the aspect must appear in the spec, not in the body:
 
@@ -2912,28 +2921,16 @@ package body Sem_Ch6 is
          end if;
       end if;
 
-      --  Language-defined aspects cannot appear in a subprogram body [stub] if
-      --  the subprogram has a separate spec. Certainly implementation-defined
-      --  aspects are allowed to appear (per Aspects_On_Body_Of_Stub_OK).
+      --  Language-defined aspects cannot appear on a subprogram body [stub] if
+      --  the subprogram has a spec. Certain implementation-defined aspects are
+      --  allowed to break this rule (see table Aspect_On_Body_Or_Stub_OK).
 
       if Has_Aspects (N) then
          if Present (Spec_Id)
            and then not Aspects_On_Body_Or_Stub_OK (N)
-
-            --  Do not emit an error on a subprogram body stub that act as
-            --  its own spec.
-
-           and then Nkind (Parent (Parent (Spec_Id))) /= N_Subprogram_Body_Stub
          then
             Diagnose_Misplaced_Aspect_Specifications;
 
-         --  Delay the analysis of aspect specifications that apply to a body
-         --  stub until the proper body is analyzed. If the corresponding body
-         --  is missing, the aspects are still analyzed in Analyze_Proper_Body.
-
-         elsif Nkind (N) in N_Body_Stub then
-            null;
-
          else
             Analyze_Aspect_Specifications (N, Body_Id);
          end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 2b095eabbf6..a5eaf1304bd 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3601,40 +3601,42 @@ package body Sem_Prag is
 
          Body_Decl := Find_Related_Subprogram_Or_Body (N, Do_Checks => True);
 
-         if not Nkind_In (Body_Decl, N_Subprogram_Body,
-                                     N_Subprogram_Body_Stub)
-         then
-            Pragma_Misplaced;
-            return;
-         end if;
-
-         Body_Id := Defining_Entity (Body_Decl);
-
-         --  The body [stub] must not act as a spec, in other words it has to
-         --  be paired with a corresponding spec.
+         --  Extract the entities of the spec and body
 
          if Nkind (Body_Decl) = N_Subprogram_Body then
+            Body_Id := Defining_Entity (Body_Decl);
             Spec_Id := Corresponding_Spec (Body_Decl);
-         else
+
+         elsif Nkind (Body_Decl) = N_Subprogram_Body_Stub then
+            Body_Id := Defining_Entity (Body_Decl);
             Spec_Id := Corresponding_Spec_Of_Stub (Body_Decl);
+
+         else
+            Pragma_Misplaced;
+            return;
          end if;
 
+         --  The pragma must apply to the second declaration of a subprogram.
+         --  In other words, the body [stub] cannot acts as a spec.
+
          if No (Spec_Id) then
             Error_Pragma ("pragma % cannot apply to a stand alone body");
             return;
+
+         --  Catch the case where the subprogram body is a subunit and acts as
+         --  the third declaration of the subprogram.
+
+         elsif Nkind (Parent (Body_Decl)) = N_Subunit then
+            Error_Pragma ("pragma % cannot apply to a subunit");
+            return;
          end if;
 
-         --  The pragma may only apply to the body [stub] of a subprogram
+         --  The pragma can only apply to the body [stub] of a subprogram
          --  declared in the visible part of a package. Retrieve the context of
          --  the subprogram declaration.
 
          Spec_Decl := Parent (Parent (Spec_Id));
 
-         pragma Assert
-           (Nkind_In (Spec_Decl, N_Abstract_Subprogram_Declaration,
-                                 N_Generic_Subprogram_Declaration,
-                                 N_Subprogram_Declaration));
-
          if Nkind (Parent (Spec_Decl)) /= N_Package_Specification then
             Error_Pragma
               ("pragma % must apply to the body of a subprogram declared in a "
@@ -12445,10 +12447,24 @@ package body Sem_Prag is
             Subp_Decl :=
               Find_Related_Subprogram_Or_Body (N, Do_Checks => True);
 
-            if Nkind (Subp_Decl) /= N_Subprogram_Declaration
-              and then (Nkind (Subp_Decl) /= N_Subprogram_Body
-                         or else not Acts_As_Spec (Subp_Decl))
+            if Nkind (Subp_Decl) = N_Subprogram_Declaration then
+               null;
+
+            --  Body acts as spec
+
+            elsif Nkind (Subp_Decl) = N_Subprogram_Body
+              and then No (Corresponding_Spec (Subp_Decl))
+            then
+               null;
+
+            --  Body stub acts as spec
+
+            elsif Nkind (Subp_Decl) = N_Subprogram_Body_Stub
+              and then No (Corresponding_Spec_Of_Stub (Subp_Decl))
             then
+               null;
+
+            else
                Pragma_Misplaced;
                return;
             end if;
@@ -12969,10 +12985,24 @@ package body Sem_Prag is
             Subp_Decl :=
               Find_Related_Subprogram_Or_Body (N, Do_Checks => True);
 
-            if Nkind (Subp_Decl) /= N_Subprogram_Declaration
-              and then (Nkind (Subp_Decl) /= N_Subprogram_Body
-                          or else not Acts_As_Spec (Subp_Decl))
+            if Nkind (Subp_Decl) = N_Subprogram_Declaration then
+               null;
+
+            --  Body acts as spec
+
+            elsif Nkind (Subp_Decl) = N_Subprogram_Body
+              and then No (Corresponding_Spec (Subp_Decl))
             then
+               null;
+
+            --  Body stub acts as spec
+
+            elsif Nkind (Subp_Decl) = N_Subprogram_Body_Stub
+              and then No (Corresponding_Spec_Of_Stub (Subp_Decl))
+            then
+               null;
+
+            else
                Pragma_Misplaced;
                return;
             end if;
@@ -14239,10 +14269,24 @@ package body Sem_Prag is
             Subp_Decl :=
               Find_Related_Subprogram_Or_Body (N, Do_Checks => True);
 
-            if Nkind (Subp_Decl) /= N_Subprogram_Declaration
-              and then (Nkind (Subp_Decl) /= N_Subprogram_Body
-                          or else not Acts_As_Spec (Subp_Decl))
+            if Nkind (Subp_Decl) = N_Subprogram_Declaration then
+               null;
+
+            --  Body acts as spec
+
+            elsif Nkind (Subp_Decl) = N_Subprogram_Body
+              and then No (Corresponding_Spec (Subp_Decl))
             then
+               null;
+
+            --  Body stub acts as spec
+
+            elsif Nkind (Subp_Decl) = N_Subprogram_Body_Stub
+              and then No (Corresponding_Spec_Of_Stub (Subp_Decl))
+            then
+               null;
+
+            else
                Pragma_Misplaced;
                return;
             end if;