swflib/abcOutTest.ml

   1 open Base
   2 open AbcType
   3 open OUnit
   4 open BytesOut
   5
   6 module A = AbcOut.Make(struct
   7                          type t = int
   8                          let to_bytes _ = []
   9                        end)
  10 open A
  11
  12 let cpool =
  13   { empty_cpool with
  14       int = [~-1;42];
  15       uint = [42];
  16       string = ["abc"];
  17       namespace = [Namespace 1];
  18       namespace_set = [[1;2]];
  19       multiname=[QName (0,1);Multiname (2,3)] }
  20
  21 let info =
  22   { params=[]; return=1; method_name=2; method_flags=[ NeedArguments; NeedActivation] }
  23
  24 let body =
  25   { method_sig=1;
  26     max_stack=2;
  27     local_count=3;
  28     init_scope_depth=4;
  29     max_scope_depth=5;
  30     code=[];
  31     exceptions=[];
  32     method_traits=[] }
  33
  34 let script =
  35   {init=0x7F; script_traits=[]}
  36
  37 let ok x y =
  38   OUnit.assert_equal ~printer:(Std.dump)  (to_int_list x) (to_int_list y)
  39
  40 let _ =
  41   ("abcOut.ml" >:::
  42      ["of_script test" >::
  43         (fun () ->
  44            ok [u30 0x7F; u30 0] @@ of_script script);
  45       "of_trait test" >::
  46         (fun () ->
  47            ok [u30 1;u8 0; u30 1; u30 2; u30 3; u8 4; ] @@
  48              of_trait {trait_name=1; data=SlotTrait (1,2,3,4); trait_metadata=[]};
  49            ok [u30 1;u8 0; u30 1; u30 2; u30 0] @@
  50              of_trait {trait_name=1; data=SlotTrait (1,2,0,4); trait_metadata=[]};
  51            ok [u30 1;u8 1; u30 1; u30 2] @@
  52              of_trait {trait_name=1; data=MethodTrait (1,2,[]); trait_metadata=[]};
  53            ok [u30 1;u8 2; u30 1; u30 2] @@
  54              of_trait {trait_name=1; data=GetterTrait (1,2,[]); trait_metadata=[]};
  55            ok [u30 1;u8 3; u30 1; u30 2] @@
  56              of_trait {trait_name=1; data=SetterTrait (1,2,[]); trait_metadata=[]};
  57            ok [u30 1;u8 4; u30 1; u30 2] @@
  58              of_trait {trait_name=1; data=ClassTrait (1,2); trait_metadata=[]};
  59            ok [u30 1;u8 5; u30 1; u30 2] @@
  60              of_trait {trait_name=1; data=FunctionTrait (1,2); trait_metadata=[]};
  61            ok [u30 1;u8 6; u30 1; u30 2; u30 3; u8 4] @@
  62              of_trait {trait_name=1; data=ConstTrait (1,2,3,4); trait_metadata=[]};
  63            ok [u30 1;u8 6; u30 1; u30 2; u30 0] @@
  64              of_trait {trait_name=1; data=ConstTrait (1,2,0,4);  trait_metadata=[]};);
  65       "of_method_info test" >::
  66         (fun () ->
  67            ok [u30 0; (* param count *)
  68                u30 1; (* return *)
  69                u30 2; (* name *)
  70                u8 3;  (* flags *)] @@
  71              of_method_info info;
  72            ok [u30 0; u30 1; u30 2;
  73                u8 0x08; (* flags *)
  74                (* optional *)
  75                u30 2; (* count *)
  76                u30 1; u8 0x03; (* val=1; kind=int *)
  77                u30 0; u8 0x0c; (* val=0; kind=null*) ] @@
  78              of_method_info { info with
  79                                 method_flags=[ HasOptional [IntVal 1; NullVal] ] };
  80            ok [u30 3; u30 1;
  81                u30 2; u30 3; u30 4; (* params *)
  82                u30 2; u8 0x80;
  83                u30 1; u30 2; u30 3  (* param names *) ] @@
  84              of_method_info { info with
  85                                params = [2; 3 ;4];
  86                                method_flags=[ HasParamNames [1; 2; 3]] };
  87         );
  88       "of_method_body test" >::
  89         (fun () ->
  90            ok [u30 1;
  91                u30 2;
  92                u30 3;
  93                u30 4;
  94                u30 5;
  95                u30 0;
  96                u30 0;
  97                u30 0] @@
  98              of_method_body body);
  99       "of_cpool test" >::
 100         (fun () ->
 101            ok [u30 1;(* int    *)
 102                u30 1;(* uint   *)
 103                u30 1;(* double *)
 104                u30 1;(* string *)
 105                u30 1;(* ns     *)
 106                u30 1;(* ns_set *)
 107                u30 1 (* mname  *)] @@
 108              of_cpool empty_cpool;
 109            ok [u30 3; s32 ~-1; s32 42;                  (* int    *)
 110                u30 2; u32 42;                           (* uint   *)
 111                u30 1;                                   (* double *)
 112                u30 2; u30 3; u8 0x61; u8 0x62; u8 0x63; (* string *)
 113                u30 2; u8 0x08; u30 1;                   (* ns     *)
 114                u30 2; u30 2; u30 1; u30 2;              (* ns_set *)
 115                u30 3; u8 0x07; u30 0; u30 1;
 116                       u8 0x09; u30 2; u30 3;            (* mname *)] @@
 117              of_cpool cpool);
 118       "of_class test" >::
 119         (fun () ->
 120            ok [u30 10; u30 0] @@
 121              of_class {cinit=10; class_traits=[]});
 122       "of_instance test" >::
 123         (fun () ->
 124            ok [u30 1; (* name *)
 125                u30 2; (* super name *)
 126                u8  3; (* flags *)
 127                u30 4; (* interface count *)
 128                u30 1; u30 2; u30 3; u30 4; (* interface *)
 129                u30 5; (* iinit *)
 130                u30 0; (* traits count *) ] @@
 131              of_instance {
 132                instance_name=1;
 133                super_name=2;
 134                instance_flags=[Sealed;Final];
 135                interfaces=[1;2;3;4];
 136                iinit=5;
 137                instance_traits=[]});
 138       "of_instance protected ns" >::
 139         (fun () ->
 140            ok [u30 1; (* name *)
 141                u30 2; (* super name *)
 142                u8  8; (* flags *)
 143                u30 1; (* protected ns *)
 144                u30 4; (* interface count *)
 145                u30 1; u30 2; u30 3; u30 4; (* interface *)
 146                u30 5; (* iinit *)
 147                u30 0; (* traits count *) ] @@
 148              of_instance {
 149                instance_name=1;
 150                super_name=2;
 151                instance_flags=[ProtectedNs 1];
 152                interfaces=[1;2;3;4];
 153                iinit=5;
 154                instance_traits=[]});
 155       "spimle abc" >::
 156         (fun () ->
 157            ok [u16 16; u16 46;(* version *)
 158                u30 1; u30 1; u30 1; u30 1; u30 1; u30 1; u30 1;
 159                (* cpool *)
 160                u30 0; (* info *)
 161                u30 0; (* meta *)
 162                u30 0; (* class *)
 163                u30 0; (* script *)
 164                u30 0; (* body *) ] @@
 165              to_bytes {
 166                cpool       = empty_cpool;
 167                method_info = [];
 168                metadata    = [];
 169                classes     = [];
 170                instances   = [];
 171                scripts       = [];
 172                method_bodies = []});
 173       "full abc" >::
 174         (fun () ->
 175            ok (List.concat [
 176              (* version *) [ u16 16; u16 46];
 177              (* cpool   *) of_cpool {empty_cpool with string=["foo"] };
 178              (* info    *) [ u30 1]; of_method_info info;
 179              (* meta    *) [u30 0];
 180              (* class   *) [u30 0];
 181              (* script  *) [u30 1]; of_script script;
 182              (* body    *) [u30 1]; of_method_body body; ]) @@
 183              to_bytes {
 184                cpool       = {empty_cpool with string=["foo"] } ;
 185                method_info = [info];
 186                metadata    = [];
 187                classes     = [];
 188                instances   = [];
 189                scripts     = [script];
 190                method_bodies = [body]})
 191      ] ) +> run_test_tt_main