This patch corrects the relocation of aspects related to a subprogram body stub
that also acts as a spect.
------------
-- Source --
------------
-- stubs.ads
package Stubs is
procedure S1 (L, R : in out Integer)
with Depends => (L => R, R => L);
procedure Error1 (L, R : in out Integer)
with Depends => (L => R, R => L);
end Stubs;
-- stubs.adb
package body Stubs is
procedure S1 (L, R : in out Integer) is separate;
procedure S2 (L, R : in out Integer) is separate
with Depends => (L => R, R => L);
procedure Error1 (L, R : in out Integer) is separate;
procedure Error2 (L, R : in out Integer) is separate
with Depends => (L => R, R => L);
procedure Error3 (L, R : in out Integer) is separate;
end Stubs;
-- stubs-error1.adb
separate (Stubs)
procedure Error1 (L, R : in out Integer)
with Depends => (L => R, R => L) is begin null; end Error1;
-- stubs-error2.adb
separate (Stubs)
procedure Error2 (L, R : in out Integer)
with Depends => (L => R, R => L) is begin null; end Error2;
-- stubs-error3.adb
separate (Stubs)
procedure Error3 (L, R : in out Integer)
with Depends => (L => R, R => L) is begin null; end Error3;
-- stubs-s1.adb
separate (Stubs)
procedure S1 (L, R : in out Integer) is begin null; end S1;
-- stubs-s2.adb
separate (Stubs)
procedure S2 (L, R : in out Integer) is begin null; end S2;
----------------------------
-- Compilation and output --
----------------------------
$ gcc -c -gnatd.V stubs.adb
stubs-error1.adb:3:01: aspect specifications must appear in subprogram
declaration
stubs-error2.adb:4:08: incorrect placement of aspect "Depends"
stubs-error3.adb:4:08: incorrect placement of aspect "Depends"
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-01-20 Hristian Kirtchev <kirtc...@adacore.com>
* aspects.adb (Move_Or_Merge_Aspects): Reimplemented.
Index: aspects.adb
===================================================================
--- aspects.adb (revision 206804)
+++ aspects.adb (working copy)
@@ -310,23 +310,87 @@
---------------------------
procedure Move_Or_Merge_Aspects (From : Node_Id; To : Node_Id) is
- begin
- if Has_Aspects (From) then
+ procedure Relocate_Aspect (Asp : Node_Id);
+ -- Asp denotes an aspect specification of node From. Relocate the Asp to
+ -- the aspect specifications of node To (if any).
- -- Merge the aspects of From into To. Make sure that From has no
- -- aspects after the merge takes place.
+ ---------------------
+ -- Relocate_Aspect --
+ ---------------------
+ procedure Relocate_Aspect (Asp : Node_Id) is
+ Asps : List_Id;
+
+ begin
if Has_Aspects (To) then
- Append_List
- (List => Aspect_Specifications (From),
- To => Aspect_Specifications (To));
- Remove_Aspects (From);
+ Asps := Aspect_Specifications (To);
- -- Otherwise simply move the aspects
+ -- Create a new aspect specification list for node To
else
- Move_Aspects (From => From, To => To);
+ Asps := New_List;
+ Set_Aspect_Specifications (To, Asps);
+ Set_Has_Aspects (To);
end if;
+
+ -- Remove the aspect from node From's aspect specifications and
+ -- append it to node To.
+
+ Remove (Asp);
+ Append (Asp, Asps);
+ end Relocate_Aspect;
+
+ -- Local variables
+
+ Asp : Node_Id;
+ Asp_Id : Aspect_Id;
+ Next_Asp : Node_Id;
+
+ -- Start of processing for Move_Or_Merge_Aspects
+
+ begin
+ if Has_Aspects (From) then
+ Asp := First (Aspect_Specifications (From));
+ while Present (Asp) loop
+
+ -- Store the next aspect now as a potential relocation will alter
+ -- the contents of the list.
+
+ Next_Asp := Next (Asp);
+
+ -- When moving or merging aspects from a subprogram body stub that
+ -- also acts as a spec, relocate only those aspects that may apply
+ -- to a body [stub]. Note that a precondition must also be moved
+ -- to the proper body as the pre/post machinery expects it to be
+ -- there.
+
+ if Nkind (From) = N_Subprogram_Body_Stub
+ and then No (Corresponding_Spec_Of_Stub (From))
+ then
+ Asp_Id := Get_Aspect_Id (Asp);
+
+ if Aspect_On_Body_Or_Stub_OK (Asp_Id)
+ or else Asp_Id = Aspect_Pre
+ or else Asp_Id = Aspect_Precondition
+ then
+ Relocate_Aspect (Asp);
+ end if;
+
+ -- Default case - relocate the aspect to its new owner
+
+ else
+ Relocate_Aspect (Asp);
+ end if;
+
+ Asp := Next_Asp;
+ end loop;
+
+ -- The relocations may have left node From's aspect specifications
+ -- list empty. If this is the case, simply remove the aspects.
+
+ if Is_Empty_List (Aspect_Specifications (From)) then
+ Remove_Aspects (From);
+ end if;
end if;
end Move_Or_Merge_Aspects;
Index: aspects.ads
===================================================================
--- aspects.ads (revision 206804)
+++ aspects.ads (working copy)
@@ -779,7 +779,9 @@
procedure Move_Or_Merge_Aspects (From : Node_Id; To : Node_Id);
-- Relocate the aspect specifications of node From to node To. If To has
-- aspects, the aspects of From are added to the aspects of To. If From has
- -- no aspects, the routine has no effect.
+ -- no aspects, the routine has no effect. When From denotes a subprogram
+ -- body stub that also acts as a spec, the only aspects relocated to node
+ -- To are those from table Aspect_On_Body_Or_Stub_OK and preconditions.
function Permits_Aspect_Specifications (N : Node_Id) return Boolean;
-- Returns True if the node N is a declaration node that permits aspect
