/tester.fs

https://github.com/martintrojer/scheme-fsharp · F# · 271 lines · 60 code · 17 blank · 194 comment · 8 complexity · 962d7f6711c9277146b174074e6cf96e MD5 · raw file

  1. // mtscheme
  2. // Copyright (c) 2010 Martin Trojer <martin.trojer@gmail.com>
  3. namespace mtscheme
  4. module tester =
  5. open mtscheme.helper
  6. open mtscheme.parser
  7. open mtscheme.interpreter
  8. open NUnit.Framework
  9. // open ZeroUnit.NUnit // http://zerounit.codeplex.com/
  10. // --- Helpers ----------------------------
  11. let getDoubleResult env expr =
  12. match eval env expr with
  13. | env, res ->
  14. match res with
  15. | Value(Number(n)) -> n
  16. | _ -> failwith "expression failure"
  17. let getBoolResult env expr =
  18. match eval env expr with
  19. | env, res ->
  20. match res with
  21. | Value(Boolean(b)) -> b
  22. | _ -> failwith "expression failure"
  23. let testListResult correct (env, expr) =
  24. let rec testLists' a b =
  25. let test' acc a b =
  26. match (a, b) with
  27. | (LValue(v1), LValue(v2)) ->
  28. acc && (v1 = v2)
  29. | (LList(l1), LList(l2)) ->
  30. acc && (testLists' l1 l2)
  31. | _ -> false
  32. try
  33. List.fold2 test' true a b
  34. with ex -> false // different lengths == fail
  35. match snd(eval env expr) with
  36. | List(res) ->
  37. testLists' res correct
  38. | _ -> false
  39. let testDouble env exprStr correct =
  40. let res = exprStr |> parse |> List.head |> (getDoubleResult env)
  41. Assert.AreEqual(correct, res)
  42. let testBool env exprStr correct =
  43. let res = exprStr |> parse |> List.head |> (getBoolResult env)
  44. Assert.AreEqual(correct, res)
  45. let testList env exprStr correct =
  46. exprStr |> parse |> List.head |> (eval env) |> testListResult correct |> Assert.IsTrue
  47. // --- Tests ----------------------------
  48. [<TestFixture>]
  49. type TestClass() =
  50. let testEnv = expandEnv globalEnv |> setEnv "kalle" (Value(Number(1.0))) |> setEnv "olle" (Value(Number(2.0)))
  51. [<Test>]
  52. member tc.testAdd() =
  53. testDouble testEnv "(+ 1 2)" (1+2)
  54. testDouble testEnv "(+ 1 (+ 2 3))" (1+2+3)
  55. testDouble testEnv "(+ 1)" (1)
  56. testDouble testEnv "(+ 1 1 1)" (1+1+1)
  57. [<Test>]
  58. member tc.testSub() =
  59. testDouble testEnv "(- 1 2)" (1-2)
  60. testDouble testEnv "(- 1 (- 2 3))" (1-(2-3))
  61. testDouble testEnv "(- 1)" (-1) // TODO; special case not handled correctly
  62. testDouble testEnv "(- 1 1 1)" (1-1-1)
  63. [<Test>]
  64. member tc.testMul() =
  65. testDouble testEnv "(* 2 3.14)" (2.0*3.14)
  66. testDouble testEnv "(+ 1 (* 2 3))" (1+2*3)
  67. testDouble testEnv "(* 1)" (1)
  68. testDouble testEnv "(* 2 1 2 2)" (2*1*2*2)
  69. [<Test>]
  70. member tc.testDiv() =
  71. testDouble testEnv "(/ 9 3)" (9/3)
  72. testDouble testEnv "(+ 1 (/ 2 3))" (1.0+2.0/3.0)
  73. testDouble testEnv "(/ 1)" (1)
  74. testDouble testEnv "(/ 2)" (1.0/2.0) // TODO; special case not handled correctly
  75. testDouble testEnv "(/ 1 2 3)" (1.0/2.0/3.0)
  76. [<Test>]
  77. member tc.testVariable() =
  78. testDouble testEnv "(kalle)" (1)
  79. testDouble testEnv "(+ 1 (+ 1 olle))" (1+1+2)
  80. [<Test>]
  81. member tc.testEq() =
  82. testBool testEnv "(= 2 2)" (2=2)
  83. testBool testEnv "(= 2 (+ 1 1))" (2=(1+1))
  84. testBool testEnv "(= 1)" (true)
  85. testBool testEnv "(= 1 1 (+ 1 1) 1)" (false)
  86. [<Test>]
  87. member tc.testGt() =
  88. testBool testEnv "(> 2 2)" (2>2)
  89. testBool testEnv "(> 1 2)" (1>2)
  90. testBool testEnv "(> 2 1)" (2>1)
  91. testBool testEnv "(> (+ 1 1 1) 2)" ((1+1+1)>2)
  92. testBool testEnv "(> 1)" (true) // TODO; should raise failure
  93. testBool testEnv "(> 1 1 (+ 1 1) 1)" (false)
  94. [<Test>]
  95. member tc.testLt() =
  96. testBool testEnv "(< 2 2)" (2<2)
  97. testBool testEnv "(< 1 2)" (1<2)
  98. testBool testEnv "(< 2 1)" (2<1)
  99. testBool testEnv "(< (+ 1 1 1) 2)" ((1+1+1)<2)
  100. testBool testEnv "(< 1)" (true) // TODO; should raise failure
  101. testBool testEnv "(< 1 1 (+ 1 1) 1)" (false)
  102. [<Test>]
  103. member tc.testGe() =
  104. testBool testEnv "(>= 2 2)" (2>=2)
  105. testBool testEnv "(>= 1 2)" (1>=2)
  106. testBool testEnv "(>= 2 1)" (2>=1)
  107. testBool testEnv "(>= (+ 1 1 1) 2)" ((1+1+1)>=2)
  108. testBool testEnv "(>= 1)" (true) // TODO; should raise failure
  109. testBool testEnv "(>= 1 1 (+ 1 1) 1)" (false) // TODO; returning true
  110. [<Test>]
  111. member tc.testLe() =
  112. testBool testEnv "(<= 2 2)" (2<=2)
  113. testBool testEnv "(<= 1 2)" (1<=2)
  114. testBool testEnv "(<= 2 1)" (2<=1)
  115. testBool testEnv "(<= (+ 1 1 1) 2)" ((1+1+1)<=2)
  116. testBool testEnv "(<= 1)" (true) // TODO; should raise failure
  117. testBool testEnv "(<= 1 1 (+ 1 1) 1)" (false)
  118. [<Test>]
  119. member tc.testNot() =
  120. testBool testEnv "(not (= 1 1))" (false)
  121. testBool testEnv "(not (not (= 1 1)))" (true)
  122. [<Test>]
  123. member tc.testDefine() =
  124. let env, res = "(define lisa 4)" |> parse |> List.head |> (eval testEnv)
  125. testDouble env "(lisa)" 4
  126. let env, res = "(define nisse (+ 1 1 1))" |> parse |> List.head |> (eval testEnv)
  127. testDouble env "(nisse)" 3
  128. [<Test>]
  129. member tc.testIf() =
  130. testDouble testEnv "(if (< 2 1) 10 11)" 11
  131. testDouble testEnv "(if (< (+ 1 1 1) 1) 11 (* 2 5))" 10
  132. [<Test>]
  133. member tc.testCond() =
  134. let comb = "(cond ((< x 0) (- 0 x)) ((= x 0) (100)) (else x))"
  135. let env, _ = "(define x -1)" |> parse |> List.head |> (eval testEnv)
  136. testDouble env comb 1
  137. let env, _ = "(define x 0)" |> parse |> List.head |> (eval testEnv)
  138. testDouble env comb 100
  139. let env, _ = "(define x 1)" |> parse |> List.head |> (eval testEnv)
  140. testDouble env comb 1
  141. [<Test>]
  142. member tc.testCons() =
  143. testList testEnv "(cons 1 2)" [LValue(Number(1.0)); LValue(Number(2.0))]
  144. testList testEnv "(cons 1 (cons 2 (cons 3 4)))" [LValue(Number(1.0)); LValue(Number(2.0));
  145. LValue(Number(3.0)); LValue(Number(4.0))]
  146. testList testEnv "(cons (cons 1 2) (cons 3 4))" [LValue(Number(1.0)); LValue(Number(2.0));
  147. LValue(Number(3.0)); LValue(Number(4.0))]
  148. testList testEnv "(cons (- 2 1) (cons 2 (+ 1 1 1)))" [LValue(Number(1.0)); LValue(Number(2.0)); LValue(Number(3.0))]
  149. testList testEnv "(cons \"kalle\" 2)" [LValue(Name("kalle")); LValue(Number(2.0))]
  150. [<Test>]
  151. member tc.testList() =
  152. testList testEnv "(list 1 2)" [LValue(Number(1.0)); LValue(Number(2.0))]
  153. 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))]
  154. testList testEnv "(list 1 \"kalle\")" [LValue(Number(1.0)); LValue(Name("kalle"))]
  155. [<Test>]
  156. member tc.testAppend() =
  157. testList testEnv "(append (list 1) (list 2)" [LValue(Number(1.0)); LValue(Number(2.0))]
  158. testList testEnv "(append (list 1 2) (list 3 4)" [LValue(Number(1.0)); LValue(Number(2.0));
  159. LValue(Number(3.0)); LValue(Number(4.0))]
  160. testList testEnv "(append (list 1) (list 2 (list 3))" [LValue(Number(1.0)); LValue(Number(2.0));
  161. LList[LValue(Number(3.0))]]
  162. [<Test>]
  163. member tc.testCar() =
  164. testDouble testEnv "(car (list 1 2))" 1
  165. testList testEnv "(car (list (list 1) 2))" [LValue(Number(1.0))]
  166. [<Test>]
  167. member tc.testCdr() =
  168. testList testEnv "(cdr (list 1 2))" [LValue(Number(2.0))]
  169. testList testEnv "(cdr (list 1 2 3))" [LValue(Number(2.0)); LValue(Number(3.0))]
  170. testList testEnv "(cdr (list 1))" []
  171. [<Test>]
  172. member tc.testNull() =
  173. testBool testEnv "(null? (list 1))" false
  174. testBool testEnv "(null? (cdr (list 1)))" true
  175. let env, _ = "(define l (list 1 2))" |> parse |> List.head |> (eval testEnv)
  176. testBool env "(null? l)" false
  177. testBool env "(null? (cdr l))" false
  178. testBool env "(null? (cdr (cdr l)))" true
  179. [<Test>]
  180. member tc.testFunction() =
  181. let env, _ = "(define (hello) (display \"hello world\"))" |> parse |> List.head |> (eval testEnv)
  182. let _ = "(hello)" |> parse |> List.head |> (eval env)
  183. let env, _ = "(define (factorial x) (if (= x 0) 1 (* x (factorial (- x 1)))))"
  184. |> parse |> List.head |> (eval testEnv)
  185. testDouble env "(factorial (+ 5 5))" 3628800
  186. let env, _ = "(define (add x y) (define (worker x y) (+ x y)) (worker x y))"
  187. |> parse |> List.head |> (eval testEnv)
  188. testDouble env "(add 1 3)" 4 // TODO; there are atleast one stack frame too many here
  189. [<Test>]
  190. member tc.testLet() =
  191. let env, _ = "(let lisa 1)" |> parse |> List.head |> (eval testEnv)
  192. testDouble env "(lisa)" 1
  193. testDouble env "(let ((a (+ 1 1))(b 3)) (+ a b))" 5
  194. [<Test>]
  195. member tc.testBegin() =
  196. let env, _ = "(define (foreach f l) (if (not (null? l)) (begin (f (car l)) (foreach f (cdr l)))))"
  197. |> parse |> List.head |> (eval testEnv)
  198. let env, _ = "(define l (list 1 2 3))" |> parse |> List.head |> (eval env)
  199. let _ = "(foreach display l)" |> parse |> List.head |> (eval env)
  200. Assert.Pass()
  201. [<Test>]
  202. member tc.testLambda() =
  203. let env, _ = "(define (adder val) (lambda (x) (+ x val)))"
  204. |> parse |> List.head |> (eval testEnv)
  205. let env, _ = "(define add4 (adder 4))" |> parse |> List.head |> (eval env)
  206. testDouble env "(add4 4)" 8
  207. let env, _ = "(define (map f l) (if (not (null? l)) (cons (f (car l)) (map f (cdr l)))))"
  208. |> parse |> List.head |> (eval testEnv)
  209. let env, _ = "(define l (list 1 2 3))" |> parse |> List.head |> (eval env)
  210. testList env "(map (lambda (x) (* x x)) l)" [LValue(Number(1.0)); LValue(Number(4.0)); LValue(Number(9.0))]
  211. [<Test>]
  212. member tc.testDisplay() =
  213. let _ = "(display \"hello world\")" |> parse |> List.head |> (eval testEnv)
  214. let _ = "(display (+ 1 2))" |> parse |> List.head |> (eval testEnv)
  215. Assert.Pass()
  216. [<Test>]
  217. member tc.testNewline() =
  218. let _ = "(newline)" |> parse |> List.head |> (eval testEnv)
  219. Assert.Pass()