PR2731: C and Ocaml bindings for setTailCall and isTailCall.

[oota-llvm.git] / test / Bindings / Ocaml / vmcore.ml

diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml
index 637ef3532c54323779ceaa08f82b66f6ecee14aa..694590885de29699e5e56672be44dc7750f27855 100644 (file)
--- a/test/Bindings/Ocaml/vmcore.ml
+++ b/test/Bindings/Ocaml/vmcore.ml
@@ -13,20 +13,34 @@ 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
 
 let group name =
+  group_name := !suite_name ^ "/" ^ name;
   case_num := 0;
-  prerr_endline ("  " ^ name ^ "...")
+  if print_checkpoints then
+    prerr_endline ("  " ^ name ^ "...")
 
 let insist cond =
   incr case_num;
-  if not cond then exit_status := 10;
-  prerr_endline ("    " ^ (string_of_int !case_num) ^ if cond then ""
-                                                              else " FAIL")
+  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 =
-  prerr_endline (name ^ ":");
+  suite_name := name;
+  if print_checkpoints then
+    prerr_endline (name ^ ":");
   f ()
 
 
@@ -245,7 +259,7 @@ let test_constants () =
   ignore (define_global "Const08" c m);
   insist ((vector_type i16_type 8) = (type_of c));
   
-  (* RUN: grep {Const09.*\{ i16, i16, i32, i32 \} \{} < %t.ll
+  (* RUN: grep {Const09.*. i16, i16, i32, i32 . .} < %t.ll
    *)
   group "structure";
   let c = const_struct [| one; two; three; four |] in
@@ -555,16 +569,16 @@ let test_functions () =
   insist (CallConv.fast = function_call_conv fn);
   ignore (build_unreachable (builder_at_end (entry_block fn)));
   
-  begin group "collector";
+  begin group "gc";
     (* 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;
+    insist (None = gc fn);
+    set_gc (Some "ocaml") fn;
+    insist (Some "ocaml" = gc fn);
+    set_gc None fn;
+    insist (None = gc fn);
+    set_gc (Some "shadowstack") fn;
     ignore (build_unreachable (builder_at_end (entry_block fn)));
   end;
   
@@ -811,7 +825,18 @@ let test_builder () =
     ignore (build_cond_br cond bb03 bb00 b)
   end;
   
-  (* TODO: Switch *)
+  group "switch"; begin
+    (* 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
+    ignore (build_unreachable (builder_at_end bb2));
+    let bb3 = append_block "SwiBlock3" fn in
+    ignore (build_unreachable (builder_at_end bb3));
+    let si = build_switch p1 bb3 1 (builder_at_end bb1) in
+    ignore (add_case si (const_int i32_type 2) bb2)
+  end;
   
   group "invoke"; begin
     (* RUN: grep {Inst02.*invoke.*P1.*P2} < %t.ll
@@ -954,11 +979,15 @@ let test_builder () =
      * RUN: grep {Inst49.*extractelement.*Vec1.*P2} < %t.ll
      * RUN: grep {Inst50.*insertelement.*Vec1.*P1.*P2} < %t.ll
      * RUN: grep {Inst51.*shufflevector.*Vec1.*Vec2.*1.*1.*0.*0} < %t.ll
+     * RUN: grep {CallInst.*tail call} < %t.ll
      *)
     let ci = build_call fn [| p2; p1 |] "CallInst" atentry in
     insist (CallConv.c = instruction_call_conv ci);
     set_instruction_call_conv 63 ci;
     insist (63 = instruction_call_conv ci);
+    insist (not (is_tail_call ci));
+    set_tail_call true ci;
+    insist (is_tail_call ci);
     
     let inst46 = build_icmp Icmp.Eq p1 p2 "Inst46" atentry in
          ignore (build_select inst46 p1 p2 "Inst47" atentry);