X-Git-Url: http://plrg.eecs.uci.edu/git/?p=oota-llvm.git;a=blobdiff_plain;f=test%2FBindings%2FOcaml%2Fvmcore.ml;h=04b80868c4d0ac247863da8b6eb38c7982669c37;hp=4280b1c9f3703940ac75be865b108a3fbe80eb27;hb=da1435f86ebc9886dd7704294e01d192d79e069c;hpb=6d6203dff3560a2cc3ac8ec620ac3b105b0c7cc7 diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml index 4280b1c9f37..04b80868c4d 100644 --- a/test/Bindings/Ocaml/vmcore.ml +++ b/test/Bindings/Ocaml/vmcore.ml @@ -1,4 +1,4 @@ -(* RUN: %ocamlc llvm.cma llvm_bitwriter.cma %s -o %t +(* RUN: %ocamlc llvm.cma llvm_analysis.cma llvm_bitwriter.cma %s -o %t * RUN: ./%t %t.bc * RUN: llvm-dis < %t.bc > %t.ll *) @@ -25,7 +25,8 @@ let insist cond = exit_status := 10; " FAIL " end in - prerr_endline (msg ^ (string_of_int !case_num)) + prerr_endline (" " ^ (string_of_int !case_num) ^ if cond then "" + else " FAIL") let suite name f = prerr_endline (name ^ ":"); @@ -102,13 +103,24 @@ let test_types () = insist (i8_type == element_type ty); insist (Array_type == classify_type ty); - (* RUN: grep {Ty10.*float\*} < %t.ll - *) - group "pointer"; - let ty = pointer_type float_type in - insist (define_type_name "Ty10" ty m); - insist (float_type == element_type ty); - insist (Pointer_type == classify_type ty); + begin group "pointer"; + (* RUN: grep {UnqualPtrTy.*float\*} < %t.ll + *) + let ty = pointer_type float_type in + insist (define_type_name "UnqualPtrTy" ty m); + insist (float_type == element_type ty); + insist (0 == address_space ty); + insist (Pointer_type == classify_type ty) + end; + + begin group "qualified_pointer"; + (* RUN: grep {QualPtrTy.*i8.*3.*\*} < %t.ll + *) + let ty = qualified_pointer_type i8_type 3 in + insist (define_type_name "QualPtrTy" ty m); + insist (i8_type == element_type ty); + insist (3 == address_space ty) + end; (* RUN: grep {Ty11.*\<4 x i16\>} < %t.ll *) @@ -467,7 +479,7 @@ let test_functions () = let fn = define_function "Fn3" ty m in insist (not (is_declaration fn)); insist (1 = Array.length (basic_blocks fn)); - (* this function is not valid because init bb lacks a terminator *) + ignore (build_unreachable (builder_at_end (entry_block fn))); (* RUN: grep {define.*Fn4.*Param1.*Param2} < %t.ll *) @@ -481,7 +493,7 @@ let test_functions () = insist (i64_type = type_of params.(1)); set_value_name "Param1" params.(0); set_value_name "Param2" params.(1); - (* this function is not valid because init bb lacks a terminator *) + ignore (build_unreachable (builder_at_end (entry_block fn))); (* RUN: grep {fastcc.*Fn5} < %t.ll *) @@ -489,7 +501,21 @@ let test_functions () = let fn = define_function "Fn5" ty m in insist (ccc = function_call_conv fn); set_function_call_conv fastcc fn; - insist (fastcc = function_call_conv fn) + insist (fastcc = function_call_conv fn); + ignore (build_unreachable (builder_at_end (entry_block fn))); + + begin group "collector"; + (* RUN: grep {Fn6.*gc.*shadowstack} < %t.ll + *) + let fn = define_function "Fn6" ty m in + insist (None = collector fn); + set_collector (Some "ocaml") fn; + insist (Some "ocaml" = collector fn); + set_collector None fn; + insist (None = collector fn); + set_collector (Some "shadowstack") fn; + ignore (build_unreachable (builder_at_end (entry_block fn))); + end (*===-- Basic Blocks ------------------------------------------------------===*) @@ -503,6 +529,7 @@ let test_basic_blocks () = let fn = declare_function "X" ty m in let bb = append_block "Bb1" fn in insist (bb = entry_block fn); + ignore (build_unreachable (builder_at_end bb)); (* RUN: grep -v Bb2 < %t.ll *) @@ -513,15 +540,18 @@ let test_basic_blocks () = group "insert"; let fn = declare_function "X3" ty m in - let bbb = append_block "" fn in - let bba = insert_block "" bbb in + let bbb = append_block "b" fn in + let bba = insert_block "a" bbb in insist ([| bba; bbb |] = basic_blocks fn); + ignore (build_unreachable (builder_at_end bba)); + ignore (build_unreachable (builder_at_end bbb)); (* RUN: grep Bb3 < %t.ll *) group "name/value"; let fn = define_function "X4" ty m in let bb = entry_block fn in + ignore (build_unreachable (builder_at_end bb)); let bbv = value_of_block bb in set_value_name "Bb3" bbv; insist ("Bb3" = value_name bbv); @@ -529,6 +559,7 @@ let test_basic_blocks () = group "casts"; let fn = define_function "X5" ty m in let bb = entry_block fn in + ignore (build_unreachable (builder_at_end bb)); insist (bb = block_of_value (value_of_block bb)); insist (value_is_block (value_of_block bb)); insist (not (value_is_block (const_null i32_type))) @@ -650,7 +681,8 @@ let test_builder () = let inst16 = build_or p1 inst15 "Inst16" b in let inst17 = build_xor p1 inst16 "Inst17" b in let inst18 = build_neg inst17 "Inst18" b in - ignore (build_not inst18 "Inst19" b) + ignore (build_not inst18 "Inst19" b); + ignore (build_unreachable b) end; group "memory"; begin @@ -673,7 +705,8 @@ let test_builder () = ignore(build_free inst20 b); ignore(build_load inst21 "Inst25" b); ignore(build_store p2 inst22 b); - ignore(build_gep inst23 [| p2 |] "Inst27" b) + ignore(build_gep inst23 [| p2 |] "Inst27" b); + ignore(build_unreachable b) end; group "casts"; begin @@ -724,11 +757,8 @@ let test_builder () = * RUN: grep {Inst48.*va_arg.*null.*i32} < %t.ll * RUN: grep {Inst49.*extractelement.*Vec1.*P2} < %t.ll * RUN: grep {Inst50.*insertelement.*Vec1.*P1.*P2} < %t.ll - * RUN: grep {Inst51.*shufflevector.*Vec1.*Vec2.*Vec3} < %t.ll + * RUN: grep {Inst51.*shufflevector.*Vec1.*Vec2.*1.*1.*0.*0} < %t.ll *) - - (* TODO: %Inst44 = Phi *) - ignore (build_call fn [| p2; p1 |] "Inst45" atentry); let inst46 = build_icmp Icmp_eq p1 p2 "Inst46" atentry in ignore (build_select inst46 p1 p2 "Inst47" atentry); @@ -737,24 +767,56 @@ let test_builder () = i32_type "Inst48" atentry); (* Set up some vector vregs. *) - let one = const_int i32_type (-1) in - let zero = const_int i32_type 1 in + let one = const_int i32_type 1 in + let zero = const_int i32_type 0 in let t1 = const_vector [| one; zero; one; zero |] in let t2 = const_vector [| zero; one; zero; one |] in let t3 = const_vector [| one; one; zero; zero |] in let vec1 = build_insertelement t1 p1 p2 "Vec1" atentry in let vec2 = build_insertelement t2 p1 p2 "Vec2" atentry in - let vec3 = build_insertelement t3 p1 p2 "Vec3" atentry in ignore (build_extractelement vec1 p2 "Inst49" atentry); ignore (build_insertelement vec1 p1 p2 "Inst50" atentry); - ignore (build_shufflevector vec1 vec2 vec3 "Inst51" atentry); + ignore (build_shufflevector vec1 vec2 t3 "Inst51" atentry); + end; + + 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 jb = append_block "PhiJoinBlock" fn in + ignore (build_br jb (builder_at_end b1)); + ignore (build_br jb (builder_at_end b2)); + let at_jb = builder_at_end jb in + + let phi = build_phi [(p1, b1)] "PhiNode" at_jb in + insist ([(p1, b1)] = incoming phi); + + add_incoming (p2, b2) phi; + insist ([(p1, b1); (p2, b2)] = incoming phi); + + ignore (build_unreachable at_jb); end +(*===-- Module Provider ---------------------------------------------------===*) + +let test_module_provider () = + let m = create_module "test" in + let mp = ModuleProvider.create m in + ModuleProvider.dispose mp + + (*===-- Writer ------------------------------------------------------------===*) let test_writer () = + group "valid"; + insist (match Llvm_analysis.verify_module m with + | None -> true + | Some msg -> prerr_string msg; false); + group "writer"; insist (write_bitcode_file m filename); @@ -771,5 +833,6 @@ let _ = suite "functions" test_functions; suite "basic blocks" test_basic_blocks; suite "builder" test_builder; + suite "module provider" test_module_provider; suite "writer" test_writer; exit !exit_status