add unittest

diff --git a/scm/src/codegen/.ocamlinit b/scm/src/codegen/.ocamlinit
index dc9598d..7633d31 100644 (file)
--- a/scm/src/codegen/.ocamlinit
+++ b/scm/src/codegen/.ocamlinit
@@ -9,4 +9,5 @@
 #load "type.cma";;
 
 #load "codegen.cma";;
-#load "../../../camlp4/pa_oo.cmo";;
\ No newline at end of file
+#load "../../../camlp4/pa_oo.cmo";;
+#load "../../../camlp4/pa_openin.cmo";;
\ No newline at end of file

diff --git a/scm/test/codegen/OMakefile b/scm/test/codegen/OMakefile
index b0b9bb3..0f08a3b 100644 (file)
--- a/scm/test/codegen/OMakefile
+++ b/scm/test/codegen/OMakefile
@@ -8,12 +8,14 @@ OUnitTest(bytes        , bytes label)
 OUnitTest(abc          , abc label bytes)
 OUnitTest(revList      , revList)
 OUnitTest(cpool        , cpool revList)
-OUnitTest(closureTrans , closureTrans)
+OUnitTest(closureTrans , closureTrans module)
 OUnitTest(asm          , asm abc label revList cpool bytes instruction)
 OUnitTest(codegenExpr  , codegen label cpool asm bytes revList instruction)
 OUnitTest(codegenStmt  , codegen label cpool asm bytes revList instruction)
 OUnitTest(codegenClass , codegen label cpool asm bytes revList instruction)
 OUnitTest(override     , override binding module)
+OUnitTest(module       , module)
+OUnitTest(binding      , binding module)
 
 # PHONY Target
 .PHONY: clean check

diff --git a/scm/test/codegen/bindingTest.ml b/scm/test/codegen/bindingTest.ml
new file mode 100644 (file)
index 0000000..fb43fcf
--- /dev/null
+++ b/scm/test/codegen/bindingTest.ml
@@ -0,0 +1,89 @@
+open Base
+open Ast
+open Override
+open AstUtil
+open OUnit
+open Binding
+
+let ok x y =
+  assert_equal ~printer:Std.dump x (snd @@ Binding.of_module y)
+
+let member scope ns name =
+  Node.ghost @@ Member (scope,(ns,name))
+let slot scope i =
+  Node.ghost @@ Slot (scope,i)
+let register n =
+  Node.ghost @@ Register n
+
+let class_  meths =
+  AstUtil.class_ (`Public (qname [] "Foo")) (qname [] "Object") [] meths
+
+(*
+  type bind =
+  Register of int
+  | Slot of scope * int
+  | Member of scope * name
+*)
+let _ =
+  ("binding.ml" >::: [
+     "let" >::
+       (fun () ->
+         ok [expr @@ let_ ["x", int 42] @@
+               `BindVar (member (Scope 1) [] "x")]
+           [expr @@ let_ ["x", int 42] @@
+              var [] "x"];
+         ok [expr @@ let_ ["x", var [] "x"] @@
+               block []]
+           [expr @@ let_ ["x", var [] "x"] @@
+              block []];
+         ok [expr @@ let_ ["x", int 42] @@
+               let_  ["x",int 42] @@
+               `BindVar (member (Scope 2) [] "x")]
+           [expr @@ let_ ["x", int 42] @@
+              let_  ["x",int 42] @@
+              var [] "x"]);
+     "letrec" >::
+       (fun () ->
+         ok [expr @@ let_rec ["x", int 42] @@
+               `BindVar (member (Scope 1) [] "x")]
+           [expr @@ let_rec ["x", int 42] @@
+              var [] "x"];
+         (* note! *)
+         ok [expr @@ let_rec ["x", `BindVar (member (Scope 1) [] "x")] @@
+               block []]
+           [expr @@ let_rec ["x", var [] "x"] @@
+              block []];
+         ok [expr @@ let_rec ["x", int 42] @@
+               let_rec  ["x",int 42] @@
+               `BindVar (member (Scope 2) [] "x")]
+           [expr @@ let_rec ["x", int 42] @@
+              let_rec  ["x",int 42] @@
+              var [] "x"]);
+     "lambda" >::
+       (fun () ->
+         ok [expr @@ lambda [] @@ var [] "x"]
+           [expr @@ lambda [] @@ var [] "x"];
+         ok [expr @@ lambda ["x"] @@ `BindVar (register 1)]
+           [expr @@ lambda ["x"] @@ var [] "x"];
+         ok [expr @@ lambda ["x";"y"] @@ `BindVar (register 2)]
+           [expr @@ lambda ["x";"y"] @@ var [] "y"]);
+     "method" >::
+       (fun () ->
+         ok [class_ [public_meth "f" [] @@ var [] "x"]]
+            [class_ [public_meth "f" [] @@ var [] "x"]];
+         ok [class_ [public_meth "f" ["x"] @@ `BindVar (register 0)]]
+            [class_ [public_meth "f" ["x"] @@ var [] "x"]]);
+     "define" >::
+       (fun () ->
+         ok [`ReDefine (`Public (qname [] "x"),0,int 42);
+             expr @@ `BindVar (slot Global 1)]
+           [`Define (`Public (qname [] "x"),int 42);
+            expr @@ var [] "x"]);
+     "class" >::
+       (fun () ->
+         ok [class_ [];
+            expr @@ `BindVar (member Global [] "Foo")]
+           [class_ [];
+            expr @@ var [] "Foo"]);
+   ]) +> run_test_tt
+

diff --git a/scm/test/codegen/moduleTest.ml b/scm/test/codegen/moduleTest.ml
new file mode 100644 (file)
index 0000000..4e2c257
--- /dev/null
+++ b/scm/test/codegen/moduleTest.ml
@@ -0,0 +1,66 @@
+open Base
+open OUnit
+open AstUtil
+
+let ok x y =
+  assert_equal x (Module.of_ast [y])
+
+let define_ name =
+  `Define (name,int 0)
+
+let class_  name =
+  AstUtil.class_ name (qname [] "Object") [] []
+
+let _ = ("module.ml" >::: [
+          "expr" >::
+            (fun () ->
+               ok [ expr @@ int 42 ] @@
+                 expr @@ int 42);
+          "define" >::
+            (fun () ->
+               ok [ define_ (`Public (qname [] "foo")) ] @@
+                 define_ (Node.ghost "foo"));
+          "class" >::
+            (fun () ->
+               ok [ class_ (`Public (qname [] "Foo")) ] @@
+                 class_ (Node.ghost "Foo"));
+          "module-all" >::
+            (fun () ->
+               ok [
+                 expr @@ int 0;
+                 define_ (`Public (qname ["foo"] "foo")) ;
+                 class_  (`Public (qname ["foo"] "Foo"))
+               ] @@
+                 module_ "foo" `All [
+                   expr @@ int 0;
+                   define_ (Node.ghost "foo");
+                   class_ (Node.ghost "Foo");
+                 ]);
+          "module-nest" >::
+            (fun () ->
+               ok [
+                 expr @@ int 0;
+                 define_ (`Public (qname ["foo";"bar"] "foo")) ;
+                 class_  (`Public (qname ["foo";"bar"] "Foo"))
+               ] @@
+                 module_ "foo" `All [
+                   module_ "bar" `All [
+                     expr @@ int 0;
+                     define_ (Node.ghost "foo");
+                     class_ (Node.ghost "Foo");
+                   ]]);
+          "module-only" >::
+            (fun () ->
+               ok [
+                 expr @@ int 0;
+                 define_ (`Public (qname ["foo"] "foo")) ;
+                 class_  (`Internal (qname ["foo"] "Foo"))
+               ] @@
+                 module_ "foo" (`Only [Node.ghost "foo"]) [
+                   expr @@ int 0;
+                   define_ (Node.ghost "foo");
+                   class_ (Node.ghost "Foo");
+                 ]);
+        ]) +> run_test_tt
+
+