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 3ff8cb9faafb6526ef8fde92cfc725647c4add2b..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;
   
@@ -705,6 +719,40 @@ let test_basic_blocks () =
   end
 
 
+(*===-- Instructions ------------------------------------------------------===*)
+
+let test_instructions () =
+  begin group "iteration";
+    let m = create_module "temp" in
+    let fty = function_type void_type [| i32_type; i32_type |] in
+    let f = define_function "f" fty m in
+    let bb = entry_block f in
+    let b = builder_at (At_end bb) in
+    
+    insist (At_end bb = instr_begin bb);
+    insist (At_start bb = instr_end bb);
+    
+    let i1 = build_add (param f 0) (param f 1) "One" b in
+    let i2 = build_sub (param f 0) (param f 1) "Two" b in
+    
+    insist (Before i1 = instr_begin bb);
+    insist (Before i2 = instr_succ i1);
+    insist (At_end bb = instr_succ i2);
+    
+    insist (After i2 = instr_end bb);
+    insist (After i1 = instr_pred i2);
+    insist (At_start bb = instr_pred i1);
+    
+    let lf s x = s ^ "->" ^ value_name x in
+    insist ("->One->Two" = fold_left_instrs lf "" bb);
+    
+    let rf x s = value_name x ^ "<-" ^ s in
+    insist ("One<-Two<-" = fold_right_instrs rf bb "");
+    
+    dispose_module m
+  end
+
+
 (*===-- Builder -----------------------------------------------------------===*)
 
 let test_builder () =
@@ -777,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
@@ -920,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);
@@ -1024,6 +1087,7 @@ let _ =
   suite "functions"        test_functions;
   suite "params"           test_params;
   suite "basic blocks"     test_basic_blocks;
+  suite "instructions"     test_instructions;
   suite "builder"          test_builder;
   suite "module provider"  test_module_provider;
   suite "pass manager"     test_pass_manager;