[Ada] Implement AI12-0109 (prohibit some "early" derivations)
authorSteve Baird <baird@adacore.com>
Fri, 13 Dec 2019 09:04:38 +0000 (09:04 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Fri, 13 Dec 2019 09:04:38 +0000 (09:04 +0000)
2019-12-13  Steve Baird  <baird@adacore.com>

gcc/ada/

* einfo.ads: Correct comment for Derived_Type_Link to reflect
that fact that this function is now used for more than just
generation of warnings.
* sem_ch3.adb (Build_Derived_Type): Do not call
Set_Derived_Type_Link if the derived type and the parent type
are in different compilation units. Such a derivation cannot be
a problematic "early" derivation (identifying these is what the
Derived_Type_Link attribute is used for) and we don't like
inter-unit references that go in the opposite direction of
semantic dependencies.
* sem_ch13.adb (Is_Type_Related_Rep_Item): A new function,
analogous to the existing function Is_Operational_Item.
(Rep_Item_Too_Late): Generate a hard error (with same text as
the warning that was previously being generated) if the
AI12-0109 legality rule is violated.

From-SVN: r279355

gcc/ada/ChangeLog
gcc/ada/einfo.ads
gcc/ada/sem_ch13.adb
gcc/ada/sem_ch3.adb

index 97b64698e7288cdeff82879acbab64cf9611a1a0..69176db196a4d9d117e84e790a939be98866b243 100644 (file)
@@ -1,3 +1,21 @@
+2019-12-13  Steve Baird  <baird@adacore.com>
+
+       * einfo.ads: Correct comment for Derived_Type_Link to reflect
+       that fact that this function is now used for more than just
+       generation of warnings.
+       * sem_ch3.adb (Build_Derived_Type): Do not call
+       Set_Derived_Type_Link if the derived type and the parent type
+       are in different compilation units. Such a derivation cannot be
+       a problematic "early" derivation (identifying these is what the
+       Derived_Type_Link attribute is used for) and we don't like
+       inter-unit references that go in the opposite direction of
+       semantic dependencies.
+       * sem_ch13.adb (Is_Type_Related_Rep_Item): A new function,
+       analogous to the existing function Is_Operational_Item.
+       (Rep_Item_Too_Late): Generate a hard error (with same text as
+       the warning that was previously being generated) if the
+       AI12-0109 legality rule is violated.
+
 2019-12-13  Eric Botcazou  <ebotcazou@adacore.com>
 
        * doc/gnat_rm/implementation_defined_pragmas.rst: Minor tweak to
index c178e3ab8fe1020610efdab0733374c8767164d0..0aa7e00e899220d51c026697d70d788422cabe58 100644 (file)
@@ -929,12 +929,12 @@ package Einfo is
 --
 --       In this case, if primitive operations have been declared for R, at
 --       the point of declaration of G, then the Derived_Type_Link of R is set
---       to point to the entity for G. This is used to generate warnings for
---       rep clauses that appear later on for R, which might result in an
---       unexpected implicit conversion operation.
+--       to point to the entity for G. This is used to generate warnings and
+--       errors for rep clauses that appear later on for R, which might result
+--       in an unexpected (or illegal) implicit conversion operation.
 --
 --       Note: if there is more than one such derived type, the link will point
---       to the last one (this is only used in generating warning messages).
+--       to the last one.
 
 --    Designated_Type (synthesized)
 --       Applies to access types. Returns the designated type. Differs from
index 9c8a0cf6b7a0e3dcd8d46f8dc7afe93a01842526..b2b9efa2978e4a8b055f80a48894d648ad8277a9 100644 (file)
@@ -154,6 +154,10 @@ package body Sem_Ch13 is
    --  that do not specify a representation characteristic are operational
    --  attributes.
 
+   function Is_Type_Related_Rep_Item (N : Node_Id) return Boolean;
+   --  Returns True for a representation clause/pragma that specifies a
+   --  type-related representation (as opposed to operational) aspect.
+
    function Is_Predicate_Static
      (Expr : Node_Id;
       Nam  : Name_Id) return Boolean;
@@ -12282,6 +12286,59 @@ package body Sem_Ch13 is
       end if;
    end Is_Predicate_Static;
 
+   ------------------------------
+   -- Is_Type_Related_Rep_Item --
+   ------------------------------
+
+   function Is_Type_Related_Rep_Item (N : Node_Id) return Boolean is
+   begin
+      case Nkind (N) is
+         when N_Attribute_Definition_Clause =>
+            declare
+               Id : constant Attribute_Id := Get_Attribute_Id (Chars (N));
+               --  See AARM 13.1(8.f-8.x) list items that end in "clause"
+               --  ???: include any GNAT-defined attributes here?
+            begin
+               return    Id = Attribute_Component_Size
+                 or else Id = Attribute_Bit_Order
+                 or else Id = Attribute_Storage_Pool
+                 or else Id = Attribute_Stream_Size
+                 or else Id = Attribute_Machine_Radix;
+            end;
+
+         when N_Pragma =>
+            case Get_Pragma_Id (N) is
+               --  See AARM 13.1(8.f-8.x) list items that start with "pragma"
+               --  ???: include any GNAT-defined pragmas here?
+               when Pragma_Pack
+                  | Pragma_Import
+                  | Pragma_Export
+                  | Pragma_Convention
+                  | Pragma_Atomic
+                  | Pragma_Independent
+                  | Pragma_Volatile
+                  | Pragma_Atomic_Components
+                  | Pragma_Independent_Components
+                  | Pragma_Volatile_Components
+                  | Pragma_Discard_Names
+               =>
+                  return True;
+               when others =>
+                  null;
+            end case;
+
+         when N_Enumeration_Representation_Clause
+            | N_Record_Representation_Clause
+         =>
+            return True;
+
+         when others =>
+            null;
+      end case;
+
+      return False;
+   end Is_Type_Related_Rep_Item;
+
    ---------------------
    -- Kill_Rep_Clause --
    ---------------------
@@ -12964,7 +13021,7 @@ package body Sem_Ch13 is
       end if;
 
       --  No error, but one more warning to consider. The RM (surprisingly)
-      --  allows this pattern:
+      --  allows this pattern in some cases:
 
       --    type S is ...
       --    primitive operations for S
@@ -12973,7 +13030,7 @@ package body Sem_Ch13 is
 
       --  Meaning that calls on the primitive operations of S for values of
       --  type R may require possibly expensive implicit conversion operations.
-      --  This is not an error, but is worth a warning.
+      --  So even when this is not an error, it is still worth a warning.
 
       if not Relaxed_RM_Semantics and then Is_Type (T) then
          declare
@@ -12981,26 +13038,47 @@ package body Sem_Ch13 is
 
          begin
             if Present (DTL)
-              and then Has_Primitive_Operations (Base_Type (T))
 
-              --  For now, do not generate this warning for the case of aspect
-              --  specification using Ada 2012 syntax, since we get wrong
-              --  messages we do not understand. The whole business of derived
-              --  types and rep items seems a bit confused when aspects are
-              --  used, since the aspects are not evaluated till freeze time.
+              --  For now, do not generate this warning for the case of
+              --  aspect specification using Ada 2012 syntax, since we get
+              --  wrong messages we do not understand. The whole business
+              --  of derived types and rep items seems a bit confused when
+              --  aspects are used, since the aspects are not evaluated
+              --  till freeze time. However, AI12-0109 confirms (in an AARM
+              --  ramification) that inheritance in this case is required
+              --  to work.
 
               and then not From_Aspect_Specification (N)
             then
-               Error_Msg_Sloc := Sloc (DTL);
-               Error_Msg_N
-                 ("representation item for& appears after derived type "
-                  & "declaration#??", N);
-               Error_Msg_NE
-                 ("\may result in implicit conversions for primitive "
-                  & "operations of&??", N, T);
-               Error_Msg_NE
-                 ("\to change representations when called with arguments "
-                  & "of type&??", N, DTL);
+               if Is_By_Reference_Type (T)
+                 and then not Is_Tagged_Type (T)
+                 and then Is_Type_Related_Rep_Item (N)
+                 and then (Ada_Version >= Ada_2012
+                            or else Has_Primitive_Operations (Base_Type (T)))
+               then
+                  --  Treat as hard error (AI12-0109, binding interpretation).
+                  --  Implementing a change of representation is not really
+                  --  an option in the case of a by-reference type, so we
+                  --  take this path for all Ada dialects if primitive
+                  --  operations are present.
+                  Error_Msg_Sloc := Sloc (DTL);
+                  Error_Msg_N
+                    ("representation item for& appears after derived type "
+                     & "declaration#", N);
+
+               elsif Has_Primitive_Operations (Base_Type (T)) then
+                  Error_Msg_Sloc := Sloc (DTL);
+
+                  Error_Msg_N
+                    ("representation item for& appears after derived type "
+                     & "declaration#??", N);
+                  Error_Msg_NE
+                    ("\may result in implicit conversions for primitive "
+                     & "operations of&??", N, T);
+                  Error_Msg_NE
+                    ("\to change representations when called with arguments "
+                     & "of type&??", N, DTL);
+               end if;
             end if;
          end;
       end if;
index c3b8796fa0849ca9319268b92248dd08f758b763..9554c3334f6e85d9d1bf0a04374be2caa07dfbe8 100644 (file)
@@ -9741,9 +9741,17 @@ package body Sem_Ch3 is
            (Derived_Type, No_Tagged_Streams_Pragma (Parent_Type));
       end if;
 
-      --  If the parent has primitive routines, set the derived type link
-
-      if Has_Primitive_Operations (Parent_Type) then
+      --  If the parent has primitive routines and may have not-seen-yet aspect
+      --  specifications (e.g., a Pack pragma), then set the derived type link
+      --  in order to later diagnose "early derivation" issues. If in different
+      --  compilation units, then "early derivation" cannot be an issue (and we
+      --  don't like interunit references that go in the opposite direction of
+      --  semantic dependencies).
+
+      if Has_Primitive_Operations (Parent_Type)
+         and then Enclosing_Comp_Unit_Node (Parent_Type) =
+           Enclosing_Comp_Unit_Node (Derived_Type)
+      then
          Set_Derived_Type_Link (Parent_Base, Derived_Type);
       end if;