/tester.fs
https://github.com/martintrojer/scheme-fsharp · F# · 271 lines · 60 code · 17 blank · 194 comment · 8 complexity · 962d7f6711c9277146b174074e6cf96e MD5 · raw file
- // mtscheme
- // Copyright (c) 2010 Martin Trojer <martin.trojer@gmail.com>
-
- namespace mtscheme
-
- module tester =
-
- open mtscheme.helper
- open mtscheme.parser
- open mtscheme.interpreter
- open NUnit.Framework
- // open ZeroUnit.NUnit // http://zerounit.codeplex.com/
-
- // --- Helpers ----------------------------
-
- let getDoubleResult env expr =
- match eval env expr with
- | env, res ->
- match res with
- | Value(Number(n)) -> n
- | _ -> failwith "expression failure"
-
- let getBoolResult env expr =
- match eval env expr with
- | env, res ->
- match res with
- | Value(Boolean(b)) -> b
- | _ -> failwith "expression failure"
-
- let testListResult correct (env, expr) =
- let rec testLists' a b =
- let test' acc a b =
- match (a, b) with
- | (LValue(v1), LValue(v2)) ->
- acc && (v1 = v2)
- | (LList(l1), LList(l2)) ->
- acc && (testLists' l1 l2)
- | _ -> false
- try
- List.fold2 test' true a b
- with ex -> false // different lengths == fail
-
- match snd(eval env expr) with
- | List(res) ->
- testLists' res correct
- | _ -> false
-
- let testDouble env exprStr correct =
- let res = exprStr |> parse |> List.head |> (getDoubleResult env)
- Assert.AreEqual(correct, res)
-
- let testBool env exprStr correct =
- let res = exprStr |> parse |> List.head |> (getBoolResult env)
- Assert.AreEqual(correct, res)
-
- let testList env exprStr correct =
- exprStr |> parse |> List.head |> (eval env) |> testListResult correct |> Assert.IsTrue
-
- // --- Tests ----------------------------
-
- [<TestFixture>]
- type TestClass() =
-
- let testEnv = expandEnv globalEnv |> setEnv "kalle" (Value(Number(1.0))) |> setEnv "olle" (Value(Number(2.0)))
-
- [<Test>]
- member tc.testAdd() =
- testDouble testEnv "(+ 1 2)" (1+2)
- testDouble testEnv "(+ 1 (+ 2 3))" (1+2+3)
- testDouble testEnv "(+ 1)" (1)
- testDouble testEnv "(+ 1 1 1)" (1+1+1)
-
- [<Test>]
- member tc.testSub() =
- testDouble testEnv "(- 1 2)" (1-2)
- testDouble testEnv "(- 1 (- 2 3))" (1-(2-3))
- testDouble testEnv "(- 1)" (-1) // TODO; special case not handled correctly
- testDouble testEnv "(- 1 1 1)" (1-1-1)
-
- [<Test>]
- member tc.testMul() =
- testDouble testEnv "(* 2 3.14)" (2.0*3.14)
- testDouble testEnv "(+ 1 (* 2 3))" (1+2*3)
- testDouble testEnv "(* 1)" (1)
- testDouble testEnv "(* 2 1 2 2)" (2*1*2*2)
-
- [<Test>]
- member tc.testDiv() =
- testDouble testEnv "(/ 9 3)" (9/3)
- testDouble testEnv "(+ 1 (/ 2 3))" (1.0+2.0/3.0)
- testDouble testEnv "(/ 1)" (1)
- testDouble testEnv "(/ 2)" (1.0/2.0) // TODO; special case not handled correctly
- testDouble testEnv "(/ 1 2 3)" (1.0/2.0/3.0)
-
- [<Test>]
- member tc.testVariable() =
- testDouble testEnv "(kalle)" (1)
- testDouble testEnv "(+ 1 (+ 1 olle))" (1+1+2)
-
- [<Test>]
- member tc.testEq() =
- testBool testEnv "(= 2 2)" (2=2)
- testBool testEnv "(= 2 (+ 1 1))" (2=(1+1))
- testBool testEnv "(= 1)" (true)
- testBool testEnv "(= 1 1 (+ 1 1) 1)" (false)
-
- [<Test>]
- member tc.testGt() =
- testBool testEnv "(> 2 2)" (2>2)
- testBool testEnv "(> 1 2)" (1>2)
- testBool testEnv "(> 2 1)" (2>1)
- testBool testEnv "(> (+ 1 1 1) 2)" ((1+1+1)>2)
- testBool testEnv "(> 1)" (true) // TODO; should raise failure
- testBool testEnv "(> 1 1 (+ 1 1) 1)" (false)
-
- [<Test>]
- member tc.testLt() =
- testBool testEnv "(< 2 2)" (2<2)
- testBool testEnv "(< 1 2)" (1<2)
- testBool testEnv "(< 2 1)" (2<1)
- testBool testEnv "(< (+ 1 1 1) 2)" ((1+1+1)<2)
- testBool testEnv "(< 1)" (true) // TODO; should raise failure
- testBool testEnv "(< 1 1 (+ 1 1) 1)" (false)
-
- [<Test>]
- member tc.testGe() =
- testBool testEnv "(>= 2 2)" (2>=2)
- testBool testEnv "(>= 1 2)" (1>=2)
- testBool testEnv "(>= 2 1)" (2>=1)
- testBool testEnv "(>= (+ 1 1 1) 2)" ((1+1+1)>=2)
- testBool testEnv "(>= 1)" (true) // TODO; should raise failure
- testBool testEnv "(>= 1 1 (+ 1 1) 1)" (false) // TODO; returning true
-
- [<Test>]
- member tc.testLe() =
- testBool testEnv "(<= 2 2)" (2<=2)
- testBool testEnv "(<= 1 2)" (1<=2)
- testBool testEnv "(<= 2 1)" (2<=1)
- testBool testEnv "(<= (+ 1 1 1) 2)" ((1+1+1)<=2)
- testBool testEnv "(<= 1)" (true) // TODO; should raise failure
- testBool testEnv "(<= 1 1 (+ 1 1) 1)" (false)
-
- [<Test>]
- member tc.testNot() =
- testBool testEnv "(not (= 1 1))" (false)
- testBool testEnv "(not (not (= 1 1)))" (true)
-
- [<Test>]
- member tc.testDefine() =
- let env, res = "(define lisa 4)" |> parse |> List.head |> (eval testEnv)
- testDouble env "(lisa)" 4
-
- let env, res = "(define nisse (+ 1 1 1))" |> parse |> List.head |> (eval testEnv)
- testDouble env "(nisse)" 3
-
- [<Test>]
- member tc.testIf() =
- testDouble testEnv "(if (< 2 1) 10 11)" 11
- testDouble testEnv "(if (< (+ 1 1 1) 1) 11 (* 2 5))" 10
-
- [<Test>]
- member tc.testCond() =
- let comb = "(cond ((< x 0) (- 0 x)) ((= x 0) (100)) (else x))"
-
- let env, _ = "(define x -1)" |> parse |> List.head |> (eval testEnv)
- testDouble env comb 1
-
- let env, _ = "(define x 0)" |> parse |> List.head |> (eval testEnv)
- testDouble env comb 100
-
- let env, _ = "(define x 1)" |> parse |> List.head |> (eval testEnv)
- testDouble env comb 1
-
- [<Test>]
- member tc.testCons() =
- testList testEnv "(cons 1 2)" [LValue(Number(1.0)); LValue(Number(2.0))]
- testList testEnv "(cons 1 (cons 2 (cons 3 4)))" [LValue(Number(1.0)); LValue(Number(2.0));
- LValue(Number(3.0)); LValue(Number(4.0))]
- testList testEnv "(cons (cons 1 2) (cons 3 4))" [LValue(Number(1.0)); LValue(Number(2.0));
- LValue(Number(3.0)); LValue(Number(4.0))]
- testList testEnv "(cons (- 2 1) (cons 2 (+ 1 1 1)))" [LValue(Number(1.0)); LValue(Number(2.0)); LValue(Number(3.0))]
- testList testEnv "(cons \"kalle\" 2)" [LValue(Name("kalle")); LValue(Number(2.0))]
-
- [<Test>]
- member tc.testList() =
- testList testEnv "(list 1 2)" [LValue(Number(1.0)); LValue(Number(2.0))]
- testList testEnv "(list 5 (list 1 1) 2)" [LValue(Number(5.0)); LList([LValue(Number(1.0)); LValue(Number(1.0))]); LValue(Number(2.0))]
- testList testEnv "(list 1 \"kalle\")" [LValue(Number(1.0)); LValue(Name("kalle"))]
-
- [<Test>]
- member tc.testAppend() =
- testList testEnv "(append (list 1) (list 2)" [LValue(Number(1.0)); LValue(Number(2.0))]
- testList testEnv "(append (list 1 2) (list 3 4)" [LValue(Number(1.0)); LValue(Number(2.0));
- LValue(Number(3.0)); LValue(Number(4.0))]
- testList testEnv "(append (list 1) (list 2 (list 3))" [LValue(Number(1.0)); LValue(Number(2.0));
- LList[LValue(Number(3.0))]]
-
- [<Test>]
- member tc.testCar() =
- testDouble testEnv "(car (list 1 2))" 1
- testList testEnv "(car (list (list 1) 2))" [LValue(Number(1.0))]
-
- [<Test>]
- member tc.testCdr() =
- testList testEnv "(cdr (list 1 2))" [LValue(Number(2.0))]
- testList testEnv "(cdr (list 1 2 3))" [LValue(Number(2.0)); LValue(Number(3.0))]
- testList testEnv "(cdr (list 1))" []
-
- [<Test>]
- member tc.testNull() =
- testBool testEnv "(null? (list 1))" false
- testBool testEnv "(null? (cdr (list 1)))" true
-
- let env, _ = "(define l (list 1 2))" |> parse |> List.head |> (eval testEnv)
- testBool env "(null? l)" false
- testBool env "(null? (cdr l))" false
- testBool env "(null? (cdr (cdr l)))" true
-
- [<Test>]
- member tc.testFunction() =
- let env, _ = "(define (hello) (display \"hello world\"))" |> parse |> List.head |> (eval testEnv)
- let _ = "(hello)" |> parse |> List.head |> (eval env)
-
- let env, _ = "(define (factorial x) (if (= x 0) 1 (* x (factorial (- x 1)))))"
- |> parse |> List.head |> (eval testEnv)
- testDouble env "(factorial (+ 5 5))" 3628800
-
- let env, _ = "(define (add x y) (define (worker x y) (+ x y)) (worker x y))"
- |> parse |> List.head |> (eval testEnv)
- testDouble env "(add 1 3)" 4 // TODO; there are atleast one stack frame too many here
-
- [<Test>]
- member tc.testLet() =
- let env, _ = "(let lisa 1)" |> parse |> List.head |> (eval testEnv)
- testDouble env "(lisa)" 1
-
- testDouble env "(let ((a (+ 1 1))(b 3)) (+ a b))" 5
-
- [<Test>]
- member tc.testBegin() =
- let env, _ = "(define (foreach f l) (if (not (null? l)) (begin (f (car l)) (foreach f (cdr l)))))"
- |> parse |> List.head |> (eval testEnv)
- let env, _ = "(define l (list 1 2 3))" |> parse |> List.head |> (eval env)
- let _ = "(foreach display l)" |> parse |> List.head |> (eval env)
-
- Assert.Pass()
-
- [<Test>]
- member tc.testLambda() =
- let env, _ = "(define (adder val) (lambda (x) (+ x val)))"
- |> parse |> List.head |> (eval testEnv)
- let env, _ = "(define add4 (adder 4))" |> parse |> List.head |> (eval env)
- testDouble env "(add4 4)" 8
-
- let env, _ = "(define (map f l) (if (not (null? l)) (cons (f (car l)) (map f (cdr l)))))"
- |> parse |> List.head |> (eval testEnv)
- let env, _ = "(define l (list 1 2 3))" |> parse |> List.head |> (eval env)
- testList env "(map (lambda (x) (* x x)) l)" [LValue(Number(1.0)); LValue(Number(4.0)); LValue(Number(9.0))]
-
- [<Test>]
- member tc.testDisplay() =
- let _ = "(display \"hello world\")" |> parse |> List.head |> (eval testEnv)
- let _ = "(display (+ 1 2))" |> parse |> List.head |> (eval testEnv)
-
- Assert.Pass()
-
- [<Test>]
- member tc.testNewline() =
- let _ = "(newline)" |> parse |> List.head |> (eval testEnv)
-
- Assert.Pass()