This patch reimplements the support for SPARK aspects/pragmas that apply to a
subprogram body stub and implements a missing rule which forbids the placement
of refinement annotations in subunits.
------------
-- Source --
------------
-- error.ads
package Error
with SPARK_Mode => On,
Abstract_State => State
is
procedure Spec_Stub_Body_1
with Global => (In_Out => State);
procedure Spec_Stub_Body_2
with Global => (In_Out => State),
Depends => (State => State);
procedure Spec_Stub_Body_3
with Global => (In_Out => State),
Depends => (State => State);
procedure Spec_Stub_Body_4
with Global => (In_Out => State),
Depends => (State => State);
procedure Spec_Stub_Body_5
with Global => (In_Out => State),
Depends => (State => State);
end Error;
-- error.adb
package body Error
with SPARK_Mode => On,
Refined_State => (State => (A, B))
is
A : Integer := 1;
B : Integer := 2;
procedure Spec_Stub_Body_1 is separate
with Depends => (A => B); -- error
-- Depends must appear on the spec (first declaration)
procedure Spec_Stub_Body_2 is separate
with Refined_Global => (In_Out => (A, B));
-- Refined_Depends must appear on the stub (second declaration)
procedure Spec_Stub_Body_3 is separate;
-- Refined_Global and Refined_Depends must appear on the stub (second
-- declaration).
procedure Spec_Stub_Body_4 is separate
with Refined_Global => (In_Out => (A, "error")),
Refined_Depends => ("error" => B);
-- Refined_Global and Refined_Depends are placed properly, but malformed
procedure Spec_Stub_Body_5 is separate
with Refined_Global => (In_Out => (A, "error")),
Refined_Depends => ("error" => B);
-- Refined_Global and Refined_Depends are placed properly, but malformed. A
-- proper body is also missing.
procedure Stub_Body is separate
with Global => (In_Out => (A, B)),
Depends => (A => B);
-- Refined_Global and Refined_Depends apply to a body whose spec (the
-- stub) is not visible.
end Error;
-- error-spec_stub_body_1.adb
separate (Error)
procedure Spec_Stub_Body_1 is begin null; end Spec_Stub_Body_1;
-- error-spec_stub_body_2.adb
separate (Error)
procedure Spec_Stub_Body_2
with Refined_Depends => (A => B) -- error
is begin null; end Spec_Stub_Body_2;
-- error-spec_stub_body_3.adb
separate (Error)
procedure Spec_Stub_Body_3
with Refined_Global => (In_Out => (A, B)), -- error
Refined_Depends => (A => B) -- error
is begin null; end Spec_Stub_Body_3;
-- error-spec_stub_body_4.adb
separate (Error)
procedure Spec_Stub_Body_4 is begin null; end Spec_Stub_Body_4;
----------------------------
-- Compilation and output --
----------------------------
$ gcc -c error.adb
error.adb:9:11: aspect specification must appear in subprogram declaration
error.adb:25:04: warning: subunit "Error.Spec_Stub_Body_5" in file
"error-spec_stub_body_5.adb" not found
error-spec_stub_body_2.adb:4:08: aspect "Refined_Depends" cannot apply to a
subunit
error-spec_stub_body_3.adb:4:08: aspect "Refined_Global" cannot apply to a
subunit
error-spec_stub_body_3.adb:5:08: aspect "Refined_Depends" cannot apply to a
subunit
error-stub_body.adb:4:08: aspect "Refined_Global" cannot apply to a subunit
error-stub_body.adb:5:08: aspect "Refined_Depends" cannot apply to a subunit
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-02-25 Hristian Kirtchev <kirtc...@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.
Index: sem_ch10.adb
===================================================================
--- sem_ch10.adb (revision 208131)
+++ sem_ch10.adb (working copy)
@@ -53,7 +53,6 @@
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 @@
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 @@
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 @@
-- 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 @@
Write_Eol;
end if;
- declare
- Comp_Unit : constant Node_Id := Cunit (Unum);
- Prop_Body : Node_Id;
+ Comp_Unit := Cunit (Unum);
- begin
- -- Check for child unit instead of subunit
+ -- 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));
+ 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
+ -- OK, we have a subunit
- else
- Prop_Body := Proper_Body (Unit (Comp_Unit));
+ else
+ Set_Corresponding_Stub (Unit (Comp_Unit), N);
+ Set_Library_Unit (N, Comp_Unit);
- -- Set corresponding stub (even if errors)
+ -- 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_Corresponding_Stub (Unit (Comp_Unit), N);
+ Version_Update (Cunit (Main_Unit), Comp_Unit);
- -- Collect SCO information for loaded subunit if we are
- -- in the main unit.
+ -- Collect SCO information for loaded subunit if we are in
+ -- the main unit.
- 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.
-
- 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;
-
- -- Set the library unit pointer in any case
-
- Set_Library_Unit (N, 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.
-
- 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).
+ -- Analyze the unit if semantics active
- 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);
-
- 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 @@
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 @@
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);
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 208131)
+++ sem_prag.adb (working copy)
@@ -3601,40 +3601,42 @@
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;
+ -- Extract the entities of the spec and body
- Body_Id := Defining_Entity (Body_Decl);
+ if Nkind (Body_Decl) = N_Subprogram_Body then
+ Body_Id := Defining_Entity (Body_Decl);
+ Spec_Id := Corresponding_Spec (Body_Decl);
- -- The body [stub] must not act as a spec, in other words it has to
- -- be paired with a corresponding spec.
+ elsif Nkind (Body_Decl) = N_Subprogram_Body_Stub then
+ Body_Id := Defining_Entity (Body_Decl);
+ Spec_Id := Corresponding_Spec_Of_Stub (Body_Decl);
- if Nkind (Body_Decl) = N_Subprogram_Body then
- Spec_Id := Corresponding_Spec (Body_Decl);
else
- Spec_Id := Corresponding_Spec_Of_Stub (Body_Decl);
+ 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 @@
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 @@
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 @@
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;
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 208067)
+++ exp_ch6.adb (working copy)
@@ -8671,58 +8671,100 @@
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 @@
--------------------------------
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 @@
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 @@
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.
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 208128)
+++ sem_ch6.adb (working copy)
@@ -2485,9 +2485,18 @@
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:
-- procedure P;
@@ -2912,28 +2921,16 @@
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;
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 208087)
+++ sem_ch13.adb (working copy)
@@ -1234,14 +1234,6 @@
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;
