Update llvm to r84119.

1 files changed, 95 insertions, 73 deletions

diff --git a/test/Bindings/Ocaml/vmcore.ml b/test/Bindings/Ocaml/vmcore.ml
index 9016d39..9e976d3 100644
--- a/test/Bindings/Ocaml/vmcore.ml
+++ b/test/Bindings/Ocaml/vmcore.ml
@@ -1,9 +1,9 @@
-(* RUN: %ocamlc -warn-error A llvm.cma llvm_analysis.cma llvm_bitwriter.cma %s -o %t 2> /dev/null
+(* RUN: %ocamlopt -warn-error A llvm.cmxa llvm_analysis.cmxa llvm_bitwriter.cmxa %s -o %t
  * RUN: ./%t %t.bc
  * RUN: llvm-dis < %t.bc > %t.ll
  *)
 
-(* Note: It takes several seconds for ocamlc to link an executable with
+(* Note: It takes several seconds for ocamlopt to link an executable with
          libLLVMCore.a, so it's better to write a big test than a bunch of
          little ones. *)
 
@@ -17,6 +17,16 @@ let suite_name = ref ""
 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;
@@ -47,7 +57,7 @@ let suite name f =
 (*===-- Fixture -----------------------------------------------------------===*)
 
 let filename = Sys.argv.(1)
-let m = create_module filename
+let m = create_module context filename
 let mp = ModuleProvider.create m
 
 
@@ -93,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
@@ -164,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
@@ -212,22 +222,30 @@ let test_constants () =
   ignore (define_global "Const03" c m);
   insist (i64_type = type_of c);
 
+  (* RUN: grep {ConstIntString.*i32.*-1} < %t.ll
+   *)
+  group "int string";
+  let c = const_int_of_string i32_type "-1" 10 in
+  ignore (define_global "ConstIntString" c m);
+  insist (i32_type = type_of c);
+
   (* 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);
 
   (* RUN: grep {ConstSingle.*2.75} < %t.ll
    * RUN: grep {ConstDouble.*3.1459} < %t.ll
+   * RUN: grep {ConstDoubleString.*1.25} < %t.ll
    *)
   begin group "real";
     let cs = const_float float_type 2.75 in
@@ -236,6 +254,10 @@ let test_constants () =
     
     let cd = const_float double_type 3.1459 in
     ignore (define_global "ConstDouble" cd m);
+    insist (double_type = type_of cd);
+
+    let cd = const_float_of_string double_type "1.25" in
+    ignore (define_global "ConstDoubleString" cd m);
     insist (double_type = type_of cd)
   end;
   
@@ -258,20 +280,20 @@ let test_constants () =
                           one; two; one; two |] in
   ignore (define_global "Const08" c m);
   insist ((vector_type i16_type 8) = (type_of c));
-  
+
   (* RUN: grep {Const09.*.i16 1, i16 2, i32 3, i32 4} < %t.ll
    *)
   group "structure";
-  let c = const_struct [| one; two; three; four |] in
+  let c = const_struct context [| one; two; three; four |] in
   ignore (define_global "Const09" c m);
-  insist ((struct_type [| i16_type; i16_type; i32_type; i32_type |])
+  insist ((struct_type context [| i16_type; i16_type; i32_type; i32_type |])
         = (type_of c));
   
   (* RUN: grep {Const10.*zeroinit} < %t.ll
    *)
   group "null";
-  let c = const_null (packed_struct_type [| i1_type; i8_type;
-                                            i64_type; double_type |]) in
+  let c = const_null (packed_struct_type context [| i1_type; i8_type; i64_type;
+                                                    double_type |]) in
   ignore (define_global "Const10" c m);
   
   (* RUN: grep {Const11.*-1} < %t.ll
@@ -343,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);
@@ -484,7 +506,7 @@ let test_global_variables () =
   insist (is_global_constant g);
   
   begin group "iteration";
-    let m = create_module "temp" in
+    let m = create_module context "temp" in
     
     insist (At_end m = global_begin m);
     insist (At_start m = global_end m);
@@ -544,7 +566,7 @@ let test_functions () =
   let fn = define_function "Fn3" ty m in
   insist (not (is_declaration fn));
   insist (1 = Array.length (basic_blocks fn));
-  ignore (build_unreachable (builder_at_end (entry_block fn)));
+  ignore (build_unreachable (builder_at_end context (entry_block fn)));
   
   (* RUN: grep {define.*Fn4.*Param1.*Param2} < %t.ll
    *)
@@ -558,7 +580,7 @@ let test_functions () =
   insist (i64_type = type_of params.(1));
   set_value_name "Param1" params.(0);
   set_value_name "Param2" params.(1);
-  ignore (build_unreachable (builder_at_end (entry_block fn)));
+  ignore (build_unreachable (builder_at_end context (entry_block fn)));
   
   (* RUN: grep {fastcc.*Fn5} < %t.ll
    *)
@@ -567,7 +589,7 @@ let test_functions () =
   insist (CallConv.c = function_call_conv fn);
   set_function_call_conv CallConv.fast fn;
   insist (CallConv.fast = function_call_conv fn);
-  ignore (build_unreachable (builder_at_end (entry_block fn)));
+  ignore (build_unreachable (builder_at_end context (entry_block fn)));
   
   begin group "gc";
     (* RUN: grep {Fn6.*gc.*shadowstack} < %t.ll
@@ -579,11 +601,11 @@ let test_functions () =
     set_gc None fn;
     insist (None = gc fn);
     set_gc (Some "shadowstack") fn;
-    ignore (build_unreachable (builder_at_end (entry_block fn)));
+    ignore (build_unreachable (builder_at_end context (entry_block fn)));
   end;
   
   begin group "iteration";
-    let m = create_module "temp" in
+    let m = create_module context "temp" in
     
     insist (At_end m = function_begin m);
     insist (At_start m = function_end m);
@@ -613,7 +635,7 @@ let test_functions () =
 
 let test_params () =
   begin group "iteration";
-    let m = create_module "temp" in
+    let m = create_module context "temp" in
     
     let vf = define_function "void" (function_type void_type [| |]) m in
     
@@ -660,31 +682,31 @@ 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 bb));
+  ignore (build_unreachable (builder_at_end context bb));
   
   (* RUN: grep -v Bb2 < %t.ll
    *)
   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 bba));
-  ignore (build_unreachable (builder_at_end bbb));
+  ignore (build_unreachable (builder_at_end context bba));
+  ignore (build_unreachable (builder_at_end context 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));
+  ignore (build_unreachable (builder_at_end context bb));
   let bbv = value_of_block bb in
   set_value_name "Bb3" bbv;
   insist ("Bb3" = value_name bbv);
@@ -692,20 +714,20 @@ 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));
+  ignore (build_unreachable (builder_at_end context 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)));
   
   begin group "iteration";
-    let m = create_module "temp" in
+    let m = create_module context "temp" in
     let f = declare_function "Temp" (function_type i32_type [| |]) m in
     
     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);
@@ -729,11 +751,11 @@ let test_basic_blocks () =
 
 let test_instructions () =
   begin group "iteration";
-    let m = create_module "temp" in
+    let m = create_module context "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
+    let b = builder_at context (At_end bb) in
     
     insist (At_end bb = instr_begin bb);
     insist (At_start bb = instr_end bb);
@@ -766,7 +788,7 @@ let test_builder () =
   
   begin group "parent";
     insist (try
-              ignore (insertion_block (builder ()));
+              ignore (insertion_block (builder context));
               false
             with Not_found ->
               true);
@@ -774,7 +796,7 @@ let test_builder () =
     let fty = function_type void_type [| i32_type |] in
     let fn = define_function "BuilderParent" fty m in
     let bb = entry_block fn in
-    let b = builder_at_end bb in
+    let b = builder_at_end context bb in
     let p = param fn 0 in
     let sum = build_add p p "sum" b in
     ignore (build_ret_void b);
@@ -791,21 +813,21 @@ let test_builder () =
      *)
     let fty = function_type void_type [| |] in
     let fn = declare_function "X6" fty m in
-    let b = builder_at_end (append_block "Bb01" fn) in
+    let b = builder_at_end context (append_block context "Bb01" fn) in
     ignore (build_ret_void b)
   end;
   
   (* The rest of the tests will use one big function. *)
   let fty = function_type i32_type [| i32_type; i32_type |] in
   let fn = define_function "X7" fty m in
-  let atentry = builder_at_end (entry_block fn) in
+  let atentry = builder_at_end context (entry_block fn) in
   let p1 = param fn 0 ++ set_value_name "P1" in
   let p2 = param fn 1 ++ set_value_name "P2" in
   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
-  ignore (build_unreachable (builder_at_end bb00));
+  let bb00 = append_block context "Bb00" fn in
+  ignore (build_unreachable (builder_at_end context bb00));
   
   group "ret"; begin
     (* RUN: grep {ret.*P1} < %t.ll
@@ -817,16 +839,16 @@ let test_builder () =
   group "br"; begin
     (* RUN: grep {br.*Bb02} < %t.ll
      *)
-    let bb02 = append_block "Bb02" fn in
-    let b = builder_at_end bb02 in
+    let bb02 = append_block context "Bb02" fn in
+    let b = builder_at_end context bb02 in
     ignore (build_br bb02 b)
   end;
   
   group "cond_br"; begin
     (* RUN: grep {br.*Inst01.*Bb03.*Bb00} < %t.ll
      *)
-    let bb03 = append_block "Bb03" fn in
-    let b = builder_at_end bb03 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)
   end;
@@ -835,12 +857,12 @@ 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
-    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
+    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 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)
   end;
   
@@ -848,30 +870,30 @@ 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 b = builder_at_end bb04 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;
   
   group "unwind"; begin
     (* RUN: grep {unwind} < %t.ll
      *)
-    let bb05 = append_block "Bb05" fn in
-    let b = builder_at_end bb05 in
+    let bb05 = append_block context "Bb05" fn in
+    let b = builder_at_end context bb05 in
     ignore (build_unwind b)
   end;
   
   group "unreachable"; begin
     (* RUN: grep {unreachable} < %t.ll
      *)
-    let bb06 = append_block "Bb06" fn in
-    let b = builder_at_end bb06 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 b = builder_at_end bb07 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
      * RUN: grep {Inst04.*sub.*P1.*Inst03} < %t.ll
@@ -912,12 +934,12 @@ let test_builder () =
   end;
   
   group "memory"; begin
-    let bb08 = append_block "Bb08" fn in
-    let b = builder_at_end bb08 in
+    let bb08 = append_block context "Bb08" fn in
+    let b = builder_at_end context bb08 in
     
-    (* RUN: grep {Inst20.*malloc.*i8	} < %t.ll
+    (* RUN: grep {Inst20.*malloc.*i8 } < %t.ll
      * RUN: grep {Inst21.*malloc.*i8.*P1} < %t.ll
-     * RUN: grep {Inst22.*alloca.*i32	} < %t.ll
+     * RUN: grep {Inst22.*alloca.*i32 } < %t.ll
      * RUN: grep {Inst23.*alloca.*i32.*P2} < %t.ll
      * RUN: grep {free.*Inst20} < %t.ll
      * RUN: grep {Inst25.*load.*Inst21} < %t.ll
@@ -1021,13 +1043,13 @@ 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
-    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 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
     
     let phi = build_phi [(p1, b1)] "PhiNode" at_jb in
     insist ([(p1, b1)] = incoming phi);
@@ -1042,7 +1064,7 @@ let test_builder () =
 (*===-- Module Provider ---------------------------------------------------===*)
 
 let test_module_provider () =
-  let m = create_module "test" in
+  let m = create_module context "test" in
   let mp = ModuleProvider.create m in
   ModuleProvider.dispose mp
 
@@ -1061,7 +1083,7 @@ let test_pass_manager () =
   begin group "function pass manager";
     let fty = function_type void_type [| |] in
     let fn = define_function "FunctionPassManager" fty m in
-    ignore (build_ret_void (builder_at_end (entry_block fn)));
+    ignore (build_ret_void (builder_at_end context (entry_block fn)));
     
     ignore (PassManager.create_function mp
              ++ PassManager.initialize