[llvm] c244cd7 - [OCaml][DebugInfo] Add tests for debug info API
Vaivaswatha Nagaraj via llvm-commits
llvm-commits at lists.llvm.org
Fri Mar 26 09:55:51 PDT 2021
Author: Vaivaswatha Nagaraj
Date: 2021-03-26T22:06:48+05:30
New Revision: c244cd72172ca8941f9f67fc183ade8afcd61c17
URL: https://github.com/llvm/llvm-project/commit/c244cd72172ca8941f9f67fc183ade8afcd61c17
DIFF: https://github.com/llvm/llvm-project/commit/c244cd72172ca8941f9f67fc183ade8afcd61c17.diff
LOG: [OCaml][DebugInfo] Add tests for debug info API
In the process of adding the tests, several bugs were
found in the implementation and interface of the API
and they were fixed.
Some utilities from the core tests (core.ml) were moved
into a separate file for reuse.
The following new functions have been added:
`dibuild_create_global_variable_expression`,
`dibuild_create_constant_value_expression` and
`llmetadata_null`. The third one already existed but
is now exposed publicly.
Differential Revision: https://reviews.llvm.org/D99403
Added:
llvm/test/Bindings/OCaml/.ocamlformat
llvm/test/Bindings/OCaml/Utils/Testsuite.ml
llvm/test/Bindings/OCaml/Utils/lit.local.cfg
llvm/test/Bindings/OCaml/debuginfo.ml
Modified:
llvm/bindings/ocaml/debuginfo/debuginfo_ocaml.c
llvm/bindings/ocaml/debuginfo/llvm_debuginfo.ml
llvm/bindings/ocaml/debuginfo/llvm_debuginfo.mli
llvm/test/Bindings/OCaml/core.ml
Removed:
################################################################################
diff --git a/llvm/bindings/ocaml/debuginfo/debuginfo_ocaml.c b/llvm/bindings/ocaml/debuginfo/debuginfo_ocaml.c
index 22ac2d4ba256..7ed0cdf09a0d 100644
--- a/llvm/bindings/ocaml/debuginfo/debuginfo_ocaml.c
+++ b/llvm/bindings/ocaml/debuginfo/debuginfo_ocaml.c
@@ -845,7 +845,7 @@ CAMLprim value llvm_set_subprogram(LLVMValueRef Func, LLVMMetadataRef SP) {
}
CAMLprim value llvm_di_subprogram_get_line(LLVMMetadataRef Subprogram) {
- return Int_val(LLVMDISubprogramGetLine(Subprogram));
+ return Val_int(LLVMDISubprogramGetLine(Subprogram));
}
CAMLprim value llvm_instr_get_debug_loc(LLVMValueRef Inst) {
@@ -858,6 +858,40 @@ CAMLprim value llvm_instr_set_debug_loc(LLVMValueRef Inst,
return Val_unit;
}
+CAMLprim LLVMMetadataRef
+llvm_dibuild_create_constant_value_expression(value Builder, value Value) {
+ return LLVMDIBuilderCreateConstantValueExpression(DIBuilder_val(Builder),
+ (int64_t)Int_val(Value));
+}
+
+CAMLprim LLVMMetadataRef llvm_dibuild_create_global_variable_expression_native(
+ value Builder, LLVMMetadataRef Scope, value Name, value Linkage,
+ LLVMMetadataRef File, value Line, LLVMMetadataRef Ty, value LocalToUnit,
+ LLVMMetadataRef Expr, LLVMMetadataRef Decl, value AlignInBits) {
+ return LLVMDIBuilderCreateGlobalVariableExpression(
+ DIBuilder_val(Builder), Scope, String_val(Name), caml_string_length(Name),
+ String_val(Linkage), caml_string_length(Linkage), File, Int_val(Line), Ty,
+ Bool_val(LocalToUnit), Expr, Decl, Int_val(AlignInBits));
+}
+
+CAMLprim LLVMMetadataRef
+llvm_dibuild_create_global_variable_expression_bytecode(value *argv, int arg) {
+
+ return llvm_dibuild_create_global_variable_expression_native(
+ argv[0], // Builder
+ (LLVMMetadataRef)argv[1], // Scope
+ argv[2], // Name
+ argv[3], // Linkage
+ (LLVMMetadataRef)argv[4], // File
+ argv[5], // Line
+ (LLVMMetadataRef)argv[6], // Ty
+ argv[7], // LocalToUnit
+ (LLVMMetadataRef)argv[8], // Expr
+ (LLVMMetadataRef)argv[9], // Decl
+ argv[10] // AlignInBits
+ );
+}
+
CAMLprim value
llvm_di_global_variable_expression_get_variable(LLVMMetadataRef GVE) {
return (ptr_to_option(LLVMDIGlobalVariableExpressionGetVariable(GVE)));
diff --git a/llvm/bindings/ocaml/debuginfo/llvm_debuginfo.ml b/llvm/bindings/ocaml/debuginfo/llvm_debuginfo.ml
index 0bcb7b6c6e83..43e7390863e8 100644
--- a/llvm/bindings/ocaml/debuginfo/llvm_debuginfo.ml
+++ b/llvm/bindings/ocaml/debuginfo/llvm_debuginfo.ml
@@ -192,7 +192,7 @@ external dibuild_create_namespace :
lldibuilder ->
parent_ref:Llvm.llmetadata ->
name:string ->
- bool:string ->
+ export_symbols:bool ->
Llvm.llmetadata = "llvm_dibuild_create_namespace"
external dibuild_create_function :
@@ -228,9 +228,6 @@ external dibuild_create_debug_location_helper :
Llvm.llmetadata = "llvm_dibuild_create_debug_location"
external llmetadata_null : unit -> Llvm.llmetadata = "llvm_metadata_null"
-(** [llmetadata_null ()] llmetadata is a wrapper around "llvm::Metadata *".
- This function returns a nullptr valued llmetadata. For example,
- it can be useful to pass NULL to LLVMInstructionSetDebugLoc. *)
let dibuild_create_debug_location ?(inlined_at = llmetadata_null ()) llctx ~line
~column ~scope =
@@ -287,7 +284,7 @@ external dibuild_create_enumeration_type :
elements:Llvm.llmetadata array ->
class_ty:Llvm.llmetadata ->
Llvm.llmetadata
- = "llvm_dibuild_create_enumeration_type_native" "llvm_dibuild_create_enumeration_type_bytecode"
+ = "llvm_dibuild_create_enumeration_type_bytecode" "llvm_dibuild_create_enumeration_type_native"
external dibuild_create_union_type :
lldibuilder ->
@@ -302,7 +299,7 @@ external dibuild_create_union_type :
run_time_language:int ->
unique_id:string ->
Llvm.llmetadata
- = "llvm_dibuild_create_union_type_native" "llvm_dibuild_create_union_type_bytecode"
+ = "llvm_dibuild_create_union_type_bytecode" "llvm_dibuild_create_union_type_native"
external dibuild_create_array_type :
lldibuilder ->
@@ -340,7 +337,7 @@ external dibuild_create_pointer_type :
address_space:int ->
name:string ->
Llvm.llmetadata
- = "llvm_dibuild_create_pointer_type_native" "llvm_dibuild_create_pointer_type_bytecode"
+ = "llvm_dibuild_create_pointer_type_bytecode" "llvm_dibuild_create_pointer_type_native"
external dibuild_create_struct_type :
lldibuilder ->
@@ -353,11 +350,11 @@ external dibuild_create_struct_type :
lldiflags ->
derived_from:Llvm.llmetadata ->
elements:Llvm.llmetadata array ->
- run_time_lang:int ->
+ DWARFSourceLanguageKind.t ->
vtable_holder:Llvm.llmetadata ->
unique_id:string ->
Llvm.llmetadata
- = "llvm_dibuild_create_struct_type_native" "llvm_dibuild_create_struct_type_bytecode"
+ = "llvm_dibuild_create_struct_type_bytecode" "llvm_dibuild_create_struct_type_native"
external dibuild_create_member_type :
lldibuilder ->
@@ -371,7 +368,7 @@ external dibuild_create_member_type :
lldiflags ->
ty:Llvm.llmetadata ->
Llvm.llmetadata
- = "llvm_dibuild_create_member_type_native" "llvm_dibuild_create_member_type_bytecode"
+ = "llvm_dibuild_create_member_type_bytecode" "llvm_dibuild_create_member_type_native"
external dibuild_create_static_member_type :
lldibuilder ->
@@ -384,7 +381,7 @@ external dibuild_create_static_member_type :
const_val:Llvm.llvalue ->
align_in_bits:int ->
Llvm.llmetadata
- = "llvm_dibuild_create_static_member_type_native" "llvm_dibuild_create_static_member_type_bytecode"
+ = "llvm_dibuild_create_static_member_type_bytecode" "llvm_dibuild_create_static_member_type_native"
external dibuild_create_member_pointer_type :
lldibuilder ->
@@ -394,7 +391,7 @@ external dibuild_create_member_pointer_type :
align_in_bits:int ->
lldiflags ->
Llvm.llmetadata
- = "llvm_dibuild_create_member_pointer_type_native" "llvm_dibuild_create_member_pointer_type_bytecode"
+ = "llvm_dibuild_create_member_pointer_type_bytecode" "llvm_dibuild_create_member_pointer_type_native"
external dibuild_create_object_pointer_type :
lldibuilder -> Llvm.llmetadata -> Llvm.llmetadata
@@ -420,9 +417,9 @@ external dibuild_create_typedef :
scope:Llvm.llmetadata ->
align_in_bits:int ->
Llvm.llmetadata
- = "llvm_dibuild_create_typedef_native" "llvm_dibuild_create_typedef_bytecode"
+ = "llvm_dibuild_create_typedef_bytecode" "llvm_dibuild_create_typedef_native"
-external dibuild_create_inheritance_native :
+external dibuild_create_inheritance :
lldibuilder ->
ty:Llvm.llmetadata ->
base_ty:Llvm.llmetadata ->
@@ -430,7 +427,7 @@ external dibuild_create_inheritance_native :
vb_ptr_offset:int ->
lldiflags ->
Llvm.llmetadata
- = "llvm_dibuild_create_inheritance_native" "llvm_dibuild_create_inheritance_bytecode"
+ = "llvm_dibuild_create_inheritance_bytecode" "llvm_dibuild_create_inheritance_native"
external dibuild_create_forward_decl :
lldibuilder ->
@@ -444,7 +441,7 @@ external dibuild_create_forward_decl :
align_in_bits:int ->
unique_identifier:string ->
Llvm.llmetadata
- = "llvm_dibuild_create_forward_decl_native" "llvm_dibuild_create_forward_decl_bytecode"
+ = "llvm_dibuild_create_forward_decl_bytecode" "llvm_dibuild_create_forward_decl_native"
external dibuild_create_replaceable_composite_type :
lldibuilder ->
@@ -459,7 +456,7 @@ external dibuild_create_replaceable_composite_type :
lldiflags ->
unique_identifier:string ->
Llvm.llmetadata
- = "llvm_dibuild_create_replaceable_composite_type_native" "llvm_dibuild_create_replaceable_composite_type_bytecode"
+ = "llvm_dibuild_create_replaceable_composite_type_bytecode" "llvm_dibuild_create_replaceable_composite_type_native"
external dibuild_create_bit_field_member_type :
lldibuilder ->
@@ -473,7 +470,7 @@ external dibuild_create_bit_field_member_type :
lldiflags ->
ty:Llvm.llmetadata ->
Llvm.llmetadata
- = "llvm_dibuild_create_bit_field_member_type_native" "llvm_dibuild_create_bit_field_member_type_bytecode"
+ = "llvm_dibuild_create_bit_field_member_type_bytecode" "llvm_dibuild_create_bit_field_member_type_native"
external dibuild_create_class_type :
lldibuilder ->
@@ -491,7 +488,7 @@ external dibuild_create_class_type :
template_params_node:Llvm.llmetadata ->
unique_identifier:string ->
Llvm.llmetadata
- = "llvm_dibuild_create_class_type_native" "llvm_dibuild_create_class_type_bytecode"
+ = "llvm_dibuild_create_class_type_bytecode" "llvm_dibuild_create_class_type_native"
external dibuild_create_artificial_type :
lldibuilder -> ty:Llvm.llmetadata -> Llvm.llmetadata
@@ -533,6 +530,25 @@ let instr_set_debug_loc i mopt =
| None -> instr_set_debug_loc_helper i (llmetadata_null ())
| Some m -> instr_set_debug_loc_helper i m
+external dibuild_create_constant_value_expression :
+ lldibuilder -> int -> Llvm.llmetadata
+ = "llvm_dibuild_create_constant_value_expression"
+
+external dibuild_create_global_variable_expression :
+ lldibuilder ->
+ scope:Llvm.llmetadata ->
+ name:string ->
+ linkage:string ->
+ file:Llvm.llmetadata ->
+ line:int ->
+ ty:Llvm.llmetadata ->
+ is_local_to_unit:bool ->
+ expr:Llvm.llmetadata ->
+ decl:Llvm.llmetadata ->
+ align_in_bits:int ->
+ Llvm.llmetadata
+ = "llvm_dibuild_create_global_variable_expression_bytecode" "llvm_dibuild_create_global_variable_expression_native"
+
external di_global_variable_expression_get_variable :
Llvm.llmetadata -> Llvm.llmetadata option
= "llvm_di_global_variable_expression_get_variable"
diff --git a/llvm/bindings/ocaml/debuginfo/llvm_debuginfo.mli b/llvm/bindings/ocaml/debuginfo/llvm_debuginfo.mli
index 24e31c7e1ffd..3c764e8b856a 100644
--- a/llvm/bindings/ocaml/debuginfo/llvm_debuginfo.mli
+++ b/llvm/bindings/ocaml/debuginfo/llvm_debuginfo.mli
@@ -202,7 +202,7 @@ val dibuild_create_namespace :
lldibuilder ->
parent_ref:Llvm.llmetadata ->
name:string ->
- bool:string ->
+ export_symbols:bool ->
Llvm.llmetadata
(** [dibuild_create_namespace] Create a new descriptor for a namespace with
the specified parent scope. See LLVMDIBuilderCreateNameSpace *)
@@ -234,6 +234,11 @@ val dibuild_create_lexical_block :
(** [dibuild_create_lexical_block] Create a descriptor for a lexical block with
the specified parent context. See LLVMDIBuilderCreateLexicalBlock *)
+val llmetadata_null : unit -> Llvm.llmetadata
+(** [llmetadata_null ()] llmetadata is a wrapper around "llvm::Metadata *".
+ This function returns a nullptr valued llmetadata. For example, it
+ can be used to convey an llmetadata for "void" type. *)
+
val dibuild_create_debug_location :
?inlined_at:Llvm.llmetadata ->
Llvm.llcontext ->
@@ -277,6 +282,28 @@ val dibuild_get_or_create_type_array :
(** [dibuild_get_or_create_type_array] Create a type array.
See LLVMDIBuilderGetOrCreateTypeArray. *)
+val dibuild_create_constant_value_expression :
+ lldibuilder -> int -> Llvm.llmetadata
+(** [dibuild_create_constant_value_expression] Create a new descriptor for
+ the specified variable that does not have an address, but does have
+ a constant value. See LLVMDIBuilderCreateConstantValueExpression. *)
+
+val dibuild_create_global_variable_expression :
+ lldibuilder ->
+ scope:Llvm.llmetadata ->
+ name:string ->
+ linkage:string ->
+ file:Llvm.llmetadata ->
+ line:int ->
+ ty:Llvm.llmetadata ->
+ is_local_to_unit:bool ->
+ expr:Llvm.llmetadata ->
+ decl:Llvm.llmetadata ->
+ align_in_bits:int ->
+ Llvm.llmetadata
+(** [dibuild_create_global_variable_expression] Create a new descriptor for
+ the specified variable. See LLVMDIBuilderCreateGlobalVariableExpression. *)
+
val di_global_variable_expression_get_variable :
Llvm.llmetadata -> Llvm.llmetadata option
(** [di_global_variable_expression_get_variable gve] returns the debug variable
@@ -391,7 +418,7 @@ val dibuild_create_struct_type :
lldiflags ->
derived_from:Llvm.llmetadata ->
elements:Llvm.llmetadata array ->
- run_time_lang:int ->
+ DWARFSourceLanguageKind.t ->
vtable_holder:Llvm.llmetadata ->
unique_id:string ->
Llvm.llmetadata
@@ -471,7 +498,7 @@ val dibuild_create_typedef :
(** [dibuild_create_typedef] Create debugging information entry for a typedef.
See LLVMDIBuilderCreateTypedef. *)
-val dibuild_create_inheritance_native :
+val dibuild_create_inheritance :
lldibuilder ->
ty:Llvm.llmetadata ->
base_ty:Llvm.llmetadata ->
@@ -479,7 +506,7 @@ val dibuild_create_inheritance_native :
vb_ptr_offset:int ->
lldiflags ->
Llvm.llmetadata
-(** [dibuild_create_inheritance_native] Create debugging information entry
+(** [dibuild_create_inheritance] Create debugging information entry
to establish inheritance relationship between two types.
See LLVMDIBuilderCreateInheritance. *)
diff --git a/llvm/test/Bindings/OCaml/.ocamlformat b/llvm/test/Bindings/OCaml/.ocamlformat
new file mode 100644
index 000000000000..e69de29bb2d1
diff --git a/llvm/test/Bindings/OCaml/Utils/Testsuite.ml b/llvm/test/Bindings/OCaml/Utils/Testsuite.ml
new file mode 100644
index 000000000000..7a8955a7a2fd
--- /dev/null
+++ b/llvm/test/Bindings/OCaml/Utils/Testsuite.ml
@@ -0,0 +1,33 @@
+(* Tiny unit test framework - really just to help find which line is busted *)
+let exit_status = ref 0
+
+let suite_name = ref ""
+
+let group_name = ref ""
+
+let case_num = ref 0
+
+let print_checkpoints = false
+
+let group name =
+ group_name := !suite_name ^ "/" ^ name;
+ case_num := 0;
+ if print_checkpoints then prerr_endline (" " ^ name ^ "...")
+
+let insist ?(exit_on_fail = false) cond =
+ incr case_num;
+ if not cond then exit_status := 10;
+ ( match (print_checkpoints, cond) with
+ | false, true -> ()
+ | false, false ->
+ prerr_endline
+ ( "FAILED: " ^ !suite_name ^ "/" ^ !group_name ^ " #"
+ ^ string_of_int !case_num )
+ | true, true -> prerr_endline (" " ^ string_of_int !case_num)
+ | true, false -> prerr_endline (" " ^ string_of_int !case_num ^ " FAIL") );
+ if exit_on_fail && not cond then exit !exit_status else ()
+
+let suite name f =
+ suite_name := name;
+ if print_checkpoints then prerr_endline (name ^ ":");
+ f ()
diff --git a/llvm/test/Bindings/OCaml/Utils/lit.local.cfg b/llvm/test/Bindings/OCaml/Utils/lit.local.cfg
new file mode 100644
index 000000000000..53edf1edae2a
--- /dev/null
+++ b/llvm/test/Bindings/OCaml/Utils/lit.local.cfg
@@ -0,0 +1,2 @@
+# This is a directory for utility functions. No test here.
+config.suffixes = ['.dummy']
diff --git a/llvm/test/Bindings/OCaml/core.ml b/llvm/test/Bindings/OCaml/core.ml
index 532171a1842c..cedf83af18d7 100644
--- a/llvm/test/Bindings/OCaml/core.ml
+++ b/llvm/test/Bindings/OCaml/core.ml
@@ -1,7 +1,7 @@
-(* RUN: rm -rf %t && mkdir -p %t && cp %s %t/core.ml
- * RUN: %ocamlc -g -w +A -package llvm.analysis -package llvm.bitwriter -linkpkg %t/core.ml -o %t/executable
+(* RUN: rm -rf %t && mkdir -p %t && cp %s %t/core.ml && cp %S/Utils/Testsuite.ml %t/Testsuite.ml
+ * RUN: %ocamlc -g -w +A -package llvm.analysis -package llvm.bitwriter -I %t/ -linkpkg %t/Testsuite.ml %t/core.ml -o %t/executable
* RUN: %t/executable %t/bitcode.bc
- * RUN: %ocamlopt -g -w +A -package llvm.analysis -package llvm.bitwriter -linkpkg %t/core.ml -o %t/executable
+ * RUN: %ocamlopt -g -w +A -package llvm.analysis -package llvm.bitwriter -I %t/ -linkpkg %t/Testsuite.ml %t/core.ml -o %t/executable
* RUN: %t/executable %t/bitcode.bc
* RUN: llvm-dis < %t/bitcode.bc > %t/dis.ll
* RUN: FileCheck %s < %t/dis.ll
@@ -17,13 +17,7 @@
open Llvm
open Llvm_bitwriter
-
-(* Tiny unit test framework - really just to help find which line is busted *)
-let exit_status = ref 0
-let suite_name = ref ""
-let group_name = ref ""
-let case_num = ref 0
-let print_checkpoints = false
+open Testsuite
let context = global_context ()
let i1_type = Llvm.i1_type context
let i8_type = Llvm.i8_type context
@@ -35,32 +29,6 @@ let float_type = Llvm.float_type context
let double_type = Llvm.double_type context
let fp128_type = Llvm.fp128_type context
-let group name =
- group_name := !suite_name ^ "/" ^ name;
- case_num := 0;
- if print_checkpoints then
- prerr_endline (" " ^ name ^ "...")
-
-let insist cond =
- incr case_num;
- if not cond then
- exit_status := 10;
- match print_checkpoints, cond with
- | false, true -> ()
- | false, false ->
- prerr_endline ("FAILED: " ^ !suite_name ^ "/" ^ !group_name ^ " #" ^ (string_of_int !case_num))
- | true, true ->
- prerr_endline (" " ^ (string_of_int !case_num))
- | true, false ->
- prerr_endline (" " ^ (string_of_int !case_num) ^ " FAIL")
-
-let suite name f =
- suite_name := name;
- if print_checkpoints then
- prerr_endline (name ^ ":");
- f ()
-
-
(*===-- Fixture -----------------------------------------------------------===*)
let filename = Sys.argv.(1)
diff --git a/llvm/test/Bindings/OCaml/debuginfo.ml b/llvm/test/Bindings/OCaml/debuginfo.ml
new file mode 100644
index 000000000000..345d8e8eb906
--- /dev/null
+++ b/llvm/test/Bindings/OCaml/debuginfo.ml
@@ -0,0 +1,413 @@
+(* RUN: rm -rf %t && mkdir -p %t && cp %s %t/debuginfo.ml && cp %S/Utils/Testsuite.ml %t/Testsuite.ml
+ * RUN: %ocamlc -g -w +A -package llvm.all_backends -package llvm.target -package llvm.analysis -package llvm.debuginfo -I %t/ -linkpkg %t/Testsuite.ml %t/debuginfo.ml -o %t/executable
+ * RUN: %t/executable | FileCheck %s
+ * RUN: %ocamlopt -g -w +A -package llvm.all_backends -package llvm.target -package llvm.analysis -package llvm.debuginfo -I %t/ -linkpkg %t/Testsuite.ml %t/debuginfo.ml -o %t/executable
+ * RUN: %t/executable | FileCheck %s
+ * XFAIL: vg_leak
+ *)
+
+open Testsuite
+
+let context = Llvm.global_context ()
+
+let filename = "di_test_file"
+
+let directory = "di_test_dir"
+
+let module_name = "di_test_module"
+
+let null_metadata = Llvm_debuginfo.llmetadata_null ()
+
+let string_of_metadata md =
+ Llvm.string_of_llvalue (Llvm.metadata_as_value context md)
+
+let stdout_metadata md = Printf.printf "%s\n" (string_of_metadata md)
+
+let prepare_target llmod =
+ Llvm_all_backends.initialize ();
+ let triple = Llvm_target.Target.default_triple () in
+ let lltarget = Llvm_target.Target.by_triple triple in
+ let llmachine = Llvm_target.TargetMachine.create ~triple lltarget in
+ let lldly =
+ Llvm_target.DataLayout.as_string
+ (Llvm_target.TargetMachine.data_layout llmachine)
+ in
+ let _ = Llvm.set_target_triple triple llmod in
+ let _ = Llvm.set_data_layout lldly llmod in
+ ()
+
+let new_module () =
+ let m = Llvm.create_module context module_name in
+ let () = prepare_target m in
+ m
+
+let test_get_module () =
+ group "module_level_tests";
+ let m = new_module () in
+ let cur_ver = Llvm_debuginfo.debug_metadata_version () in
+ insist (cur_ver > 0);
+ let m_ver = Llvm_debuginfo.get_module_debug_metadata_version m in
+ (* We haven't added any debug info to the module *)
+ insist (m_ver = 0);
+ let dibuilder = Llvm_debuginfo.dibuilder m in
+ let di_version_key = "Debug Info Version" in
+ let ver =
+ Llvm.value_as_metadata @@ Llvm.const_int (Llvm.i32_type context) cur_ver
+ in
+ let () =
+ Llvm.add_module_flag m Llvm.ModuleFlagBehavior.Warning di_version_key ver
+ in
+ let file_di =
+ Llvm_debuginfo.dibuild_create_file dibuilder ~filename ~directory
+ in
+ stdout_metadata file_di;
+ (* CHECK: [[FILE_PTR:<0x[0-9a-f]*>]] = !DIFile(filename: "di_test_file", directory: "di_test_dir")
+ *)
+ insist
+ ( Llvm_debuginfo.di_file_get_filename ~file:file_di = filename
+ && Llvm_debuginfo.di_file_get_directory ~file:file_di = directory );
+ insist
+ ( Llvm_debuginfo.get_metadata_kind file_di
+ = Llvm_debuginfo.MetadataKind.DIFileMetadataKind );
+ let cu_di =
+ Llvm_debuginfo.dibuild_create_compile_unit dibuilder
+ Llvm_debuginfo.DWARFSourceLanguageKind.C89 ~file_ref:file_di
+ ~producer:"TestGen" ~is_optimized:false ~flags:"" ~runtime_ver:0
+ ~split_name:"" Llvm_debuginfo.DWARFEmissionKind.LineTablesOnly ~dwoid:0
+ ~di_inlining:false ~di_profiling:false ~sys_root:"" ~sdk:""
+ in
+ stdout_metadata cu_di;
+ (* CHECK: [[CMPUNIT_PTR:<0x[0-9a-f]*>]] = distinct !DICompileUnit(language: DW_LANG_C89, file: [[FILE_PTR]], producer: "TestGen", isOptimized: false, runtimeVersion: 0, emissionKind: LineTablesOnly, splitDebugInlining: false)
+ *)
+ insist
+ ( Llvm_debuginfo.get_metadata_kind cu_di
+ = Llvm_debuginfo.MetadataKind.DICompileUnitMetadataKind );
+ let m_di =
+ Llvm_debuginfo.dibuild_create_module dibuilder ~parent_ref:cu_di
+ ~name:module_name ~config_macros:"" ~include_path:"" ~sys_root:""
+ in
+ insist
+ ( Llvm_debuginfo.get_metadata_kind m_di
+ = Llvm_debuginfo.MetadataKind.DIModuleMetadataKind );
+ insist (Llvm_debuginfo.get_module_debug_metadata_version m = cur_ver);
+ stdout_metadata m_di;
+ (* CHECK: [[MODULE_PTR:<0x[0-9a-f]*>]] = !DIModule(scope: null, name: "di_test_module")
+ *)
+ (m, dibuilder, file_di, m_di)
+
+let flags_zero = Llvm_debuginfo.diflags_get Llvm_debuginfo.DIFlag.Zero
+
+let int_ty_di bits dibuilder =
+ Llvm_debuginfo.dibuild_create_basic_type dibuilder ~name:"int"
+ ~size_in_bits:bits ~encoding:0x05
+ (* llvm::dwarf::DW_ATE_signed *) flags_zero
+
+let test_get_function m dibuilder file_di m_di =
+ group "function_level_tests";
+
+ (* Create a function of type "void foo (int)". *)
+ let int_ty_di = int_ty_di 32 dibuilder in
+ stdout_metadata int_ty_di;
+ (* CHECK: [[INT32_PTR:<0x[0-9a-f]*>]] = !DIBasicType(name: "int", size: 32, encoding: DW_ATE_signed)
+ *)
+ let param_types = [| null_metadata; int_ty_di |] in
+ let fty_di =
+ Llvm_debuginfo.dibuild_create_subroutine_type dibuilder ~file:file_di
+ ~param_types flags_zero
+ in
+ insist
+ ( Llvm_debuginfo.get_metadata_kind fty_di
+ = Llvm_debuginfo.MetadataKind.DISubroutineTypeMetadataKind );
+ (* To be able to print and verify the type array of the subroutine type,
+ * since we have no way to access it from fty_di, we build it again. *)
+ let fty_di_args =
+ Llvm_debuginfo.dibuild_get_or_create_type_array dibuilder ~data:param_types
+ in
+ stdout_metadata fty_di_args;
+ (* CHECK: [[FARGS_PTR:<0x[0-9a-f]*>]] = !{null, [[INT32_PTR]]}
+ *)
+ stdout_metadata fty_di;
+ (* CHECK: [[SBRTNTY_PTR:<0x[0-9a-f]*>]] = !DISubroutineType(types: [[FARGS_PTR]])
+ *)
+ (* Let's create the LLVM-IR function now. *)
+ let name = "tfun" in
+ let fty =
+ Llvm.function_type (Llvm.void_type context) [| Llvm.i32_type context |]
+ in
+ let f = Llvm.define_function name fty m in
+ let f_di =
+ Llvm_debuginfo.dibuild_create_function dibuilder ~scope:m_di ~name
+ ~linkage_name:name ~file:file_di ~line_no:10 ~ty:fty_di
+ ~is_local_to_unit:false ~is_definition:true ~scope_line:10
+ ~flags:flags_zero ~is_optimized:false
+ in
+ stdout_metadata f_di;
+ (* CHECK: [[SBPRG_PTR:<0x[0-9a-f]*>]] = distinct !DISubprogram(name: "tfun", linkageName: "tfun", scope: [[MODULE_PTR]], file: [[FILE_PTR]], line: 10, type: [[SBRTNTY_PTR]], scopeLine: 10, spFlags: DISPFlagDefinition, unit: [[CMPUNIT_PTR]], retainedNodes: {{<0x[0-9a-f]*>}})
+ *)
+ Llvm_debuginfo.set_subprogram f f_di;
+ ( match Llvm_debuginfo.get_subprogram f with
+ | Some f_di' -> insist (f_di = f_di')
+ | None -> insist false );
+ insist
+ ( Llvm_debuginfo.get_metadata_kind f_di
+ = Llvm_debuginfo.MetadataKind.DISubprogramMetadataKind );
+ insist (Llvm_debuginfo.di_subprogram_get_line f_di = 10);
+ (f, f_di)
+
+let test_bbinstr f f_di file_di dibuilder =
+ group "basic_block and instructions tests";
+ (* Create this pattern:
+ * if (arg0 != 0) {
+ * foo(arg0);
+ * }
+ * return;
+ *)
+ let arg0 = (Llvm.params f).(0) in
+ let builder = Llvm.builder_at_end context (Llvm.entry_block f) in
+ let zero = Llvm.const_int (Llvm.i32_type context) 0 in
+ let cmpi = Llvm.build_icmp Llvm.Icmp.Ne zero arg0 "cmpi" builder in
+ let truebb = Llvm.append_block context "truebb" f in
+ let falsebb = Llvm.append_block context "falsebb" f in
+ let _ = Llvm.build_cond_br cmpi truebb falsebb builder in
+ let foodecl =
+ Llvm.declare_function "foo"
+ (Llvm.element_type (Llvm.type_of f))
+ (Llvm.global_parent f)
+ in
+ let _ =
+ Llvm.position_at_end truebb builder;
+ let scope =
+ Llvm_debuginfo.dibuild_create_lexical_block dibuilder ~scope:f_di
+ ~file:file_di ~line:9 ~column:4
+ in
+ let file_of_f_di = Llvm_debuginfo.di_scope_get_file ~scope:f_di in
+ let file_of_scope = Llvm_debuginfo.di_scope_get_file ~scope in
+ insist
+ ( Option.is_some file_of_f_di
+ && Option.get file_of_f_di = file_di
+ && Option.is_some file_of_scope
+ && Option.get file_of_f_di = file_di );
+ let foocall = Llvm.build_call foodecl [| arg0 |] "" builder in
+ let foocall_loc =
+ Llvm_debuginfo.dibuild_create_debug_location context ~line:10 ~column:12
+ ~scope
+ in
+ Llvm_debuginfo.instr_set_debug_loc foocall (Some foocall_loc);
+ insist
+ ( match Llvm_debuginfo.instr_get_debug_loc foocall with
+ | Some foocall_loc' -> foocall_loc' = foocall_loc
+ | None -> false );
+ stdout_metadata scope;
+ (* CHECK: [[BLOCK_PTR:<0x[0-9a-f]*>]] = distinct !DILexicalBlock(scope: [[SBPRG_PTR]], file: [[FILE_PTR]], line: 9, column: 4)
+ *)
+ stdout_metadata foocall_loc;
+ (* CHECK: !DILocation(line: 10, column: 12, scope: [[BLOCK_PTR]])
+ *)
+ insist
+ ( Llvm_debuginfo.di_location_get_scope ~location:foocall_loc = scope
+ && Llvm_debuginfo.di_location_get_line ~location:foocall_loc = 10
+ && Llvm_debuginfo.di_location_get_column ~location:foocall_loc = 12 );
+ insist
+ ( Llvm_debuginfo.get_metadata_kind foocall_loc
+ = Llvm_debuginfo.MetadataKind.DILocationMetadataKind
+ && Llvm_debuginfo.get_metadata_kind scope
+ = Llvm_debuginfo.MetadataKind.DILexicalBlockMetadataKind );
+ Llvm.build_br falsebb builder
+ in
+ let _ =
+ Llvm.position_at_end falsebb builder;
+ Llvm.build_ret_void builder
+ in
+ (* Printf.printf "%s\n" (Llvm.string_of_llmodule (Llvm.global_parent f)); *)
+ ()
+
+let test_global_variable_expression dibuilder f_di m_di =
+ group "global variable expression tests";
+ let cexpr_di =
+ Llvm_debuginfo.dibuild_create_constant_value_expression dibuilder 0
+ in
+ stdout_metadata cexpr_di;
+ (* CHECK: [[DICEXPR:!DIExpression\(DW_OP_constu, 0, DW_OP_stack_value\)]]
+ *)
+ insist
+ ( Llvm_debuginfo.get_metadata_kind cexpr_di
+ = Llvm_debuginfo.MetadataKind.DIExpressionMetadataKind );
+ let ty = int_ty_di 64 dibuilder in
+ stdout_metadata ty;
+ (* CHECK: [[INT64TY_PTR:<0x[0-9a-f]*>]] = !DIBasicType(name: "int", size: 64, encoding: DW_ATE_signed)
+ *)
+ let gvexpr_di =
+ Llvm_debuginfo.dibuild_create_global_variable_expression dibuilder
+ ~scope:m_di ~name:"my_global" ~linkage:"" ~file:f_di ~line:5 ~ty
+ ~is_local_to_unit:true ~expr:cexpr_di ~decl:null_metadata ~align_in_bits:0
+ in
+ insist
+ ( Llvm_debuginfo.get_metadata_kind gvexpr_di
+ = Llvm_debuginfo.MetadataKind.DIGlobalVariableExpressionMetadataKind );
+ ( match
+ Llvm_debuginfo.di_global_variable_expression_get_variable gvexpr_di
+ with
+ | Some gvexpr_var_di ->
+ insist
+ ( Llvm_debuginfo.get_metadata_kind gvexpr_var_di
+ = Llvm_debuginfo.MetadataKind.DIGlobalVariableMetadataKind );
+ stdout_metadata gvexpr_var_di
+ (* CHECK: [[GV_PTR:<0x[0-9a-f]*>]] = distinct !DIGlobalVariable(name: "my_global", scope: [[MODULE_PTR]], file: [[FILE_PTR]], line: 5, type: [[INT64TY_PTR]], isLocal: true, isDefinition: true)
+ *)
+ | None -> insist false );
+ stdout_metadata gvexpr_di;
+ (* CHECK: [[GVEXP_PTR:<0x[0-9a-f]*>]] = !DIGlobalVariableExpression(var: [[GV_PTR]], expr: [[DICEXPR]])
+ *)
+ ()
+
+let test_types dibuilder file_di m_di =
+ group "type tests";
+ let namespace_di =
+ Llvm_debuginfo.dibuild_create_namespace dibuilder ~parent_ref:m_di
+ ~name:"NameSpace1" ~export_symbols:false
+ in
+ stdout_metadata namespace_di;
+ (* CHECK: [[NAMESPACE_PTR:<0x[0-9a-f]*>]] = !DINamespace(name: "NameSpace1", scope: [[MODULE_PTR]])
+ *)
+ let int64_ty_di = int_ty_di 64 dibuilder in
+ let structty_args = [| int64_ty_di; int64_ty_di; int64_ty_di |] in
+ let struct_ty_di =
+ Llvm_debuginfo.dibuild_create_struct_type dibuilder ~scope:namespace_di
+ ~name:"StructType1" ~file:file_di ~line_number:20 ~size_in_bits:192
+ ~align_in_bits:0 flags_zero ~derived_from:null_metadata
+ ~elements:structty_args Llvm_debuginfo.DWARFSourceLanguageKind.C89
+ ~vtable_holder:null_metadata ~unique_id:"StructType1"
+ in
+ (* Since there's no way to fetch the element types which is now
+ * a type array, we build that again for checking. *)
+ let structty_di_eltypes =
+ Llvm_debuginfo.dibuild_get_or_create_type_array dibuilder
+ ~data:structty_args
+ in
+ stdout_metadata structty_di_eltypes;
+ (* CHECK: [[STRUCTELT_PTR:<0x[0-9a-f]*>]] = !{[[INT64TY_PTR]], [[INT64TY_PTR]], [[INT64TY_PTR]]}
+ *)
+ stdout_metadata struct_ty_di;
+ (* CHECK: [[STRUCT_PTR:<0x[0-9a-f]*>]] = !DICompositeType(tag: DW_TAG_structure_type, name: "StructType1", scope: [[NAMESPACE_PTR]], file: [[FILE_PTR]], line: 20, size: 192, elements: [[STRUCTELT_PTR]], identifier: "StructType1")
+ *)
+ insist
+ ( Llvm_debuginfo.get_metadata_kind struct_ty_di
+ = Llvm_debuginfo.MetadataKind.DICompositeTypeMetadataKind );
+ let structptr_di =
+ Llvm_debuginfo.dibuild_create_pointer_type dibuilder
+ ~pointee_ty:struct_ty_di ~size_in_bits:192 ~align_in_bits:0
+ ~address_space:0 ~name:""
+ in
+ stdout_metadata structptr_di;
+ (* CHECK: [[STRUCTPTR_PTR:<0x[0-9a-f]*>]] = !DIDerivedType(tag: DW_TAG_pointer_type, baseType: [[STRUCT_PTR]], size: 192, dwarfAddressSpace: 0)
+ *)
+ insist
+ ( Llvm_debuginfo.get_metadata_kind structptr_di
+ = Llvm_debuginfo.MetadataKind.DIDerivedTypeMetadataKind );
+ let enumerator1 =
+ Llvm_debuginfo.dibuild_create_enumerator dibuilder ~name:"Test_A" ~value:0
+ ~is_unsigned:true
+ in
+ stdout_metadata enumerator1;
+ (* CHECK: [[ENUMERATOR1_PTR:<0x[0-9a-f]*>]] = !DIEnumerator(name: "Test_A", value: 0, isUnsigned: true)
+ *)
+ let enumerator2 =
+ Llvm_debuginfo.dibuild_create_enumerator dibuilder ~name:"Test_B" ~value:1
+ ~is_unsigned:true
+ in
+ stdout_metadata enumerator2;
+ (* CHECK: [[ENUMERATOR2_PTR:<0x[0-9a-f]*>]] = !DIEnumerator(name: "Test_B", value: 1, isUnsigned: true)
+ *)
+ let enumerator3 =
+ Llvm_debuginfo.dibuild_create_enumerator dibuilder ~name:"Test_C" ~value:2
+ ~is_unsigned:true
+ in
+ insist
+ ( Llvm_debuginfo.get_metadata_kind enumerator1
+ = Llvm_debuginfo.MetadataKind.DIEnumeratorMetadataKind
+ && Llvm_debuginfo.get_metadata_kind enumerator2
+ = Llvm_debuginfo.MetadataKind.DIEnumeratorMetadataKind
+ && Llvm_debuginfo.get_metadata_kind enumerator3
+ = Llvm_debuginfo.MetadataKind.DIEnumeratorMetadataKind );
+ stdout_metadata enumerator3;
+ (* CHECK: [[ENUMERATOR3_PTR:<0x[0-9a-f]*>]] = !DIEnumerator(name: "Test_C", value: 2, isUnsigned: true)
+ *)
+ let elements = [| enumerator1; enumerator2; enumerator3 |] in
+ let enumeration_ty_di =
+ Llvm_debuginfo.dibuild_create_enumeration_type dibuilder ~scope:namespace_di
+ ~name:"EnumTest" ~file:file_di ~line_number:1 ~size_in_bits:64
+ ~align_in_bits:0 ~elements ~class_ty:int64_ty_di
+ in
+ let elements_arr =
+ Llvm_debuginfo.dibuild_get_or_create_type_array dibuilder ~data:elements
+ in
+ stdout_metadata elements_arr;
+ (* CHECK: [[ELEMENTS_PTR:<0x[0-9a-f]*>]] = !{[[ENUMERATOR1_PTR]], [[ENUMERATOR2_PTR]], [[ENUMERATOR3_PTR]]}
+ *)
+ stdout_metadata enumeration_ty_di;
+ (* CHECK: [[ENUMERATION_PTR:<0x[0-9a-f]*>]] = !DICompositeType(tag: DW_TAG_enumeration_type, name: "EnumTest", scope: [[NAMESPACE_PTR]], file: [[FILE_PTR]], line: 1, baseType: [[INT64TY_PTR]], size: 64, elements: [[ELEMENTS_PTR]])
+ *)
+ insist
+ ( Llvm_debuginfo.get_metadata_kind enumeration_ty_di
+ = Llvm_debuginfo.MetadataKind.DICompositeTypeMetadataKind );
+ let int32_ty_di = int_ty_di 32 dibuilder in
+ let class_mem1 =
+ Llvm_debuginfo.dibuild_create_member_type dibuilder ~scope:namespace_di
+ ~name:"Field1" ~file:file_di ~line_number:3 ~size_in_bits:32
+ ~align_in_bits:0 ~offset_in_bits:0 flags_zero ~ty:int32_ty_di
+ in
+ stdout_metadata class_mem1;
+ (* CHECK: [[MEMB1_PTR:<0x[0-9a-f]*>]] = !DIDerivedType(tag: DW_TAG_member, name: "Field1", scope: [[NAMESPACE_PTR]], file: [[FILE_PTR]], line: 3, baseType: [[INT32_PTR]], size: 32)
+ *)
+ insist (Llvm_debuginfo.di_type_get_name class_mem1 = "Field1");
+ insist (Llvm_debuginfo.di_type_get_line class_mem1 = 3);
+ let class_mem2 =
+ Llvm_debuginfo.dibuild_create_member_type dibuilder ~scope:namespace_di
+ ~name:"Field2" ~file:file_di ~line_number:4 ~size_in_bits:64
+ ~align_in_bits:8 ~offset_in_bits:32 flags_zero ~ty:int64_ty_di
+ in
+ stdout_metadata class_mem2;
+ (* CHECK: [[MEMB2_PTR:<0x[0-9a-f]*>]] = !DIDerivedType(tag: DW_TAG_member, name: "Field2", scope: [[NAMESPACE_PTR]], file: [[FILE_PTR]], line: 4, baseType: [[INT64TY_PTR]], size: 64, align: 8, offset: 32)
+ *)
+ insist (Llvm_debuginfo.di_type_get_offset_in_bits class_mem2 = 32);
+ insist (Llvm_debuginfo.di_type_get_size_in_bits class_mem2 = 64);
+ insist (Llvm_debuginfo.di_type_get_align_in_bits class_mem2 = 8);
+ let class_elements = [| class_mem1; class_mem2 |] in
+ insist
+ ( Llvm_debuginfo.get_metadata_kind class_mem1
+ = Llvm_debuginfo.MetadataKind.DIDerivedTypeMetadataKind
+ && Llvm_debuginfo.get_metadata_kind class_mem2
+ = Llvm_debuginfo.MetadataKind.DIDerivedTypeMetadataKind );
+ stdout_metadata
+ (Llvm_debuginfo.dibuild_get_or_create_type_array dibuilder
+ ~data:class_elements);
+ (* CHECK: [[CLASSMEM_PTRS:<0x[0-9a-f]*>]] = !{[[MEMB1_PTR]], [[MEMB2_PTR]]}
+ *)
+ let classty_di =
+ Llvm_debuginfo.dibuild_create_class_type dibuilder ~scope:namespace_di
+ ~name:"MyClass" ~file:file_di ~line_number:1 ~size_in_bits:96
+ ~align_in_bits:0 ~offset_in_bits:0 flags_zero ~derived_from:null_metadata
+ ~elements:class_elements ~vtable_holder:null_metadata
+ ~template_params_node:null_metadata ~unique_identifier:"MyClass"
+ in
+ stdout_metadata classty_di;
+ (* [[CLASS_PTR:<0x[0-9a-f]*>]] = !DICompositeType(tag: DW_TAG_structure_type, name: "MyClass", scope: [[NAMESPACE_PTR]], file: [[FILE_PTR]], line: 1, size: 96, elements: [[CLASSMEM_PTRS]], identifier: "MyClass")
+ *)
+ insist
+ ( Llvm_debuginfo.get_metadata_kind classty_di
+ = Llvm_debuginfo.MetadataKind.DICompositeTypeMetadataKind );
+ ()
+
+let () =
+ let m, dibuilder, file_di, m_di = test_get_module () in
+ let f, fun_di = test_get_function m dibuilder file_di m_di in
+ let () = test_bbinstr f fun_di file_di dibuilder in
+ let () = test_global_variable_expression dibuilder file_di m_di in
+ let () = test_types dibuilder file_di m_di in
+ Llvm_debuginfo.dibuild_finalize dibuilder;
+ ( match Llvm_analysis.verify_module m with
+ | Some err ->
+ prerr_endline ("Verification of module failed: " ^ err);
+ exit_status := 1
+ | None -> () );
+ exit !exit_status
More information about the llvm-commits
mailing list