]>
Commit | Line | Data |
---|---|---|
1a4d82fc JJ |
1 | (* RUN: rm -rf %t.builddir |
2 | * RUN: mkdir -p %t.builddir | |
3 | * RUN: cp %s %t.builddir | |
4 | * RUN: %ocamlopt -warn-error A llvm.cmxa llvm_target.cmxa llvm_executionengine.cmxa %t.builddir/executionengine.ml -o %t | |
223e47cc LB |
5 | * RUN: %t |
6 | * XFAIL: vg_leak | |
7 | *) | |
8 | ||
9 | open Llvm | |
10 | open Llvm_executionengine | |
11 | open Llvm_target | |
12 | ||
13 | (* Note that this takes a moment to link, so it's best to keep the number of | |
14 | individual tests low. *) | |
15 | ||
16 | let context = global_context () | |
17 | let i8_type = Llvm.i8_type context | |
18 | let i32_type = Llvm.i32_type context | |
19 | let i64_type = Llvm.i64_type context | |
20 | let double_type = Llvm.double_type context | |
21 | ||
22 | let bomb msg = | |
23 | prerr_endline msg; | |
24 | exit 2 | |
25 | ||
26 | let define_main_fn m retval = | |
27 | let fn = | |
28 | let str_arr_type = pointer_type (pointer_type i8_type) in | |
29 | define_function "main" (function_type i32_type [| i32_type; | |
30 | str_arr_type; | |
31 | str_arr_type |]) m in | |
32 | let b = builder_at_end (global_context ()) (entry_block fn) in | |
33 | ignore (build_ret (const_int i32_type retval) b); | |
34 | fn | |
35 | ||
36 | let define_plus m = | |
37 | let fn = define_function "plus" (function_type i32_type [| i32_type; | |
38 | i32_type |]) m in | |
39 | let b = builder_at_end (global_context ()) (entry_block fn) in | |
40 | let add = build_add (param fn 0) (param fn 1) "sum" b in | |
41 | ignore (build_ret add b) | |
42 | ||
43 | let test_genericvalue () = | |
44 | let tu = (1, 2) in | |
45 | let ptrgv = GenericValue.of_pointer tu in | |
46 | assert (tu = GenericValue.as_pointer ptrgv); | |
47 | ||
48 | let fpgv = GenericValue.of_float double_type 2. in | |
49 | assert (2. = GenericValue.as_float double_type fpgv); | |
50 | ||
51 | let intgv = GenericValue.of_int i32_type 3 in | |
52 | assert (3 = GenericValue.as_int intgv); | |
53 | ||
54 | let i32gv = GenericValue.of_int32 i32_type (Int32.of_int 4) in | |
55 | assert ((Int32.of_int 4) = GenericValue.as_int32 i32gv); | |
56 | ||
57 | let nigv = GenericValue.of_nativeint i32_type (Nativeint.of_int 5) in | |
58 | assert ((Nativeint.of_int 5) = GenericValue.as_nativeint nigv); | |
59 | ||
60 | let i64gv = GenericValue.of_int64 i64_type (Int64.of_int 6) in | |
61 | assert ((Int64.of_int 6) = GenericValue.as_int64 i64gv) | |
62 | ||
63 | let test_executionengine () = | |
64 | (* create *) | |
65 | let m = create_module (global_context ()) "test_module" in | |
66 | let main = define_main_fn m 42 in | |
67 | ||
68 | let m2 = create_module (global_context ()) "test_module2" in | |
69 | define_plus m2; | |
70 | ||
71 | let ee = ExecutionEngine.create m in | |
72 | ExecutionEngine.add_module m2 ee; | |
73 | ||
74 | (* run_static_ctors *) | |
75 | ExecutionEngine.run_static_ctors ee; | |
76 | ||
77 | (* run_function_as_main *) | |
78 | let res = ExecutionEngine.run_function_as_main main [|"test"|] [||] ee in | |
79 | if 42 != res then bomb "main did not return 42"; | |
80 | ||
81 | (* free_machine_code *) | |
82 | ExecutionEngine.free_machine_code main ee; | |
83 | ||
84 | (* find_function *) | |
85 | match ExecutionEngine.find_function "dne" ee with | |
86 | | Some _ -> raise (Failure "find_function 'dne' failed") | |
87 | | None -> | |
88 | ||
89 | match ExecutionEngine.find_function "plus" ee with | |
90 | | None -> raise (Failure "find_function 'plus' failed") | |
91 | | Some plus -> | |
92 | ||
93 | (* run_function *) | |
94 | let res = ExecutionEngine.run_function plus | |
95 | [| GenericValue.of_int i32_type 2; | |
96 | GenericValue.of_int i32_type 2 |] | |
97 | ee in | |
98 | if 4 != GenericValue.as_int res then bomb "plus did not work"; | |
99 | ||
100 | (* remove_module *) | |
101 | Llvm.dispose_module (ExecutionEngine.remove_module m2 ee); | |
102 | ||
103 | (* run_static_dtors *) | |
104 | ExecutionEngine.run_static_dtors ee; | |
105 | ||
1a4d82fc JJ |
106 | (* Show that the data layout binding links and runs.*) |
107 | let dl = ExecutionEngine.data_layout ee in | |
223e47cc LB |
108 | |
109 | (* Demonstrate that a garbage pointer wasn't returned. *) | |
1a4d82fc | 110 | let ty = DataLayout.intptr_type context dl in |
223e47cc LB |
111 | if ty != i32_type && ty != i64_type then bomb "target_data did not work"; |
112 | ||
113 | (* dispose *) | |
114 | ExecutionEngine.dispose ee | |
115 | ||
116 | let _ = | |
117 | test_genericvalue (); | |
118 | test_executionengine () |