From b02b87882788e57e180c6b903a37ced0db1ce828 Mon Sep 17 00:00:00 2001 From: Erick Tryzelaar Date: Wed, 19 Aug 2009 17:32:24 +0000 Subject: Convert the rest of the ocaml types and functions to use context. git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@79430 91177308-0d34-0410-b5e6-96231b3b80d8 --- test/Bindings/Ocaml/analysis.ml | 8 ++-- test/Bindings/Ocaml/bitreader.ml | 2 +- test/Bindings/Ocaml/bitwriter.ml | 6 ++- test/Bindings/Ocaml/executionengine.ml | 6 +++ test/Bindings/Ocaml/scalar_opts.ml | 6 ++- test/Bindings/Ocaml/target.ml | 8 +++- test/Bindings/Ocaml/vmcore.ml | 67 +++++++++++++++++++--------------- 7 files changed, 64 insertions(+), 39 deletions(-) (limited to 'test') diff --git a/test/Bindings/Ocaml/analysis.ml b/test/Bindings/Ocaml/analysis.ml index f1fbe32a82..29ebb92247 100644 --- a/test/Bindings/Ocaml/analysis.ml +++ b/test/Bindings/Ocaml/analysis.ml @@ -8,6 +8,8 @@ open Llvm_analysis (* Note that this takes a moment to link, so it's best to keep the number of individual tests low. *) +let context = global_context () + let test x = if not x then exit 1 else () let bomb msg = @@ -15,10 +17,10 @@ let bomb msg = exit 2 let _ = - let fty = function_type void_type [| |] in - let m = create_module (global_context ()) "valid_m" in + let fty = function_type (void_type context) [| |] in + let m = create_module context "valid_m" in let fn = define_function "valid_fn" fty m in - let at_entry = builder_at_end (global_context ()) (entry_block fn) in + let at_entry = builder_at_end context (entry_block fn) in ignore (build_ret_void at_entry); diff --git a/test/Bindings/Ocaml/bitreader.ml b/test/Bindings/Ocaml/bitreader.ml index 2b93123216..2abeda95f5 100644 --- a/test/Bindings/Ocaml/bitreader.ml +++ b/test/Bindings/Ocaml/bitreader.ml @@ -14,7 +14,7 @@ let _ = let fn = Sys.argv.(1) in let m = Llvm.create_module context "ocaml_test_module" in - ignore (Llvm.define_type_name "caml_int_ty" Llvm.i32_type m); + ignore (Llvm.define_type_name "caml_int_ty" (Llvm.i32_type context) m); test (Llvm_bitwriter.write_bitcode_file m fn); diff --git a/test/Bindings/Ocaml/bitwriter.ml b/test/Bindings/Ocaml/bitwriter.ml index bb769b2173..42c8daec5d 100644 --- a/test/Bindings/Ocaml/bitwriter.ml +++ b/test/Bindings/Ocaml/bitwriter.ml @@ -6,11 +6,13 @@ (* Note that this takes a moment to link, so it's best to keep the number of individual tests low. *) +let context = Llvm.global_context () + let test x = if not x then exit 1 else () let _ = - let m = Llvm.create_module (Llvm.global_context ()) "ocaml_test_module" in + let m = Llvm.create_module context "ocaml_test_module" in - ignore (Llvm.define_type_name "caml_int_ty" Llvm.i32_type m); + ignore (Llvm.define_type_name "caml_int_ty" (Llvm.i32_type context) m); test (Llvm_bitwriter.write_bitcode_file m Sys.argv.(1)) diff --git a/test/Bindings/Ocaml/executionengine.ml b/test/Bindings/Ocaml/executionengine.ml index 56cf6e86c7..420a14f67c 100644 --- a/test/Bindings/Ocaml/executionengine.ml +++ b/test/Bindings/Ocaml/executionengine.ml @@ -9,6 +9,12 @@ open Llvm_target (* Note that this takes a moment to link, so it's best to keep the number of individual tests low. *) +let context = global_context () +let i8_type = Llvm.i8_type context +let i32_type = Llvm.i32_type context +let i64_type = Llvm.i64_type context +let double_type = Llvm.double_type context + let bomb msg = prerr_endline msg; exit 2 diff --git a/test/Bindings/Ocaml/scalar_opts.ml b/test/Bindings/Ocaml/scalar_opts.ml index 936a0524f8..8f6802da76 100644 --- a/test/Bindings/Ocaml/scalar_opts.ml +++ b/test/Bindings/Ocaml/scalar_opts.ml @@ -9,6 +9,8 @@ open Llvm open Llvm_scalar_opts open Llvm_target +let context = global_context () +let void_type = Llvm.void_type context (* Tiny unit test framework - really just to help find which line is busted *) let suite name f = @@ -19,7 +21,7 @@ let suite name f = (*===-- Fixture -----------------------------------------------------------===*) let filename = Sys.argv.(1) -let m = create_module (global_context ()) filename +let m = create_module context filename let mp = ModuleProvider.create m @@ -30,7 +32,7 @@ let test_transforms () = let fty = function_type void_type [| |] in let fn = define_function "fn" fty m in - ignore (build_ret_void (builder_at_end (global_context ()) (entry_block fn))); + ignore (build_ret_void (builder_at_end context (entry_block fn))); let td = TargetData.create (target_triple m) in diff --git a/test/Bindings/Ocaml/target.ml b/test/Bindings/Ocaml/target.ml index 385bc8131e..f7d1cbf285 100644 --- a/test/Bindings/Ocaml/target.ml +++ b/test/Bindings/Ocaml/target.ml @@ -8,6 +8,10 @@ open Llvm open Llvm_target +let context = global_context () +let i32_type = Llvm.i32_type context +let i64_type = Llvm.i64_type context + (* Tiny unit test framework - really just to help find which line is busted *) let suite name f = prerr_endline (name ^ ":"); @@ -17,14 +21,14 @@ let suite name f = (*===-- Fixture -----------------------------------------------------------===*) let filename = Sys.argv.(1) -let m = create_module (global_context ()) filename +let m = create_module context filename (*===-- Target Data -------------------------------------------------------===*) let test_target_data () = let td = TargetData.create (target_triple m) in - let sty = struct_type (global_context ()) [| i32_type; i64_type |] in + let sty = struct_type context [| i32_type; i64_type |] in ignore (TargetData.as_string td); ignore (TargetData.invalidate_struct_layout td sty); diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml index f1fa23cc94..4f6d3eabf2 100644 --- a/test/Bindings/Ocaml/vmcore.ml +++ b/test/Bindings/Ocaml/vmcore.ml @@ -18,6 +18,15 @@ let group_name = ref "" let case_num = ref 0 let print_checkpoints = false let context = global_context () +let i1_type = Llvm.i1_type context +let i8_type = Llvm.i8_type context +let i16_type = Llvm.i16_type context +let i32_type = Llvm.i32_type context +let i64_type = Llvm.i64_type context +let void_type = Llvm.void_type context +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; @@ -94,7 +103,7 @@ let test_types () = (* RUN: grep {Ty04.*i42} < %t.ll *) group "i42"; - let ty = integer_type 42 in + let ty = integer_type context 42 in insist (define_type_name "Ty04" ty m); (* RUN: grep {Ty05.*float} < %t.ll @@ -165,22 +174,22 @@ let test_types () = (* RUN: grep {Ty12.*opaque} < %t.ll *) group "opaque"; - let ty = opaque_type () in + let ty = opaque_type context in insist (define_type_name "Ty12" ty m); insist (ty == ty); - insist (ty <> opaque_type ()); + insist (ty <> opaque_type context); (* RUN: grep -v {Ty13} < %t.ll *) group "delete"; - let ty = opaque_type () in + let ty = opaque_type context in insist (define_type_name "Ty13" ty m); delete_type_name "Ty13" m; (* RUN: grep -v {RecursiveTy.*RecursiveTy} < %t.ll *) group "recursive"; - let ty = opaque_type () in + let ty = opaque_type context in let th = handle_to_type ty in refine_type ty (pointer_type ty); let ty = type_of_handle th in @@ -223,14 +232,14 @@ let test_constants () = (* RUN: grep {Const04.*"cruel\\\\00world"} < %t.ll *) group "string"; - let c = const_string "cruel\000world" in + let c = const_string context "cruel\000world" in ignore (define_global "Const04" c m); insist ((array_type i8_type 11) = type_of c); (* RUN: grep {Const05.*"hi\\\\00again\\\\00"} < %t.ll *) group "stringz"; - let c = const_stringz "hi\000again" in + let c = const_stringz context "hi\000again" in ignore (define_global "Const05" c m); insist ((array_type i8_type 9) = type_of c); @@ -356,7 +365,7 @@ let test_constants () = * RUN: grep {ConstIntToPtr.*inttoptr} < %t.ll * RUN: grep {ConstBitCast.*bitcast} < %t.ll *) - let i128_type = integer_type 128 in + let i128_type = integer_type context 128 in ignore (define_global "ConstTrunc" (const_trunc (const_add foldbomb five) i8_type) m); ignore (define_global "ConstSExt" (const_sext foldbomb i128_type) m); @@ -673,7 +682,7 @@ let test_basic_blocks () = *) group "entry"; let fn = declare_function "X" ty m in - let bb = append_block "Bb1" fn in + let bb = append_block context "Bb1" fn in insist (bb = entry_block fn); ignore (build_unreachable (builder_at_end context bb)); @@ -681,13 +690,13 @@ let test_basic_blocks () = *) group "delete"; let fn = declare_function "X2" ty m in - let bb = append_block "Bb2" fn in + let bb = append_block context "Bb2" fn in delete_block bb; group "insert"; let fn = declare_function "X3" ty m in - let bbb = append_block "b" fn in - let bba = insert_block "a" bbb in + let bbb = append_block context "b" fn in + let bba = insert_block context "a" bbb in insist ([| bba; bbb |] = basic_blocks fn); ignore (build_unreachable (builder_at_end context bba)); ignore (build_unreachable (builder_at_end context bbb)); @@ -717,8 +726,8 @@ let test_basic_blocks () = insist (At_end f = block_begin f); insist (At_start f = block_end f); - let b1 = append_block "One" f in - let b2 = append_block "Two" f in + let b1 = append_block context "One" f in + let b2 = append_block context "Two" f in insist (Before b1 = block_begin f); insist (Before b2 = block_succ b1); @@ -804,7 +813,7 @@ let test_builder () = *) let fty = function_type void_type [| |] in let fn = declare_function "X6" fty m in - let b = builder_at_end context (append_block "Bb01" fn) in + let b = builder_at_end context (append_block context "Bb01" fn) in ignore (build_ret_void b) end; @@ -817,7 +826,7 @@ let test_builder () = let f1 = build_uitofp p1 float_type "F1" atentry in let f2 = build_uitofp p2 float_type "F2" atentry in - let bb00 = append_block "Bb00" fn in + let bb00 = append_block context "Bb00" fn in ignore (build_unreachable (builder_at_end context bb00)); group "ret"; begin @@ -830,7 +839,7 @@ let test_builder () = group "br"; begin (* RUN: grep {br.*Bb02} < %t.ll *) - let bb02 = append_block "Bb02" fn in + let bb02 = append_block context "Bb02" fn in let b = builder_at_end context bb02 in ignore (build_br bb02 b) end; @@ -838,7 +847,7 @@ let test_builder () = group "cond_br"; begin (* RUN: grep {br.*Inst01.*Bb03.*Bb00} < %t.ll *) - let bb03 = append_block "Bb03" fn in + let bb03 = append_block context "Bb03" fn in let b = builder_at_end context bb03 in let cond = build_trunc p1 i1_type "Inst01" b in ignore (build_cond_br cond bb03 bb00 b) @@ -848,10 +857,10 @@ let test_builder () = (* RUN: grep {switch.*P1.*SwiBlock3} < %t.ll * RUN: grep {2,.*SwiBlock2} < %t.ll *) - let bb1 = append_block "SwiBlock1" fn in - let bb2 = append_block "SwiBlock2" fn in + let bb1 = append_block context "SwiBlock1" fn in + let bb2 = append_block context "SwiBlock2" fn in ignore (build_unreachable (builder_at_end context bb2)); - let bb3 = append_block "SwiBlock3" fn in + let bb3 = append_block context "SwiBlock3" fn in ignore (build_unreachable (builder_at_end context bb3)); let si = build_switch p1 bb3 1 (builder_at_end context bb1) in ignore (add_case si (const_int i32_type 2) bb2) @@ -861,7 +870,7 @@ let test_builder () = (* RUN: grep {Inst02.*invoke.*P1.*P2} < %t.ll * RUN: grep {to.*Bb04.*unwind.*Bb00} < %t.ll *) - let bb04 = append_block "Bb04" fn in + let bb04 = append_block context "Bb04" fn in let b = builder_at_end context bb04 in ignore (build_invoke fn [| p1; p2 |] bb04 bb00 "Inst02" b) end; @@ -869,7 +878,7 @@ let test_builder () = group "unwind"; begin (* RUN: grep {unwind} < %t.ll *) - let bb05 = append_block "Bb05" fn in + let bb05 = append_block context "Bb05" fn in let b = builder_at_end context bb05 in ignore (build_unwind b) end; @@ -877,13 +886,13 @@ let test_builder () = group "unreachable"; begin (* RUN: grep {unreachable} < %t.ll *) - let bb06 = append_block "Bb06" fn in + let bb06 = append_block context "Bb06" fn in let b = builder_at_end context bb06 in ignore (build_unreachable b) end; group "arithmetic"; begin - let bb07 = append_block "Bb07" fn in + let bb07 = append_block context "Bb07" fn in let b = builder_at_end context bb07 in (* RUN: grep {Inst03.*add.*P1.*P2} < %t.ll @@ -925,7 +934,7 @@ let test_builder () = end; group "memory"; begin - let bb08 = append_block "Bb08" fn in + let bb08 = append_block context "Bb08" fn in let b = builder_at_end context bb08 in (* RUN: grep {Inst20.*malloc.*i8 } < %t.ll @@ -1034,10 +1043,10 @@ let test_builder () = group "phi"; begin (* RUN: grep {PhiNode.*P1.*PhiBlock1.*P2.*PhiBlock2} < %t.ll *) - let b1 = append_block "PhiBlock1" fn in - let b2 = append_block "PhiBlock2" fn in + let b1 = append_block context "PhiBlock1" fn in + let b2 = append_block context "PhiBlock2" fn in - let jb = append_block "PhiJoinBlock" fn in + let jb = append_block context "PhiJoinBlock" fn in ignore (build_br jb (builder_at_end context b1)); ignore (build_br jb (builder_at_end context b2)); let at_jb = builder_at_end context jb in -- cgit v1.2.3