let test name body =
test_cases := (name >:: body)::!test_cases;;
-let ok =
- OUnit.assert_equal
+let ok x y =
+ OUnit.assert_equal ~printer:Std.dump x y
(* test util*)
let empty_method =
}
let insts insts =
- {empty_method with instructions=insts}
+ {empty_method with instructions=insts}
module Inst = struct
type s =
[ `OpOnly1 | `OpOnly2
| `OpOnly3 | `OpOnly4
- | `WithArgs | `WithPrefix
| `String | `Int
| `StackAdd | `StackDel
| `ScopeAdd | `ScopeDel
| `Meth
- | `Class ]
+ | `Class
+ | `Script of s method_ ]
type t = int
let class_ =
`Meth ->
Some {(insts [`OpOnly1]) with
method_name = `QName (`Namespace "","f")}
-
+ | `Script m ->
+ Some m
| _ ->
None
| _ ->
[]
- let inst =
+ let inst _ =
function
`OpOnly1 ->
101
0
end
-let insts _ =
- undefined
-
module C = Compile.Make(Inst)
-let _ = test "Instruction" begin
- fun () ->
- let {method_info=mi;
- method_body=mb} =
- C.to_abc @@ insts [`OpOnly1; `OpOnly2] in
- ok 1 @@ List.length mi;
- ok 1 @@ List.length mb;
- ok 0 @@ (List.hd mb).method_sig;
- ok [u8 101; u8 102] @@ (List.hd mb).code
-end
+let to_abc xs =
+ C.to_abc @@ `Script (insts xs)
-let _ = test "args/prefix" begin
+
+
+let _ = test "Instruction" begin
fun () ->
let {method_info=mi;
method_body=mb} =
- C.to_abc @@ insts [`WithArgs; `WithPrefix] in
+ to_abc [`OpOnly1; `OpOnly2] in
ok 1 @@ List.length mi;
ok 1 @@ List.length mb;
ok 0 @@ (List.hd mb).method_sig;
- ok [u8 0; u8 1;
- u8 2; u8 0] @@ (List.hd mb).code
+ ok [101; 102] @@ (List.hd mb).code
end
let _ = test "constant" begin
fun () ->
let {cpool=cpool} =
- C.to_abc @@ insts [`String; `Int; `Meth] in
+ to_abc [`String; `Int; `Meth] in
let cpool' =
List.fold_left (flip Cpool.add) Cpool.empty [
`String "foo";
fun () ->
let {method_info=mi;
method_body=mb} =
- C.to_abc @@ insts [`StackAdd; `StackAdd; `StackDel] in
+ to_abc [`StackAdd; `StackAdd; `StackDel] in
ok 1 @@ List.length mi;
ok 1 @@ List.length mb;
ok 2 @@ (List.hd mb).max_stack;
fun () ->
let {method_info=mi;
method_body=mb} =
- C.to_abc @@ insts [`ScopeAdd; `ScopeAdd; `ScopeDel] in
+ to_abc [`ScopeAdd; `ScopeAdd; `ScopeDel] in
ok 1 @@ List.length mi;
ok 1 @@ List.length mb;
ok 2 @@ (List.hd mb).max_scope_depth;
fun () ->
let {method_info=mi;
method_body=mb} =
- C.to_abc @@ insts [`Meth] in
+ to_abc [`Meth] in
ok 2 @@ List.length mi;
ok 2 @@ List.length mb;
ok 0 @@ (List.nth mb 0).method_sig;
ok 1 @@ (List.nth mb 1).method_sig;
- ok [u8 101] @@ (List.nth mb 0).code;
- ok [u8 0] @@ (List.nth mb 1).code;
+ ok [101] @@ (List.nth mb 0).code;
+ ok [0] @@ (List.nth mb 1).code;
end
let _ = test "method dup" begin
fun () ->
let {method_info=mi;
method_body=mb} =
- C.to_abc @@ insts [`Meth; `Meth] in
+ to_abc [`Meth; `Meth] in
ok 3 @@ List.length mi;
ok 3 @@ List.length mb
end
instance_info = ii;
class_info = ci;
cpool = cp } =
- C.to_abc @@ insts [`Class] in
+ to_abc [`Class] in
let nth_method i =
(List.nth mb i).code in
ok 1 @@ List.length ci;
let i =
List.hd ii in
(* class info *)
- ok [u8 101] @@ nth_method c.AbcType.cinit;
+ ok [101] @@ nth_method c.AbcType.cinit;
begin match c.class_traits with
[t] ->
let (name,method_i) =
method_trait t in
- ok [u8 104] @@ nth_method method_i;
+ ok [104] @@ nth_method method_i;
assert_cpool (`QName (`Namespace "","")) @@ name
| _::_ | [] ->
assert_failure "must not happen" end;
assert_cpool (`QName (`Namespace "","Foo")) @@ i.instance_name;
assert_cpool (`QName (`Namespace "","Object")) @@ i.super_name;
ok [Sealed] @@ i.instance_flags;
- ok [u8 102] @@ (List.nth mb i.AbcType.iinit).AbcType.code;
+ ok [102] @@ (List.nth mb i.AbcType.iinit).AbcType.code;
begin match i.instance_traits with
[t] ->
let (name,method_i) =
method_trait t in
- ok [u8 103] @@ nth_method method_i;
+ ok [103] @@ nth_method method_i;
assert_cpool (`QName (`Namespace "","")) @@ name
| _::_ | [] ->
assert_failure "must not happen" end;