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 string x =
  13   String (node x)
  14
  15 let int x =
  16   Int (node x)
  17
  18 let float x =
  19   Float (node x)
  20
  21 let bool x =
  22   Bool (node x)
  23
  24 let var x =
  25   Var (node x)
  26
  27 let meth name args body =
  28   (node name,List.map node args,body)
  29
  30 let klass name super attrs methods =
  31   Class (node name,node super,List.map node attrs,methods)
  32
  33 let define_class name super attrs =
  34   DefineClass (node name,node super,List.map node attrs)
  35
  36 let define_method name self obj args body =
  37   DefineMethod (node name,(node self,node obj),List.map node args,body)
  38
  39 let _ =
  40   ("clos module test" >::: [
  41      "basic" >::
  42        (fun () ->
  43           ok [klass "Foo" ("bar","Baz") []
  44                 [meth "f" ["self";"x"] (int 42)]] @@
  45             trans [define_class  "Foo" ("bar","Baz") [];
  46                    define_method "f"   "self" "Foo" ["x"] (int 42)]);
  47      "attributes" >::
  48        (fun () ->
  49           ok [klass "Foo" ("bar","Baz") ["x";"y"] []] @@
  50             trans [define_class  "Foo" ("bar","Baz") ["x";"y"]]);
  51      "plain is not change" >::
  52        (fun () ->
  53           ok [Expr (int 42)] @@
  54             trans [Plain (Expr (int 42))]);
  55      "define and plain is mixed" >::
  56        (fun () ->
  57           ok [klass "Foo" ("bar","Baz") []
  58                 [meth "f" ["self";"x"] (int 42)];
  59               Expr (int 42)] @@
  60        trans [define_class "Foo" ("bar","Baz") [];
  61               Plain (Expr (int 42));
  62               define_method "f" "self" "Foo" ["x"] (int 42)]);
  63      "invoke" >::
  64        (fun () ->
  65           ok [klass "Foo" ("bar","Baz") []
  66                 [meth "f" ["self";"x"] (int 42)];
  67               Expr (Invoke (var "obj",node "f",[int 10]))] @@
  68             trans [define_class  "Foo" ("bar","Baz") [];
  69                    define_method "f" "self" "Foo" ["x"] (int 42);
  70                    Plain (Expr (Call [var "f";var "obj";int 10]))]);
  71      "invoke deep" >::
  72        (fun () ->
  73           ok [Expr (If (Invoke (var "obj",node "f",[int 10]),
  74                         Block [],
  75                         Block []))] @@
  76             trans [define_method "f" "self" "Foo" ["x"] (int 42);
  77                    Plain (Expr (If (Call [var "f";var "obj";int 10],
  78                                     Block [],
  79                                     Block [])))])
  80    ]) +> run_test_tt
  81