Patchwork [Ada] Legality of aspects specified on a full view

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 4, 2012, 9:19 a.m.
Message ID <20121004091914.GA6971@adacore.com>
Download mbox | patch
Permalink /patch/189073/
State New
Headers show

Comments

Arnaud Charlet - Oct. 4, 2012, 9:19 a.m.
In Ada 2012, certain aaspects, such as Type_Invariant, can be specified on a
partial view of a type, or on the full view, but not in both This patch
rejects such duplications cleanly.

the command:

    gcc -c -gnat12 -gnata r.ads

must yield:

    r.ads:5:32: aspect already specified in private declaration

---
package R is
    type T is private with Type_Invariant => Non_Null (T);
    function Non_Null (X : T) return Boolean;
private
    type T is new Integer with Type_Invariant => T /= 0;
    function Non_Null (X : T) return Boolean is (X /= 0);
end R;

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-10-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Check_Duplicate_Aspects): Diagnose properly
	aspects that appear in the partial and the full view of a type.

Patch

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 192066)
+++ sem_ch3.adb	(working copy)
@@ -23,6 +23,7 @@ 
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Checks;   use Checks;
 with Debug;    use Debug;
@@ -14805,6 +14806,11 @@ 
       New_Id   : Entity_Id;
       Prev_Par : Node_Id;
 
+      procedure Check_Duplicate_Aspects;
+      --  Check that aspects specified in a completion have not been specified
+      --  already in the partial view. Type_Invariant and others can be
+      --  specified on either view but never on both.
+
       procedure Tag_Mismatch;
       --  Diagnose a tagged partial view whose full view is untagged.
       --  We post the message on the full view, with a reference to
@@ -14813,6 +14819,38 @@ 
       --  so we determine the position of the error message from the
       --  respective slocs of both.
 
+      -----------------------------
+      -- Check_Duplicate_Aspects --
+      -----------------------------
+      procedure Check_Duplicate_Aspects is
+         Prev_Aspects   : constant List_Id := Aspect_Specifications (Prev_Par);
+         Full_Aspects   : constant List_Id := Aspect_Specifications (N);
+         F_Spec, P_Spec : Node_Id;
+
+      begin
+         if Present (Prev_Aspects) and then Present (Full_Aspects) then
+            F_Spec := First (Full_Aspects);
+            while Present (F_Spec) loop
+               P_Spec := First (Prev_Aspects);
+               while Present (P_Spec) loop
+                  if
+                    Chars (Identifier (P_Spec)) = Chars (Identifier (F_Spec))
+                  then
+                     Error_Msg_N
+                       ("aspect already specified in private declaration",
+                         F_Spec);
+                     Remove (F_Spec);
+                     return;
+                  end if;
+
+                  Next (P_Spec);
+               end loop;
+
+               Next (F_Spec);
+            end loop;
+         end if;
+      end Check_Duplicate_Aspects;
+
       ------------------
       -- Tag_Mismatch --
       ------------------
@@ -15022,6 +15060,10 @@ 
                  ("declaration of full view must appear in private part", N);
             end if;
 
+            if Ada_Version >= Ada_2012 then
+               Check_Duplicate_Aspects;
+            end if;
+
             Copy_And_Swap (Prev, Id);
             Set_Has_Private_Declaration (Prev);
             Set_Has_Private_Declaration (Id);