decl.c (gnat_to_gnu_entity): Beep up comment on SAVED...
authorEric Botcazou <ebotcazou@adacore.com>
Sat, 29 Jun 2019 09:01:27 +0000 (09:01 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Sat, 29 Jun 2019 09:01:27 +0000 (09:01 +0000)
* gcc-interface/decl.c (gnat_to_gnu_entity): Beep up comment on SAVED,
and tweak comment on the assertion about the scopes of Itypes.  Do not
skip the regular processing for Itypes that are E_Record_Subtype with
a Cloned_Subtype.  Get the Cloned_Subtype for every E_Record_Subtype
if the type is dummy and hasn't got its own freeze node.
<E_Record_Subtype>: Save again the DECL of the Cloned_Subtype, if any.
<E_Access_Subtype>: Save again the DECL of the equivalent type.
(Gigi_Equivalent_Type) <E_Access_Subtype>: New case.

From-SVN: r272822

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/specs/array5.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/array5_pkg1.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/array5_pkg2-g.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/array5_pkg2.ads [new file with mode: 0644]

index 4db9b2882127568b51093cbdd46bb25713209623..55e337cb09864fc2da6bc84bcbfd9d9fe26327b8 100644 (file)
@@ -1,3 +1,14 @@
+2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/decl.c (gnat_to_gnu_entity): Beep up comment on SAVED,
+       and tweak comment on the assertion about the scopes of Itypes.  Do not
+       skip the regular processing for Itypes that are E_Record_Subtype with
+       a Cloned_Subtype.  Get the Cloned_Subtype for every E_Record_Subtype
+       if the type is dummy and hasn't got its own freeze node.
+       <E_Record_Subtype>: Save again the DECL of the Cloned_Subtype, if any.
+       <E_Access_Subtype>: Save again the DECL of the equivalent type.
+       (Gigi_Equivalent_Type) <E_Access_Subtype>: New case.
+
 2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/utils.c (unchecked_convert): Tweak comment.  Only skip
index e99aeb4ad0f26767f48dbac82de58e7153d924fe..81f621b576f7f672c9daa2592ac0db393e78c3b8 100644 (file)
@@ -308,7 +308,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
   tree gnu_size = NULL_TREE;
   /* Contains the GCC name to be used for the GCC node.  */
   tree gnu_entity_name;
-  /* True if we have already saved gnu_decl as a GNAT association.  */
+  /* True if we have already saved gnu_decl as a GNAT association.  This can
+     also be used to purposely avoid making such an association but this use
+     case ought not to be applied to types because it can break the deferral
+     mechanism implemented for access types.  */
   bool saved = false;
   /* True if we incremented defer_incomplete_level.  */
   bool this_deferred = false;
@@ -325,14 +328,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 
   /* Since a use of an Itype is a definition, process it as such if it is in
      the main unit, except for E_Access_Subtype because it's actually a use
-     of its base type, and for E_Record_Subtype with cloned subtype because
-     it's actually a use of the cloned subtype, see below.  */
+     of its base type, see below.  */
   if (!definition
       && is_type
       && Is_Itype (gnat_entity)
-      && !(kind == E_Access_Subtype
-          || (kind == E_Record_Subtype
-              && Present (Cloned_Subtype (gnat_entity))))
+      && Ekind (gnat_entity) != E_Access_Subtype
       && !present_gnu_tree (gnat_entity)
       && In_Extended_Main_Code_Unit (gnat_entity))
     {
@@ -375,7 +375,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
        }
 
       /* This abort means the Itype has an incorrect scope, i.e. that its
-        scope does not correspond to the subprogram it is declared in.  */
+        scope does not correspond to the subprogram it is first used in.  */
       gcc_unreachable ();
     }
 
@@ -384,7 +384,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
      In that case, we will abort below when we try to save a new GCC tree
      for this object.  We also need to handle the case of getting a dummy
      type when a Full_View exists but be careful so as not to trigger its
-     premature elaboration.  */
+     premature elaboration.  Likewise for a cloned subtype without its own
+     freeze node, which typically happens when a generic gets instantiated
+     on an incomplete or private type.  */
   if ((!definition || (is_type && imported_p))
       && present_gnu_tree (gnat_entity))
     {
@@ -398,7 +400,23 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
              || No (Freeze_Node (Full_View (gnat_entity)))))
        {
          gnu_decl
-           = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, false);
+           = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE,
+                                 false);
+         save_gnu_tree (gnat_entity, NULL_TREE, false);
+         save_gnu_tree (gnat_entity, gnu_decl, false);
+       }
+
+      if (TREE_CODE (gnu_decl) == TYPE_DECL
+         && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
+         && Ekind (gnat_entity) == E_Record_Subtype
+         && No (Freeze_Node (gnat_entity))
+         && Present (Cloned_Subtype (gnat_entity))
+         && (present_gnu_tree (Cloned_Subtype (gnat_entity))
+             || No (Freeze_Node (Cloned_Subtype (gnat_entity)))))
+       {
+         gnu_decl
+           = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity), NULL_TREE,
+                                 false);
          save_gnu_tree (gnat_entity, NULL_TREE, false);
          save_gnu_tree (gnat_entity, gnu_decl, false);
        }
@@ -3338,14 +3356,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
     case E_Record_Subtype:
       /* If Cloned_Subtype is Present it means this record subtype has
         identical layout to that type or subtype and we should use
-        that GCC type for this one.  The front end guarantees that
+        that GCC type for this one.  The front-end guarantees that
         the component list is shared.  */
       if (Present (Cloned_Subtype (gnat_entity)))
        {
          gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
                                         NULL_TREE, false);
          gnat_annotate_type = Cloned_Subtype (gnat_entity);
-         saved = true;
+         maybe_present = true;
          break;
        }
 
@@ -3758,8 +3776,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
     case E_Access_Subtype:
       /* We treat this as identical to its base type; any constraint is
         meaningful only to the front-end.  */
-      gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, false);
-      saved = true;
+      gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, false);
+      maybe_present = true;
 
       /* The designated subtype must be elaborated as well, if it does
         not have its own freeze node.  But designated subtypes created
@@ -4983,6 +5001,10 @@ Gigi_Equivalent_Type (Entity_Id gnat_entity)
        gnat_equiv = Equivalent_Type (gnat_entity);
       break;
 
+    case E_Access_Subtype:
+      gnat_equiv = Etype (gnat_entity);
+      break;
+
     case E_Class_Wide_Type:
       gnat_equiv = Root_Type (gnat_entity);
       break;
index aacf71c05ff7cde85d228f8c5ceabcf2ac405f0c..c6500c7f48f237aa2bf3250f4d5ce5e402861938 100644 (file)
@@ -1,3 +1,10 @@
+2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/specs/array5.ads: New test.
+       * gnat.dg/specs/array5_pkg1.ads: New helper.
+       * gnat.dg/specs/array5_pkg2.ads: Likewise.
+       * gnat.dg/specs/array5_pkg2-g.ads: Likewise.
+
 2019-06-29  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/specs/unchecked_convert1.ads: New test.
diff --git a/gcc/testsuite/gnat.dg/specs/array5.ads b/gcc/testsuite/gnat.dg/specs/array5.ads
new file mode 100644 (file)
index 0000000..b0c2d2b
--- /dev/null
@@ -0,0 +1,9 @@
+-- { dg-do compile }\r
+\r
+with Array5_Pkg1; use Array5_Pkg1;\r
+\r
+package Array5 is\r
+\r
+  C : constant Integer := Arr'Last;\r
+\r
+end Array5;\r
diff --git a/gcc/testsuite/gnat.dg/specs/array5_pkg1.ads b/gcc/testsuite/gnat.dg/specs/array5_pkg1.ads
new file mode 100644 (file)
index 0000000..885d6a4
--- /dev/null
@@ -0,0 +1,14 @@
+with Array5_Pkg2; use Array5_Pkg2;\r
+with Array5_Pkg2.G;\r
+\r
+package Array5_Pkg1 is\r
+\r
+  type Derived is new Root with record\r
+    N : Integer;\r
+  end record;\r
+\r
+  package My_G is new Array5_Pkg2.G (Derived);\r
+\r
+  type Arr is array (1 .. My_G.Data.N) of Integer;\r
+\r
+end Array5_Pkg1;\r
diff --git a/gcc/testsuite/gnat.dg/specs/array5_pkg2-g.ads b/gcc/testsuite/gnat.dg/specs/array5_pkg2-g.ads
new file mode 100644 (file)
index 0000000..1bb9396
--- /dev/null
@@ -0,0 +1,13 @@
+with System.Address_To_Access_Conversions;\r
+\r
+generic\r
+\r
+  type T is new Root with private;\r
+\r
+package Array5_Pkg2.G is\r
+\r
+  package Ptr is new System.Address_To_Access_Conversions (T);\r
+\r
+  Data : Ptr.Object_Pointer;\r
+\r
+end Array5_Pkg2.G;\r
diff --git a/gcc/testsuite/gnat.dg/specs/array5_pkg2.ads b/gcc/testsuite/gnat.dg/specs/array5_pkg2.ads
new file mode 100644 (file)
index 0000000..6c83460
--- /dev/null
@@ -0,0 +1,5 @@
+package Array5_Pkg2 is\r
+\r
+  type Root is tagged null record;\r
+\r
+end Array5_Pkg2;\r