test/test_lisp.ml

   1 open Base
   2 open OUnit
   3 open Lisp
   4 open Util
   5 open Ast
   6 open ClosTrans
   7
   8 let expr xs =
   9   [ClosTrans.Plain (Ast.Expr xs)]
  10
  11 let node x =
  12   {(Node.empty x) with Node.filename = "<string>"; Node.lineno = 0}
  13
  14 let ok x y =
  15   OUnit.assert_equal ~printer:(string_of_list $ List.map ClosTrans.to_string) x y
  16
  17 let syntax_error f =
  18   try
  19     f ();
  20     assert_failure "not raise"
  21   with Syntax_error _ ->
  22     assert_bool "raised" true
  23
  24 let string x =
  25   String (node x)
  26
  27 let int x =
  28   Int (node x)
  29
  30 let float x =
  31   Float (node x)
  32
  33 let bool x =
  34   Bool (node x)
  35
  36 let var x =
  37   Var (node x)
  38
  39 let define_class name super attrs =
  40   DefineClass (node name,node super,List.map node attrs)
  41
  42 let define_method name self obj args body =
  43   DefineMethod (node name,(node self,node obj),List.map node args,body)
  44
  45 let _ =
  46   ("lisp module test" >::: [
  47      "empty" >::
  48        (fun () ->
  49           OUnit.assert_equal [] @@ Lisp.compile_string "");
  50      "comment" >::
  51        (fun () ->
  52           OUnit.assert_equal [] @@
  53             Lisp.compile_string "; foo bar");
  54      "string" >::
  55        (fun () ->
  56           ok (expr (string "hello")) @@
  57             Lisp.compile_string "\"hello\"");
  58      "int" >::
  59        (fun () ->
  60           ok (expr (int 42)) @@
  61             Lisp.compile_string "42");
  62      "float" >::
  63        (fun () ->
  64           ok (expr (float 42.)) @@
  65             Lisp.compile_string "42.";
  66           ok (expr (float 42.5)) @@
  67             Lisp.compile_string "42.5");
  68      "bool" >::
  69        (fun () ->
  70           ok (expr (bool true)) @@
  71             Lisp.compile_string "#t";
  72           ok (expr (bool false)) @@
  73             Lisp.compile_string "#f");
  74      "call" >::
  75        (fun () ->
  76           ok (expr (Call [var "print"])) @@
  77             Lisp.compile_string "(print)";
  78           ok (expr (Call [var "print";string "hello"])) @@
  79             Lisp.compile_string "(print \"hello\")";
  80           ok (expr (Call [var "print";string "hello";string "world"])) @@
  81             Lisp.compile_string "(print \"hello\" \"world\")");
  82      "+" >::
  83        (fun () ->
  84           ok (expr (Call [var "+";int 1;int 2])) @@
  85             Lisp.compile_string "(+ 1 2)";
  86           ok (expr (Call [var "-";int 1;int 2])) @@
  87             Lisp.compile_string "(- 1 2)";
  88           ok (expr (Call [var "*";int 1;int 2])) @@
  89             Lisp.compile_string "(* 1 2)";
  90           ok (expr (Call [var "/";int 1;int 2])) @@
  91             Lisp.compile_string "(/ 1 2)");
  92      "<" >::
  93        (fun () ->
  94           ok (expr (Call [var "=";int 1;int 2])) @@
  95             Lisp.compile_string "(= 1 2)";
  96           ok (expr (Call [var "<";int 1;int 2])) @@
  97             Lisp.compile_string "(< 1 2)";
  98           ok (expr (Call [var "<=";int 1;int 2])) @@
  99             Lisp.compile_string "(<= 1 2)";
 100           ok (expr (Call [var ">";int 1;int 2])) @@
 101             Lisp.compile_string "(> 1 2)";
 102           ok (expr (Call [var ">=";int 1;int 2])) @@
 103             Lisp.compile_string "(>= 1 2)");
 104      "if" >::
 105        (fun () ->
 106           ok (expr (If (int 1,int 2,int 3))) @@
 107             Lisp.compile_string "(if 1 2 3)");
 108      "cond" >::
 109        (fun () ->
 110           ok (expr (If (int 1,
 111                           Block [int 2],
 112                           If (int 3,
 113                               Block [int 4],
 114                               Block [int 5])))) @@
 115             Lisp.compile_string "(cond (1 2) (3 4) (else 5))");
 116      "cond without else" >::
 117        (fun () ->
 118           ok (expr (If (int 1,
 119                           Block [int 2],
 120                           If (int 3,
 121                               Block [int 4],
 122                               Block [])))) @@
 123             Lisp.compile_string "(cond (1 2) (3 4))");
 124      "let" >::
 125        (fun () ->
 126           ok (expr (Let ([node "x",int 1;node "y",int 2],Block [var "x";var "y"]))) @@
 127             Lisp.compile_string "(let ((x 1) (y 2)) x y)");
 128      "letrec" >::
 129        (fun () ->
 130           ok (expr (LetRec ([node "x",int 1;node "y",int 2],Block [var "x";var "y"]))) @@
 131             Lisp.compile_string "(letrec ((x 1) (y 2)) x y)");
 132      "begin" >::
 133        (fun () ->
 134           ok (expr (Block [int 1;int 2])) @@
 135             Lisp.compile_string "(begin 1 2)");
 136      "lambda" >::
 137        (fun () ->
 138           ok (expr (Lambda ([],Block [int 42]))) @@
 139             Lisp.compile_string "(lambda () 42)");
 140      "lambda args" >::
 141        (fun () ->
 142           ok (expr (Lambda ([node "a";node "b";node "c"],Block [int 42]))) @@
 143             Lisp.compile_string "(lambda (a b c) 42)");
 144      "new" >::
 145        (fun () ->
 146           ok (expr (New (node ("","Foo"),[]))) @@
 147             Lisp.compile_string "(new Foo)");
 148      "new args" >::
 149        (fun () ->
 150           ok (expr (New (node ("","Foo"),[int 1;int 2]))) @@
 151             Lisp.compile_string "(new Foo 1 2)");
 152      "invoke" >::
 153        (fun () ->
 154           ok (expr (Invoke (var "foo",node "baz",[int 1;int 2]))) @@
 155             Lisp.compile_string "(. foo (baz 1 2))");
 156      "define" >::
 157        (fun () ->
 158           ok [Plain (Define (node "x",Block [int 42]))] @@
 159             Lisp.compile_string "(define x 42)";
 160           ok [Plain (Define (node "f",Lambda ([node "x"],Block [int 42])))] @@
 161             Lisp.compile_string "(define (f x) 42)");
 162      "class" >::
 163        (fun () ->
 164           ok [define_class "Foo" ("","Object") ["x";"y"]] @@
 165             Lisp.compile_string "(define-class Foo (Object) (x y))";
 166           ok [define_class "Foo" ("flash.text","Object") ["x";"y"]] @@
 167             Lisp.compile_string "(define-class Foo (flash.text.Object) (x y))";
 168           ok [define_class "Foo" ("flash.text","Object") []] @@
 169             Lisp.compile_string "(define-class Foo (flash.text.Object) ())");
 170      "method" >::
 171        (fun () ->
 172           ok [define_method  "f" "self" "Object" ["x";"y"] (Block [int 42])] @@
 173             Lisp.compile_string "(define-method f ((self Object) x y) 42)");
 174      "slot-ref" >::
 175        (fun () ->
 176           ok (expr (SlotRef (var "obj",node "name"))) @@
 177             Lisp.compile_string "(slot-ref obj name)");
 178      "slot-set!" >::
 179        (fun () ->
 180           ok (expr (SlotSet (var "obj",node "name",int 42))) @@
 181             Lisp.compile_string "(slot-set! obj name 42)");
 182      "syntax error" >::
 183        (fun () ->
 184           syntax_error (fun () ->
 185                           Lisp.compile_string "(if a)"))
 186    ]) +> run_test_tt