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 <schonb...@adacore.com> * sem_ch3.adb (Check_Duplicate_Aspects): Diagnose properly aspects that appear in the partial and the full view of a type.
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);