Merge branch 'topic/recursive-types' into 'master'

Handle self-referential types

See merge request eng/toolchain/gnat-llvm!364

Author: tromey

llvm-interface/gnatllvm-debuginfo.adb

@@ -1132,7 +1132,30 @@ package body GNATLLVM.DebugInfo is
                 then Implementation_Base_Type (TE)
                 else Get_Fullest_View (TE));
 
+            Empty_Fields : Metadata_Array (1 .. 0);
+
          begin
+            --  A type might be self-referential.  For example, a
+            --  record may have a member whose type refers back to the
+            --  same record type.  To handle this case, we construct a
+            --  empty composite type and record it; then later we
+            --  update the members of the type.
+            if Is_Unchecked_Union (TE) then
+               Result := DI_Create_Union_Type
+                 (Get_Scope_For (TE), Get_Possibly_Local_Name (TE),
+                  Get_Debug_File_Node (Get_Source_File_Index (S)),
+                  Get_Physical_Line_Number (S), Size, Align, DI_Flag_Zero,
+                  Empty_Fields, 0, "");
+            else
+               Result := DI_Create_Struct_Type
+                 (Get_Scope_For (TE), Get_Possibly_Local_Name (TE),
+                  Get_Debug_File_Node (Get_Source_File_Index (S)),
+                  Get_Physical_Line_Number (S), Size, Align, DI_Flag_Zero,
+                  No_Metadata_T, Empty_Fields, 0, No_Metadata_T, "");
+            end if;
+
+            Set_Debug_Metadata (TE, Result);
+
             F := First_Component_Or_Discriminant (TE);
             while Present (F) loop
                if Get_Fullest_View (Scope (Ancestor_Field (F)))
@@ -1186,20 +1209,14 @@ package body GNATLLVM.DebugInfo is
                   Members (J) := Member_Table.Table (J);
                end loop;
 
-               if Is_Unchecked_Union (TE) then
-                  Result := DI_Create_Union_Type
-                    (Get_Scope_For (TE), Get_Possibly_Local_Name (TE),
-                     Get_Debug_File_Node (Get_Source_File_Index (S)),
-                     Get_Physical_Line_Number (S), Size, Align, DI_Flag_Zero,
-                     Members, 0, "");
-               else
-                  Result := DI_Create_Struct_Type
-                    (Get_Scope_For (TE), Get_Possibly_Local_Name (TE),
-                     Get_Debug_File_Node (Get_Source_File_Index (S)),
-                     Get_Physical_Line_Number (S), Size, Align, DI_Flag_Zero,
-                     No_Metadata_T, Members, 0, No_Metadata_T, "");
-               end if;
+               --  At least in theory it seems that LLVM may replace
+               --  the object entirely, so don't assume Result will be
+               --  the same, and be sure to clear it from the cache.
+               Result := Replace_Composite_Elements (DI_Builder, Result,
+                                                     Members);
+               Clear_Debug_Metadata (TE);
             end;
+
          end Record_Type;
 
          --  For an enumeration type, make an enumerator metadata for each

llvm-interface/gnatllvm-environment.adb

@@ -546,6 +546,11 @@ package body GNATLLVM.Environment is
    procedure Set_Debug_Metadata       (TE : Entity_Id; DT : Metadata_T)
      renames Env_Debug.Set;
 
+   procedure Clear_Debug_Metadata     (TE : Entity_Id) is
+   begin
+      Env_Debug.Set (TE, No_Metadata_T);
+   end Clear_Debug_Metadata;
+
    function  Get_Array_Info           (TE : Entity_Id) return Array_Info_Id
      renames Env_Array.Get;
    function  Get_Array_Info_N         (TE : Entity_Id) return Array_Info_Id

llvm-interface/gnatllvm-environment.ads

@@ -199,6 +199,9 @@ package GNATLLVM.Environment is
                    or else Get_Debug_Metadata_N (TE) = DT),
           Post => Get_Debug_Metadata_N (TE) = DT, Inline;
 
+   procedure Clear_Debug_Metadata     (TE : Entity_Id)
+     with Post => No (Get_Debug_Metadata_N (TE)), Inline;
+
    procedure Set_Array_Info           (TE : Entity_Id; AI : Array_Info_Id)
      with Pre  => Is_Array_Type (TE)
                   and then (No (Get_Array_Info_N (TE))

llvm-interface/gnatllvm-wrapper.adb

@@ -966,4 +966,22 @@ package body GNATLLVM.Wrapper is
                                                    uint32_t (Align_In_Bits));
    end Create_Global_Variable_Declaration;
 
+   function Replace_Composite_Elements
+     (Builder   : DI_Builder_T;
+      Composite : Metadata_T;
+      Elements  : Metadata_Array) return Metadata_T
+   is
+      function Replace_Composite_Elements_C
+        (Builder   : DI_Builder_T;
+         Composite : Metadata_T;
+         Elements  : System.Address;
+         Num_Elements : unsigned) return Metadata_T
+        with Import => True, Convention => C,
+             External_Name => "Replace_Composite_Elements";
+   begin
+      return Replace_Composite_Elements_C (Builder, Composite,
+                                           Elements'Address,
+                                           unsigned (Elements'Length));
+   end Replace_Composite_Elements;
+
 end GNATLLVM.Wrapper;

llvm-interface/gnatllvm-wrapper.ads

@@ -578,4 +578,11 @@ package GNATLLVM.Wrapper is
       Decl : Metadata_T;
       Align_In_Bits : Nat) return Metadata_T;
 
+   function Replace_Composite_Elements
+     (Builder   : DI_Builder_T;
+      Composite : Metadata_T;
+      Elements  : Metadata_Array) return Metadata_T;
+   --  Wrapper for DIBuilder::replaceArrays that only allows updating
+   --  the elements of a composite type.
+
 end GNATLLVM.Wrapper;

llvm-interface/llvm_wrapper.cc

@@ -1565,3 +1565,14 @@ LLVMMetadataRef Create_Global_Variable_Declaration(
       false, unwrap<DIExpression>(Expr), MD,
       nullptr, AlignInBits));
 }
+
+extern "C"
+LLVMMetadataRef Replace_Composite_Elements(
+    LLVMDIBuilderRef Builder, LLVMMetadataRef Composite,
+    LLVMMetadataRef *Elements, unsigned NumElements) {
+  auto Elems = unwrap(Builder)->getOrCreateArray({unwrap(Elements), NumElements});
+  DICompositeType *T = unwrap<DICompositeType>(Composite);
+  unwrap(Builder)->replaceArrays(T, Elems);
+  // T might have been modified by replaceArrays.
+  return wrap(T);
+}