Ada: Fix segfault on mutually recursive record type declarations

This was reported a long time ago and is again a fairly pathological case,
but it turns out to be unfixable with the current model of type freezing
in GNAT (which is the second one suggested in the AARM 13.14(19.i) clause).

The code is legal but, as the declaration of any object of the types will
exhaust the heap and eventually raise Storage_Error, it is totally useless.

The patch contains a small cleanup in a related area as well as the addition
of a commented assertion in gigi, so that the compiler shuts down properly.

gcc/ada/
	PR ada/15800
	* freeze.adb (Freeze_Entity.Freeze_Record_Type): Small cleanup
	in code and comments.
	* gcc-interface/utils.cc (create_field_decl): Assert that the type
	of the field is frozen at this point.

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 346789ff7573231d0dd86d3aac78cee1696d0919..d8fdc306c3a51e52d0b1cc885fd7f53ccd20528e 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -5646,14 +5646,9 @@ package body Freeze is
 
             --  If the component is an access type with an allocator as default
             --  value, the designated type will be frozen by the corresponding
-            --  expression in init_proc. In order to place the freeze node for
-            --  the designated type before that for the current record type,
-            --  freeze it now.
-
-            --  Same process if the component is an array of access types,
-            --  initialized with an aggregate. If the designated type is
-            --  private, it cannot contain allocators, and it is premature
-            --  to freeze the type, so we check for this as well.
+            --  expression in the initialization procedure. In order to place
+            --  the freeze node for the designated type ahead of that for the
+            --  current record type, freeze the designated type right now.
 
             elsif Is_Access_Type (Etype (Comp))
               and then Present (Parent (Comp))
@@ -5665,17 +5660,16 @@ package body Freeze is
                declare
                   Alloc : constant Node_Id :=
                             Unqualify (Expression (Parent (Comp)));
-
+                  Desig_Typ : constant Entity_Id :=
+                                Designated_Type (Etype (Comp));
                begin
                   if Nkind (Alloc) = N_Allocator then
-
                      --  If component is pointer to a class-wide type, freeze
                      --  the specific type in the expression being allocated.
                      --  The expression may be a subtype indication, in which
                      --  case freeze the subtype mark.
 
-                     if Is_Class_Wide_Type (Designated_Type (Etype (Comp)))
-                     then
+                     if Is_Class_Wide_Type (Desig_Typ) then
                         if Is_Entity_Name (Expression (Alloc)) then
                            Freeze_And_Append
                              (Entity (Expression (Alloc)), N, Result);
@@ -5686,21 +5680,24 @@ package body Freeze is
                             (Entity (Subtype_Mark (Expression (Alloc))),
                              N, Result);
                         end if;
-                     elsif Is_Itype (Designated_Type (Etype (Comp))) then
+                     elsif Is_Itype (Desig_Typ) then
                         Check_Itype (Etype (Comp));
                      else
-                        Freeze_And_Append
-                          (Designated_Type (Etype (Comp)), N, Result);
+                        Freeze_And_Append (Desig_Typ, N, Result);
                      end if;
                   end if;
                end;
+
             elsif Is_Access_Type (Etype (Comp))
               and then Is_Itype (Designated_Type (Etype (Comp)))
             then
                Check_Itype (Etype (Comp));
 
-            --  Freeze the designated type when initializing a component with
-            --  an aggregate in case the aggregate contains allocators.
+            --  Likewise if the component is an array of access types that is
+            --  initialized with an aggregate, in case the aggregate contains
+            --  allocators. But if the designated type is private, it cannot
+            --  contain allocators, and it is premature to freeze the type,
+            --  so we check for this as well.
 
             --     type T is ...;
             --     type T_Ptr is access all T;
@@ -5712,13 +5709,15 @@ package body Freeze is
 
             elsif Is_Array_Type (Etype (Comp))
               and then Is_Access_Type (Component_Type (Etype (Comp)))
+              and then Present (Parent (Comp))
+              and then Nkind (Parent (Comp)) = N_Component_Declaration
+              and then Present (Expression (Parent (Comp)))
+              and then Nkind (Expression (Parent (Comp))) = N_Aggregate
             then
                declare
-                  Comp_Par  : constant Node_Id   := Parent (Comp);
                   Desig_Typ : constant Entity_Id :=
                                 Designated_Type
                                   (Component_Type (Etype (Comp)));
-
                begin
                   --  The only case when this sort of freezing is not done is
                   --  when the designated type is class-wide and the root type
@@ -5740,12 +5739,7 @@ package body Freeze is
                   then
                      null;
 
-                  elsif Is_Fully_Defined (Desig_Typ)
-                    and then Present (Comp_Par)
-                    and then Nkind (Comp_Par) = N_Component_Declaration
-                    and then Present (Expression (Comp_Par))
-                    and then Nkind (Expression (Comp_Par)) = N_Aggregate
-                  then
+                  elsif Is_Fully_Defined (Desig_Typ) then
                      Freeze_And_Append (Desig_Typ, N, Result);
                   end if;
                end;

diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc
index f176ca9eb65f6e18c4ac29356f174d4e36047adc..83b9e82d2dc89c519e5261e9efcf60be440bcdaf 100644 (file)
--- a/gcc/ada/gcc-interface/utils.cc
+++ b/gcc/ada/gcc-interface/utils.cc
@@ -3226,6 +3226,9 @@ create_field_decl (tree name, tree type, tree record_type, tree size, tree pos,
 {
   tree field_decl = build_decl (input_location, FIELD_DECL, name, type);
 
+  /* The type must be frozen at this point.  */
+  gcc_assert (COMPLETE_TYPE_P (type));
+
   DECL_CONTEXT (field_decl) = record_type;
   TREE_READONLY (field_decl) = TYPE_READONLY (type);