Merge branch 'topic/variants-v2' into 'master'

Basic variant types See merge request eng/toolchain/gnat-llvm!365

Author: tromey

llvm-interface/check_for_llvm_apis.sh

@@ -42,6 +42,9 @@ api_test HAVE_TYPE_FN_SCOPE "void call(DebugInfoFinder *f, DILocalVariable *v) {
 # Test that checks if sizes and offsets can be dynamic.
 api_test HAVE_DYNAMIC_OFFSETS "void call(DIBuilder *b) { b->createMemberType(nullptr, StringRef(), nullptr, 0, nullptr, 0, nullptr, DINode::FlagZero, nullptr); }"
 
+# Test whether multiple members can be included in a variant.
+api_test HAVE_MULTI_MEMBER_VARIANT "void call(DIBuilder *b) { b->createVariantMemberType(nullptr, DINodeArray(), (Constant*)nullptr, (DIType*)nullptr); }"
+
 for def in $haves; do
  echo "#define GNAT_LLVM_$def"
 done > obj/tmp-gnat-llvm-config.h

llvm-interface/gnatllvm-debuginfo.adb

@@ -23,17 +23,18 @@ with Table; use Table;
 with Uintp.LLVM; use Uintp.LLVM;
 with Urealp; use Urealp;
 
-with GNATLLVM.Arrays; use GNATLLVM.Arrays;
-with GNATLLVM.Codegen; use GNATLLVM.Codegen;
-with GNATLLVM.Environment; use GNATLLVM.Environment;
-with GNATLLVM.GLType; use GNATLLVM.GLType;
-with GNATLLVM.Helper; use GNATLLVM.Helper;
-with GNATLLVM.MDType; use GNATLLVM.MDType;
-with GNATLLVM.Records; use GNATLLVM.Records;
-with GNATLLVM.Subprograms; use GNATLLVM.Subprograms;
-with GNATLLVM.Types; use GNATLLVM.Types;
-with GNATLLVM.Utils; use GNATLLVM.Utils;
-with GNATLLVM.Wrapper; use GNATLLVM.Wrapper;
+with GNATLLVM.Arrays; use GNATLLVM.Arrays;
+with GNATLLVM.Codegen; use GNATLLVM.Codegen;
+with GNATLLVM.Environment; use GNATLLVM.Environment;
+with GNATLLVM.GLType; use GNATLLVM.GLType;
+with GNATLLVM.Helper; use GNATLLVM.Helper;
+with GNATLLVM.MDType; use GNATLLVM.MDType;
+with GNATLLVM.Records; use GNATLLVM.Records;
+with GNATLLVM.Records.Debug; use GNATLLVM.Records.Debug;
+with GNATLLVM.Subprograms; use GNATLLVM.Subprograms;
+with GNATLLVM.Types; use GNATLLVM.Types;
+with GNATLLVM.Utils; use GNATLLVM.Utils;
+with GNATLLVM.Wrapper; use GNATLLVM.Wrapper;
 
 package body GNATLLVM.DebugInfo is
 
@@ -115,11 +116,6 @@ package body GNATLLVM.DebugInfo is
  Post => Present (Create_Array_Type'Result);
  -- Create metadata corresponding to the array type GT.
 
- function Create_Type_Data (GT : GL_Type) return Metadata_T
- with Pre => Present (GT);
- -- Create metadata corresponding to the type of GT. Return
- -- No_Metadata_T if the type is too complex.
-
  function Create_Type_Data (V : GL_Value) return Metadata_T
  with Pre => Present (V);
  -- Create metadata for the type and relationship of R. Don't return
@@ -953,9 +949,7 @@ package body GNATLLVM.DebugInfo is
  if Is_Unchecked_Union (TE) then
  -- Allow.
  null;
- elsif Ekind (TE) in Record_Kind or
- else not Types_Can_Have_Dynamic_Offsets
- then
+ elsif not Types_Can_Have_Dynamic_Offsets then
  return DI_Create_Unspecified_Type (Name);
  end if;
  end if;
@@ -1113,111 +1107,19 @@ package body GNATLLVM.DebugInfo is
  -- for the type and the position and size are known and static,
  -- add that field as a member.
 
- when Record_Kind => Record_Type : declare
-
- package Member_Table is new Table.Table
- (Table_Component_Type => Metadata_T,
- Table_Index_Type => Int,
- Table_Low_Bound => 1,
- Table_Initial => 20,
- Table_Increment => 5,
- Table_Name => "Member_Table");
-
- F : Opt_Record_Field_Kind_Id;
-
+ when Record_Kind => declare
  Original_Type : constant Entity_Id :=
- (if Is_Packed (TE)
- then Etype (TE)
- elsif Ekind (TE) = E_Record_Subtype
- then Implementation_Base_Type (TE)
- else Get_Fullest_View (TE));
-
- Empty_Fields : Metadata_Array (1 .. 0);
-
+ (if Ekind (TE) = E_Record_Subtype
+ then Implementation_Base_Type (TE)
+ else Get_Fullest_View (TE));
  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)))
- /= Original_Type
- then
- -- Inherited component, so we can skip it here.
- null;
- elsif Known_Static_Component_Bit_Offset (F)
- and then Known_Static_Esize (F)
- then
- declare
- F_GT : constant GL_Type := Field_Type (F);
- Mem_MD : constant Metadata_T :=
- Create_Type_Data (F_GT);
- Name : constant String := Get_Name (F);
- F_S : constant Source_Ptr := Sloc (F);
- File : constant Metadata_T :=
- Get_Debug_File_Node (Get_Source_File_Index (F_S));
- Offset : constant ULL :=
- UI_To_ULL (Component_Bit_Offset (F));
- Storage_Offset : constant ULL :=
- (Offset / UBPU) * UBPU;
- MD : constant Metadata_T :=
- (if Is_Bitfield (F)
- then DI_Create_Bit_Field_Member_Type
- (No_Metadata_T, Name, File,
- Get_Physical_Line_Number (F_S),
- UI_To_ULL (Esize (F)), Offset,
- Storage_Offset, Mem_MD)
- else DI_Create_Member_Type
- (No_Metadata_T, Name, File,
- Get_Physical_Line_Number (F_S),
- UI_To_ULL (Esize (F)),
- Get_Type_Alignment (F_GT), Offset, Mem_MD));
-
- begin
- -- Add the member type to the table
-
- Member_Table.Append (MD);
- end;
- end if;
-
- Next_Component_Or_Discriminant (F);
- end loop;
-
- declare
- Members : Metadata_Array (1 .. Member_Table.Last);
-
- begin
- for J in Members'Range loop
- Members (J) := Member_Table.Table (J);
- end loop;
-
- -- 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;
+ Result :=
+ Create_Record_Debug_Info
+ (TE, Original_Type,
+ Get_Scope_For (Original_Type),
+ Get_Possibly_Local_Name (Original_Type),
+ Size, Align, S);
+ end;
 
  -- For an enumeration type, make an enumerator metadata for each
  -- entry. The code below is a bit convoluted to avoid needing a

llvm-interface/gnatllvm-debuginfo.ads

@@ -91,6 +91,11 @@ package GNATLLVM.DebugInfo is
  with Pre => Present (N);
  -- Add debugging info for the "use" clause N.
 
+ function Create_Type_Data (GT : GL_Type) return Metadata_T
+ with Pre => Present (GT);
+ -- Create metadata corresponding to the type of GT. Return
+ -- No_Metadata_T if the type is too complex.
+
  Empty_DI_Expr : Metadata_T;
  -- An empty DI_Expr
 

llvm-interface/gnatllvm-records-create.adb

@@ -678,7 +678,8 @@ package body GNATLLVM.Records.Create is
  Num_Bits => Num_Bits,
  TBAA_Type => No_Metadata_T,
  Array_Bitfield => Array_Bitfield,
- Large_Array_Bitfield => Large_Array_Bitfield));
+ Large_Array_Bitfield => Large_Array_Bitfield,
+ Is_Inherited => Full_Scope (E) /= TE));
 
  if No (Last_Field_Id) then
  First_Field_Id := Field_Info_Table.Last;