From 6dc621ed505f1aa43a8f687a5d507cf476fa9744 Mon Sep 17 00:00:00 2001 From: mzp Date: Sat, 22 Nov 2008 12:54:47 +0900 Subject: [PATCH] [UPDATE]lisp module test --- test/test_clostrans.ml | 82 +++++++++++++++++++++++------------ test/test_lisp.ml | 113 +++++++++++++++++++++++++++++-------------------- 2 files changed, 123 insertions(+), 72 deletions(-) diff --git a/test/test_clostrans.ml b/test/test_clostrans.ml index 57c3610..934013c 100644 --- a/test/test_clostrans.ml +++ b/test/test_clostrans.ml @@ -1,50 +1,80 @@ open Base -open ClosTrans -open Ast +open ClosTrans2 +open Ast2 open OUnit let ok x y = - OUnit.assert_equal ~printer:(string_of_list $ List.map Ast.to_string_stmt) x y + OUnit.assert_equal ~printer:(string_of_list $ List.map Ast2.to_string_stmt) x y + +let node x = + {(Node.empty x) with Node.filename = ""; Node.lineno = 0} + +let string x = + String (node x) + +let int x = + Int (node x) + +let float x = + Float (node x) + +let bool x = + Bool (node x) + +let var x = + Var (node x) + +let meth name args body = + (node name,List.map node args,body) + +let klass name super attrs methods = + Class (node name,node super,List.map node attrs,methods) + +let define_class name super attrs = + DefineClass (node name,node super,List.map node attrs) + +let define_method name self obj args body = + DefineMethod (node name,(node self,node obj),List.map node args,body) let _ = ("clos module test" >::: [ "basic" >:: (fun () -> - ok [Class ("Foo",("bar","Baz"),[], - [("f",["self";"x"],Int 42)])] @@ - trans [DefineClass ("Foo",("bar","Baz"),[]); - DefineMethod ("f",("self","Foo"),["x"],Int 42)]); + ok [klass "Foo" ("bar","Baz") [] + [meth "f" ["self";"x"] (int 42)]] @@ + trans [define_class "Foo" ("bar","Baz") []; + define_method "f" "self" "Foo" ["x"] (int 42)]); "attributes" >:: (fun () -> - ok [Class ("Foo",("bar","Baz"),["x";"y"],[])] @@ - trans [DefineClass ("Foo",("bar","Baz"),["x";"y"])]); + ok [klass "Foo" ("bar","Baz") ["x";"y"] []] @@ + trans [define_class "Foo" ("bar","Baz") ["x";"y"]]); "plain is not change" >:: (fun () -> - ok [Expr (Int 42)] @@ - trans [Plain (Expr (Int 42))]); + ok [Expr (int 42)] @@ + trans [Plain (Expr (int 42))]); "define and plain is mixed" >:: (fun () -> - ok [Class ("Foo",("bar","Baz"),[], - [("f",["self";"x"],Int 42)]); - Expr (Int 42)] @@ - trans [DefineClass ("Foo",("bar","Baz"),[]); - Plain (Expr (Int 42)); - DefineMethod ("f",("self","Foo"),["x"],Int 42)]); + ok [klass "Foo" ("bar","Baz") [] + [meth "f" ["self";"x"] (int 42)]; + Expr (int 42)] @@ + trans [define_class "Foo" ("bar","Baz") []; + Plain (Expr (int 42)); + define_method "f" "self" "Foo" ["x"] (int 42)]); "invoke" >:: (fun () -> - ok [Class ("Foo",("bar","Baz"),[], - [("f",["self";"x"],Int 42)]); - Expr (Invoke (Var "obj","f",[Int 10]))] @@ - trans [DefineClass ("Foo",("bar","Baz"),[]); - DefineMethod ("f",("self","Foo"),["x"],Int 42); - Plain (Expr (Call [Var "f";Var "obj";Int 10]))]); + ok [klass "Foo" ("bar","Baz") [] + [meth "f" ["self";"x"] (int 42)]; + Expr (Invoke (var "obj",node "f",[int 10]))] @@ + trans [define_class "Foo" ("bar","Baz") []; + define_method "f" "self" "Foo" ["x"] (int 42); + Plain (Expr (Call [var "f";var "obj";int 10]))]); "invoke deep" >:: (fun () -> - ok [Expr (If (Invoke (Var "obj","f",[Int 10]), + ok [Expr (If (Invoke (var "obj",node "f",[int 10]), Block [], Block []))] @@ - trans [DefineMethod ("f",("self","Foo"),["x"],Int 42); - Plain (Expr (If (Call [Var "f";Var "obj";Int 10], + trans [define_method "f" "self" "Foo" ["x"] (int 42); + Plain (Expr (If (Call [var "f";var "obj";int 10], Block [], Block [])))]) ]) +> run_test_tt diff --git a/test/test_lisp.ml b/test/test_lisp.ml index d6f12ac..fe146bd 100644 --- a/test/test_lisp.ml +++ b/test/test_lisp.ml @@ -21,6 +21,27 @@ let syntax_error f = with Syntax_error _ -> assert_bool "raised" true +let string x = + String (node x) + +let int x = + Int (node x) + +let float x = + Float (node x) + +let bool x = + Bool (node x) + +let var x = + Var (node x) + +let define_class name super attrs = + DefineClass (node name,node super,List.map node attrs) + +let define_method name self obj args body = + DefineMethod (node name,(node self,node obj),List.map node args,body) + let _ = ("lisp module test" >::: [ "empty" >:: @@ -32,134 +53,134 @@ let _ = Lisp2.compile_string "; foo bar"); "string" >:: (fun () -> - ok (expr (String (node "hello"))) @@ + ok (expr (string "hello")) @@ Lisp2.compile_string "\"hello\""); "int" >:: (fun () -> - ok (expr (Int (node 42))) @@ + ok (expr (int 42)) @@ Lisp2.compile_string "42"); "float" >:: (fun () -> - ok (expr (Float (node 42.))) @@ + ok (expr (float 42.)) @@ Lisp2.compile_string "42."; - ok (expr (Float (node 42.5))) @@ + ok (expr (float 42.5)) @@ Lisp2.compile_string "42.5"); -(* "bool" >:: + "bool" >:: (fun () -> - ok (expr (Bool true)) @@ + ok (expr (bool true)) @@ Lisp2.compile_string "#t"; - ok (expr (Bool false)) @@ + ok (expr (bool false)) @@ Lisp2.compile_string "#f"); "call" >:: (fun () -> - ok (expr (Call [Var "print"])) @@ + ok (expr (Call [var "print"])) @@ Lisp2.compile_string "(print)"; - ok (expr (Call [Var "print";String "hello"])) @@ + ok (expr (Call [var "print";string "hello"])) @@ Lisp2.compile_string "(print \"hello\")"; - ok (expr (Call [Var "print";String "hello";String "world"])) @@ + ok (expr (Call [var "print";string "hello";string "world"])) @@ Lisp2.compile_string "(print \"hello\" \"world\")"); "+" >:: (fun () -> - ok (expr (Call [Var "+";Int 1;Int 2])) @@ + ok (expr (Call [var "+";int 1;int 2])) @@ Lisp2.compile_string "(+ 1 2)"; - ok (expr (Call [Var "-";Int 1;Int 2])) @@ + ok (expr (Call [var "-";int 1;int 2])) @@ Lisp2.compile_string "(- 1 2)"; - ok (expr (Call [Var "*";Int 1;Int 2])) @@ + ok (expr (Call [var "*";int 1;int 2])) @@ Lisp2.compile_string "(* 1 2)"; - ok (expr (Call [Var "/";Int 1;Int 2])) @@ + ok (expr (Call [var "/";int 1;int 2])) @@ Lisp2.compile_string "(/ 1 2)"); "<" >:: (fun () -> - ok (expr (Call [Var "=";Int 1;Int 2])) @@ + ok (expr (Call [var "=";int 1;int 2])) @@ Lisp2.compile_string "(= 1 2)"; - ok (expr (Call [Var "<";Int 1;Int 2])) @@ + ok (expr (Call [var "<";int 1;int 2])) @@ Lisp2.compile_string "(< 1 2)"; - ok (expr (Call [Var "<=";Int 1;Int 2])) @@ + ok (expr (Call [var "<=";int 1;int 2])) @@ Lisp2.compile_string "(<= 1 2)"; - ok (expr (Call [Var ">";Int 1;Int 2])) @@ + ok (expr (Call [var ">";int 1;int 2])) @@ Lisp2.compile_string "(> 1 2)"; - ok (expr (Call [Var ">=";Int 1;Int 2])) @@ + ok (expr (Call [var ">=";int 1;int 2])) @@ Lisp2.compile_string "(>= 1 2)"); "if" >:: (fun () -> - ok (expr (If (Int 1,Int 2,Int 3))) @@ + ok (expr (If (int 1,int 2,int 3))) @@ Lisp2.compile_string "(if 1 2 3)"); "cond" >:: (fun () -> - ok (expr (If (Int 1, - Block [Int 2], - If (Int 3, - Block [Int 4], - Block [Int 5])))) @@ + ok (expr (If (int 1, + Block [int 2], + If (int 3, + Block [int 4], + Block [int 5])))) @@ Lisp2.compile_string "(cond (1 2) (3 4) (else 5))"); "cond without else" >:: (fun () -> - ok (expr (If (Int 1, - Block [Int 2], - If (Int 3, - Block [Int 4], + ok (expr (If (int 1, + Block [int 2], + If (int 3, + Block [int 4], Block [])))) @@ Lisp2.compile_string "(cond (1 2) (3 4))"); "let" >:: (fun () -> - ok (expr (Let (["x",Int 1;"y",Int 2],Block [Var "x";Var "y"]))) @@ + ok (expr (Let ([node "x",int 1;node "y",int 2],Block [var "x";var "y"]))) @@ Lisp2.compile_string "(let ((x 1) (y 2)) x y)"); "letrec" >:: (fun () -> - ok (expr (LetRec (["x",Int 1;"y",Int 2],Block [Var "x";Var "y"]))) @@ + ok (expr (LetRec ([node "x",int 1;node "y",int 2],Block [var "x";var "y"]))) @@ Lisp2.compile_string "(letrec ((x 1) (y 2)) x y)"); "begin" >:: (fun () -> - ok (expr (Block [Int 1;Int 2])) @@ + ok (expr (Block [int 1;int 2])) @@ Lisp2.compile_string "(begin 1 2)"); "lambda" >:: (fun () -> - ok (expr (Lambda ([],Block [Int 42]))) @@ + ok (expr (Lambda ([],Block [int 42]))) @@ Lisp2.compile_string "(lambda () 42)"); "lambda args" >:: (fun () -> - ok (expr (Lambda (["a";"b";"c"],Block [Int 42]))) @@ + ok (expr (Lambda ([node "a";node "b";node "c"],Block [int 42]))) @@ Lisp2.compile_string "(lambda (a b c) 42)"); "new" >:: (fun () -> - ok (expr (New (("","Foo"),[]))) @@ + ok (expr (New (node ("","Foo"),[]))) @@ Lisp2.compile_string "(new Foo)"); "new args" >:: (fun () -> - ok (expr (New (("","Foo"),[Int 1;Int 2]))) @@ + ok (expr (New (node ("","Foo"),[int 1;int 2]))) @@ Lisp2.compile_string "(new Foo 1 2)"); "invoke" >:: (fun () -> - ok (expr (Invoke (Var "foo","baz",[Int 1;Int 2]))) @@ + ok (expr (Invoke (var "foo",node "baz",[int 1;int 2]))) @@ Lisp2.compile_string "(. foo (baz 1 2))"); "define" >:: (fun () -> - ok [Plain (Define ("x",Block [Int 42]))] @@ + ok [Plain (Define (node "x",Block [int 42]))] @@ Lisp2.compile_string "(define x 42)"; - ok [Plain (Define ("f",Lambda (["x"],Block [Int 42])))] @@ + ok [Plain (Define (node "f",Lambda ([node "x"],Block [int 42])))] @@ Lisp2.compile_string "(define (f x) 42)"); "class" >:: (fun () -> - ok [DefineClass ("Foo",("","Object"),["x";"y"])] @@ + ok [define_class "Foo" ("","Object") ["x";"y"]] @@ Lisp2.compile_string "(define-class Foo (Object) (x y))"; - ok [DefineClass ("Foo",("flash.text","Object"),["x";"y"])] @@ + ok [define_class "Foo" ("flash.text","Object") ["x";"y"]] @@ Lisp2.compile_string "(define-class Foo (flash.text.Object) (x y))"; - ok [DefineClass ("Foo",("flash.text","Object"),[])] @@ + ok [define_class "Foo" ("flash.text","Object") []] @@ Lisp2.compile_string "(define-class Foo (flash.text.Object) ())"); "method" >:: (fun () -> - ok [DefineMethod ("f",("self","Object"),["x";"y"],Block [Int 42])] @@ + ok [define_method "f" "self" "Object" ["x";"y"] (Block [int 42])] @@ Lisp2.compile_string "(define-method f ((self Object) x y) 42)"); "slot-ref" >:: (fun () -> - ok (expr (SlotRef (Var "obj","name"))) @@ + ok (expr (SlotRef (var "obj",node "name"))) @@ Lisp2.compile_string "(slot-ref obj name)"); "slot-set!" >:: (fun () -> - ok (expr (SlotSet (Var "obj","name",Int 42))) @@ + ok (expr (SlotSet (var "obj",node "name",int 42))) @@ Lisp2.compile_string "(slot-set! obj name 42)"); "syntax error" >:: (fun () -> syntax_error (fun () -> - Lisp2.compile_string "(if a)"))*) + Lisp2.compile_string "(if a)")) ]) +> run_test_tt -- 2.11.0