diff options
Diffstat (limited to 'test/Bindings/Ocaml/vmcore.ml')
| -rw-r--r-- | test/Bindings/Ocaml/vmcore.ml | 67 |
1 files changed, 38 insertions, 29 deletions
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 |