Add support for inserting inline asm to ocaml.
[oota-llvm.git] / test / Bindings / Ocaml / vmcore.ml
index 48c1a9570a35387a11c3431b85cf5dc9d2715e32..40747f36111788d8b2d2287065fd2840c4bcc8f2 100644 (file)
@@ -185,6 +185,14 @@ let test_types () =
   let ty = opaque_type context in
   insist (define_type_name "delete_type" ty m);
   delete_type_name "delete_type" m;
+
+  (* RUN: grep {type_name.*opaque} < %t.ll
+   *)
+  group "type_name"; begin
+    let ty = opaque_type context in
+    insist (define_type_name "type_name" ty m);
+    insist ((type_by_name m "type_name") = Some ty)
+  end;
   
   (* RUN: grep -v {recursive_type.*recursive_type} < %t.ll
    *)
@@ -307,6 +315,13 @@ let test_constants () =
   group "all ones";
   let c = const_all_ones i64_type in
   ignore (define_global "const_all_ones" c m);
+
+  group "pointer null"; begin
+    (* RUN: grep {const_pointer_null = global i64\\* null} < %t.ll
+     *)
+    let c = const_pointer_null (pointer_type i64_type) in
+    ignore (define_global "const_pointer_null" c m);
+  end;
   
   (* RUN: grep {const_undef.*undef} < %t.ll
    *)
@@ -441,7 +456,17 @@ let test_constants () =
   ignore (define_global "const_shufflevector" (const_shufflevector
     (const_vector [| zero; one |])
     (const_vector [| one; zero |])
-    (const_bitcast foldbomb (vector_type i32_type 2))) m)
+    (const_bitcast foldbomb (vector_type i32_type 2))) m);
+
+  group "asm"; begin
+    let ft = function_type void_type [| i32_type; i32_type; i32_type |] in
+    ignore (const_inline_asm
+      ft
+      ""
+      "{cx},{ax},{di},~{dirflag},~{fpsr},~{flags},~{edi},~{ecx}"
+      true
+      false)
+  end
 
 
 (*===-- Global Values -----------------------------------------------------===*)
@@ -493,28 +518,46 @@ let test_global_variables () =
   let (++) x f = f x; x in
   let fourty_two32 = const_int i32_type 42 in
 
-  (* RUN: grep {GVar01.*external} < %t.ll
-   *)
-  group "declarations";
-  insist (None == lookup_global "GVar01" m);
-  let g = declare_global i32_type "GVar01" m in
-  insist (is_declaration g);
-  insist (pointer_type float_type ==
-            type_of (declare_global float_type "GVar01" m));
-  insist (g == declare_global i32_type "GVar01" m);
-  insist (match lookup_global "GVar01" m with Some x -> x = g
-                                            | None -> false);
+  group "declarations"; begin
+    (* RUN: grep {GVar01.*external} < %t.ll
+     *)
+    insist (None == lookup_global "GVar01" m);
+    let g = declare_global i32_type "GVar01" m in
+    insist (is_declaration g);
+    insist (pointer_type float_type ==
+              type_of (declare_global float_type "GVar01" m));
+    insist (g == declare_global i32_type "GVar01" m);
+    insist (match lookup_global "GVar01" m with Some x -> x = g
+                                              | None -> false);
+
+    insist (None == lookup_global "QGVar01" m);
+    let g = declare_qualified_global i32_type "QGVar01" 3 m in
+    insist (is_declaration g);
+    insist (qualified_pointer_type float_type 3 ==
+              type_of (declare_qualified_global float_type "QGVar01" 3 m));
+    insist (g == declare_qualified_global i32_type "QGVar01" 3 m);
+    insist (match lookup_global "QGVar01" m with Some x -> x = g
+                                              | None -> false);
+  end;
   
-  (* RUN: grep {GVar02.*42} < %t.ll
-   * RUN: grep {GVar03.*42} < %t.ll
-   *)
-  group "definitions";
-  let g = define_global "GVar02" fourty_two32 m in
-  let g2 = declare_global i32_type "GVar03" m ++
+  group "definitions"; begin
+    (* RUN: grep {GVar02.*42} < %t.ll
+     * RUN: grep {GVar03.*42} < %t.ll
+     *)
+    let g = define_global "GVar02" fourty_two32 m in
+    let g2 = declare_global i32_type "GVar03" m ++
            set_initializer fourty_two32 in
-  insist (not (is_declaration g));
-  insist (not (is_declaration g2));
-  insist ((global_initializer g) == (global_initializer g2));
+    insist (not (is_declaration g));
+    insist (not (is_declaration g2));
+    insist ((global_initializer g) == (global_initializer g2));
+
+    let g = define_qualified_global "QGVar02" fourty_two32 3 m in
+    let g2 = declare_qualified_global i32_type "QGVar03" 3 m ++
+           set_initializer fourty_two32 in
+    insist (not (is_declaration g));
+    insist (not (is_declaration g2));
+    insist ((global_initializer g) == (global_initializer g2));
+  end;
 
   (* RUN: grep {GVar04.*thread_local} < %t.ll
    *)
@@ -897,6 +940,23 @@ let test_builder () =
     let si = build_switch p1 bb3 1 (builder_at_end context bb1) in
     ignore (add_case si (const_int i32_type 2) bb2)
   end;
+
+  group "indirectbr"; begin
+    (* RUN: grep {indirectbr i8\\* blockaddress(@X7, %IBRBlock2), \\\[label %IBRBlock2, label %IBRBlock3\\\]} < %t.ll
+     *)
+    let bb1 = append_block context "IBRBlock1" fn in
+
+    let bb2 = append_block context "IBRBlock2" fn in
+    ignore (build_unreachable (builder_at_end context bb2));
+
+    let bb3 = append_block context "IBRBlock3" fn in
+    ignore (build_unreachable (builder_at_end context bb3));
+
+    let addr = block_address fn bb2 in
+    let ibr = build_indirect_br addr 2 (builder_at_end context bb1) in
+    ignore (add_destination ibr bb2);
+    ignore (add_destination ibr bb3)
+  end;
   
   group "invoke"; begin
     (* RUN: grep {build_invoke.*invoke.*P1.*P2} < %t.ll
@@ -1089,6 +1149,46 @@ let test_builder () =
     ignore (build_insertelement vec1 p1 p2 "build_insertelement" atentry);
     ignore (build_shufflevector vec1 vec2 t3 "build_shufflevector" atentry);
   end;
+
+  group "metadata"; begin
+    (* RUN: grep {%metadata = add i32 %P1, %P2, !test !0} < %t.ll
+     * RUN: grep {!0 = metadata !\{i32 1, metadata !"metadata test"\}} < %t.ll
+     *)
+    let i = build_add p1 p2 "metadata" atentry in
+    insist ((has_metadata i) = false);
+
+    let m1 = const_int i32_type 1 in
+    let m2 = mdstring context "metadata test" in
+    let md = mdnode context [| m1; m2 |] in
+
+    let kind = mdkind_id context "test" in
+    set_metadata i kind md;
+
+    insist ((has_metadata i) = true);
+    insist ((metadata i kind) = Some md);
+
+    clear_metadata i kind;
+
+    insist ((has_metadata i) = false);
+    insist ((metadata i kind) = None);
+
+    set_metadata i kind md
+  end;
+
+  group "dbg"; begin
+    (* RUN: grep {%dbg = add i32 %P1, %P2, !dbg !1} < %t.ll
+     * RUN: grep {!1 = metadata !\{i32 2, metadata !"dbg test"\}} < %t.ll
+     *)
+    let m1 = const_int i32_type 2 in
+    let m2 = mdstring context "dbg test" in
+    let md = mdnode context [| m1; m2 |] in
+    set_current_debug_location atentry md;
+
+    let i = build_add p1 p2 "dbg" atentry in
+    insist ((has_metadata i) = true);
+
+    clear_current_debug_location atentry
+  end;
   
   group "phi"; begin
     (* RUN: grep {PhiNode.*P1.*PhiBlock1.*P2.*PhiBlock2} < %t.ll