[Ada] Aspects Depends and Global on subprogram body stubs

Arnaud Charlet charlet@adacore.com
Mon Jan 20 15:29:00 GMT 2014


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  <kirtchev@adacore.com>

	* aspects.adb (Move_Or_Merge_Aspects): Reimplemented.

-------------- next part --------------
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


More information about the Gcc-patches mailing list