swflib/abcInTest.ml

   1 open Base
   2 open OUnit
   3 open BytesOut
   4 open AbcType
   5
   6 let ok ?msg x y =
   7   OUnit.assert_equal ?msg ~printer:Std.dump x y
   8
   9 module A = AbcIn.Make(struct
  10                          type t = int
  11                          let of_bytes _ =
  12                            raise Stream.Failure
  13                        end)
  14
  15 let example name =
  16   let ch =
  17     open_in_bin @@ Printf.sprintf "%s.abc" name in
  18     A.of_bytes @@ BytesIn.of_channel ch
  19
  20 let bytes xs =
  21   Stream.of_list @@ BytesOut.to_int_list xs
  22
  23 let abc =
  24   example "hello"
  25
  26 let cpool =
  27   abc.cpool
  28
  29 let _ =
  30   ("abcIn.ml" >::: [
  31      "cpool" >:: begin fun () ->
  32        let char c =
  33          u8 @@ Char.code c in
  34        let cpool =
  35          A.to_cpool @@ bytes [
  36            (* int *)
  37            u30 3; s32 1;s32 2;
  38            (* uint *)
  39            u30 2; u32 3;
  40            (* double *)
  41            u30 2; d64 4.2;
  42            (* str *)
  43            u30 2; u30 2; char 'h'; char 'i';
  44            (* ns *)
  45            u30 3; u8 0x08; u30 1; u8 0x05; u30 1;
  46            (* ns_set *)
  47            u30 2; u30 1; u30 1;
  48            (* mn *)
  49            u30 2; u8 0x07; u30 1; u30 1
  50          ] in
  51          ok ~msg:"int"    [1;2] cpool.int;
  52          ok ~msg:"uint"   [3] cpool.uint;
  53          ok ~msg:"double" [4.2] cpool.double;
  54          ok ~msg:"str"    ["hi"] cpool.string;
  55          ok ~msg:"ns"     [Namespace 1; PrivateNamespace 1] cpool.namespace;
  56          ok ~msg:"ns_set" [[1]] cpool.namespace_set;
  57          ok ~msg:"mn"     [QName(1,1)] cpool.multiname;
  58      end;
  59      "method signature" >::  begin fun () ->
  60        let m =
  61          A.to_method_info @@ bytes [
  62            (* param count *) u30 3;
  63            (* return_type *) u30 1;
  64            (* param types *) u30 1; u30 2; u30 3;
  65            (* name *) u30 4;
  66            (* flags *) u8 0x03;
  67          ] in
  68          ok ~msg:"param" [1;2;3] m.params;
  69          ok ~msg:"return" 1 m.return;
  70          ok ~msg:"name"   4 m.method_name;
  71          ok ~msg:"flags"  [NeedArguments; NeedActivation] m.method_flags;
  72      end;
  73    "metadata test" >:: begin fun () ->
  74      let metadata =
  75        A.to_metadata @@ bytes [
  76          (* name *) u30 0;
  77          (* item_count *) u30 2;
  78          (* items *) u30 1; u30 2; u30 3; u30 4
  79        ] in
  80        ok ~msg:"name" 0 metadata.metadata_name;
  81        ok ~msg:"items" [(1,2);(3,4)] metadata.items
  82    end;
  83    "trait" >:: begin fun ()  ->
  84      let trait =
  85        A.to_trait @@ bytes [
  86          (* name *) u30 1;
  87          (* kind *) u30 0;
  88          (* slot_id *) u30 1; (* type_name *) u30 2; (* vindex *) u30 0;
  89        ] in
  90        ok ~msg:"name" 1 trait.trait_name;
  91        ok ~msg:"data" (SlotTrait (1,2,0,0)) trait.data;
  92        ok ~msg:"metadata" [] trait.trait_metadata
  93    end;
  94    "instance" >:: begin fun () ->
  95      let instance =
  96        A.to_instance @@ bytes [
  97          (* name *) u30 1;
  98          (* super *) u30 2;
  99          (* flags *) u8 0x01;
 100          (* count *) u30 1;
 101          (* interface *) u30 1;
 102          (* iinit *) u30 3;
 103          (* trait_count *) u30 0;
 104        ] in
 105        ok 1 @@ instance.instance_name;
 106        ok 2 @@ instance.super_name;
 107        ok [Sealed] @@ instance.instance_flags;
 108        ok [1] @@ instance.interfaces;
 109        ok 3 @@ instance.iinit;
 110        ok [] @@ instance.instance_traits
 111    end;
 112    "class" >:: begin fun () ->
 113      let c =
 114        A.to_class @@ bytes [
 115          (* cinit *) u30 1;
 116          (* trait_count *) u30 0;
 117        ] in
 118        ok 1 c.cinit;
 119        ok [] c.class_traits
 120    end;
 121    "script" >:: begin fun () ->
 122      let s =
 123        A.to_script @@ bytes [
 124          u30 1;
 125          u30 0;
 126        ] in
 127        ok 1 s.init;
 128        ok [] s.script_traits
 129    end;
 130    "exception" >:: begin fun()->
 131      let e =
 132        A.to_exception @@ bytes [
 133          u30 1;
 134          u30 2;
 135          u30 3;
 136          u30 4;
 137          u30 5;
 138        ] in
 139        ok ~msg:"from"   1 e.from_pos;
 140        ok ~msg:"to"     2 e.to_pos;
 141        ok ~msg:"target" 3 e.target;
 142        ok ~msg:"type"   4 e.exception_type;
 143        ok ~msg:"var"    5 e.var_name
 144    end;
 145    "method body" >:: begin fun () ->
 146      let m  =
 147        A.to_method_body @@ bytes [
 148          (* methodi *) u30 0;
 149          (* max_stack *) u30 2;
 150          (* local count *) u30 1;
 151          (* init scope depth *) u30 0;
 152          (* max scope depth *) u30 1;
 153          (* code *) u30 0;
 154          (* exception *) u30 0;
 155          (* tairt count *) u30 0
 156        ] in
 157        ok 0 m.method_sig;
 158        ok [] m.exceptions;
 159        ok 1 m.local_count;
 160        ok 0 m.init_scope_depth;
 161        ok 1 m.max_scope_depth;
 162        ok 2 m.max_stack;
 163        ok [] m.method_traits;
 164        flip ok m.code []
 165    end;
 166    ]) +> run_test_tt_main