test/test_clostrans.ml

   1 open Base
   2 open ClosTrans
   3 open Ast
   4 open OUnit
   5
   6 let ok x y =
   7   OUnit.assert_equal ~printer:(string_of_list $ List.map Ast.to_string_stmt) x y
   8
   9 let node x =
  10   {(Node.empty x) with Node.filename = "<string>"; Node.lineno = 0}
  11
  12 let pos x n a b =
  13   {(Node.empty x) with
  14      Node.filename = "<string>";
  15      lineno        = n;
  16      start_pos     = a;
  17      end_pos       = b}
  18
  19 let string x =
  20   `String (node x)
  21
  22 let int x =
  23   `Int (node x)
  24
  25 let float x =
  26   `Float (node x)
  27
  28 let bool x =
  29   `Bool (node x)
  30
  31 let var x =
  32   `Var (node x)
  33
  34 let meth name args body =
  35   (node name,List.map node args,body)
  36
  37 let klass name super attrs methods =
  38   `Class (node name,node super,List.map node attrs,methods)
  39
  40 let define_class name super attrs =
  41   `DefineClass (node name,node super,List.map node attrs)
  42
  43 let define_method name self obj args body =
  44   `DefineMethod (node name,(node self,node obj),List.map node args,body)
  45
  46 let _ =
  47   ("clos module test" >::: [
  48      "pos" >::
  49        (fun () ->
  50           let klass =
  51             pos "Foo" 0 1 3 in
  52           let super =
  53             pos ("bar","Baz") 0 5 8 in
  54           let attrs =
  55             [pos "x" 0 9 10] in
  56           let f =
  57             pos "f" 1 0 1 in
  58           let self =
  59             pos "self" 1 3 5 in
  60           let obj  =
  61             pos "Foo" 1 6 8 in
  62           let args =
  63             [pos "x" 1 9 10] in
  64             ok [`Class (klass,super,attrs,
  65                        [f,self::args,`Block []])] @@
  66               trans [`DefineClass (klass,super,attrs);
  67                      `DefineMethod(f,(self,obj),args,`Block [])]);
  68      "basic" >::
  69        (fun () ->
  70           ok [klass "Foo" ("bar","Baz") []
  71                 [meth "f" ["self";"x"] (int 42)]] @@
  72             trans [define_class  "Foo" ("bar","Baz") [];
  73                    define_method "f"   "self" "Foo" ["x"] (int 42)]);
  74      "attributes" >::
  75        (fun () ->
  76           ok [klass "Foo" ("bar","Baz") ["x";"y"] []] @@
  77             trans [define_class  "Foo" ("bar","Baz") ["x";"y"]]);
  78      "plain is not change" >::
  79        (fun () ->
  80           ok [`Expr (int 42)] @@
  81             trans [`Expr (int 42)]);
  82      "define and plain is mixed" >::
  83        (fun () ->
  84           ok [klass "Foo" ("bar","Baz") []
  85                 [meth "f" ["self";"x"] (int 42)];
  86               `Expr (int 42)] @@
  87        trans [define_class "Foo" ("bar","Baz") [];
  88               `Expr (int 42);
  89               define_method "f" "self" "Foo" ["x"] (int 42)]);
  90      "invoke" >::
  91        (fun () ->
  92           ok [klass "Foo" ("bar","Baz") []
  93                 [meth "f" ["self";"x"] (int 42)];
  94               `Expr (`Invoke (var "obj",node "f",[int 10]))] @@
  95             trans [define_class  "Foo" ("bar","Baz") [];
  96                    define_method "f" "self" "Foo" ["x"] (int 42);
  97                    `Expr (`Call [var "f";var "obj";int 10])]);
  98      "invoke deep" >::
  99        (fun () ->
 100           ok [`Expr (`If (`Invoke (var "obj",node "f",[int 10]),
 101                         `Block [],
 102                         `Block []))] @@
 103             trans [define_method "f" "self" "Foo" ["x"] (int 42);
 104                    `Expr (`If (`Call [var "f";var "obj";int 10],
 105                                `Block [],
 106                                `Block []))])
 107    ]) +> run_test_tt
 108