sifflet-2.3.0: tests/Testing/Unit/ExprTests.hs
-- New tests for Expr
module Testing.Unit.ExprTests (tests, runU) where
import Test.HUnit
import Data.Number.Sifflet
import Data.Sifflet.Tree as T
import Language.Sifflet.Examples
import Language.Sifflet.Expr
import Language.Sifflet.ExprTree
import Text.Sifflet.Repr ()
import Language.Sifflet.Util
import Testing.TestUtil
env0 :: Env
env0 = makeEnv [] []
envTest :: Env
envTest = extendEnv ["x", "y"] -- , "foo"]
[VNumber (Exact 3), VNumber (Exact 7)] -- , VFun foo]
exampleEnv
fPlus :: Function
fPlus = envGetFunction baseEnv "+"
-- (ifExpr t a b represents "if t a else b")
ifExpr :: Bool -> Integer -> Integer -> Expr
ifExpr bool0 int1 int2 = eIf (eBool bool0) (eInt int1) (eInt int2)
plusExpr :: Integer -> Integer -> Expr
plusExpr int1 int2 = ePlus (eInt int1) (eInt int2)
testRepr :: Test
testRepr = assertAll
[
-- Functions
assertEqual "repr of Function (primitive)" "<primfunc +>"
(repr fPlus),
-- Values
assertEqual "repr of VString" "\"hi monde\"" (repr $ VString "hi monde"),
assertEqual "repr of VNumber" "23" (repr $ VNumber (Exact 23)),
assertEqual "repr of VBool" "False" (repr $ VBool False),
-- add VList ...
-- ExprNode
assertEqual "reprl of ExprNode/symbol with no value"
["casey"]
(reprl $ ENode (NSymbol (Symbol "casey")) EvalUntried),
assertEqual "reprl of ExprNode/symbol with value"
["casey", "23"]
(reprl $ ENode (NSymbol (Symbol "casey"))
(EvalOk (VNumber (Exact 23)))),
assertEqual "reprl of ExprNode/symbol with an error"
["casey", "error: unbound"]
(reprl $ ENode (NSymbol (Symbol "casey")) (EvalError "unbound")),
assertEqual "reprs of ExprNode/symbol with value"
"casey 23"
(reprs $ ENode (NSymbol (Symbol "casey"))
(EvalOk (VNumber (Exact 23)))),
assertEqual "reprl of ExprNode/string literal"
["\"adam\""]
(reprl $ ENode (NString "adam") EvalUntried),
assertEqual "reprl of ExprNode/int literal"
["23"]
(reprl $ ENode (NNumber (Exact 23)) EvalUntried),
assertEqual "reprl of ExprNode/boolean literal"
["False"]
(reprl $ ENode (NBool False) (EvalOk (VBool False))),
assertEqual "reprl of ExprNode/if"
["if"]
(reprl $ ENode (NSymbol (Symbol "if")) EvalUntried),
assertEqual "reprl of ExprNode/if/value"
["if", "5"]
(reprl $ ENode (NSymbol (Symbol "if"))
(EvalOk (VNumber (Exact 5)))),
assertEqual "reprs of ExprNode/if/value"
"if 5"
(reprs $ ENode (NSymbol (Symbol "if"))
(EvalOk (VNumber (Exact 5)))),
-- Expr
assertEqual "repr of Expr/variable"
"betty"
(repr $ eSymbol "betty"),
assertEqual "repr of Expr/function call with args"
"(top sam \"johnny\")"
(repr (eCall "top" [eSymbol "sam", eString "johnny"]))
]
testEnv :: Test
testEnv =
let ints = map int
e0 = makeEnv [] []
e1 = extendEnv ["a", "b"] (ints [1, 3]) e0
e2 = extendEnv ["b", "c", "d"] (ints [5, 7, 9]) e1
in assertAll
[
-- testing Env
assertEqual "makeEnv + envGet"
(int 21)
(envGet (makeEnv ["a", "b"] [int 21, VString "hoot"])
"a"),
assertEqual "envIns + envGet"
(int 12)
(envGet (envIns e0 "x" (int 12)) "x"),
assertEqual "extendEnv e1 a" (int 1) (envGet e1 "a"),
assertEqual "extendEnv e1 b" (int 3) (envGet e1 "b"),
assertEqual "extendEnv e2 b" (int 5) (envGet e2 "b"),
assertEqual "extendEnv e2 c" (int 7) (envGet e2 "c"),
assertEqual "extendEnv e2 d" (int 9) (envGet e2 "d"),
assertEqual "envSet e0 a 1"
(makeEnv ["a"] [int 1])
(envSet e0 "a" (int 1)),
assertEqual "envSet e1 a 7"
(extendEnv ["a", "b"] (ints [7, 3]) e0)
(envSet e1 "a" (int 7)),
assertEqual "envSet e2 a 7"
(extendEnv ["b", "c", "d"] (ints [5, 7, 9])
(extendEnv ["a", "b"] (ints [7, 3]) e0))
(envSet e2 "a" (int 7)),
assertEqual "envSet e2 b 18"
(extendEnv ["b", "c", "d"] (ints [18, 7, 9]) e1)
(envSet e2 "b" (int 18)),
assertEqual "envSet e2 z 23"
(extendEnv ["b", "c", "d", "z"]
(ints [5, 7, 9, 23])
e1)
(envSet e2 "z" (int 23))
]
testExprTree :: Test
testExprTree = TestCase $
let call1 = eCall "top" [eSymbol "sam", eString "johnny"]
in assertEqual "testing reciprocals exprTree, treeExpr"
(Succ call1)
(treeToExpr (exprToTree call1))
int :: Integer -> Value
int = VNumber . Exact
testEval :: Test
testEval =
assertAll
[assertEqual "eval 2 + 3"
(EvalOk (VNumber (Exact 5)))
(eval (ePlus (eInt 2) (eInt 3))
exampleEnv)
,
assertEqual "eval x + y"
(EvalOk (int 10))
(eval (ePlus (eSymbol "x") (eSymbol "y"))
envTest)
,
assertEqual "eval foo 2 4"
(EvalOk (int 8))
(eval (eFoo (eInt 2) (eInt 4)) envTest)
,
assertEqual "eval foo x y"
(EvalOk (int 13))
(eval (eFoo (eSymbol "x") (eSymbol "y"))
envTest)
,
assertEqual "eval (1 + x) + foo y 2"
(EvalOk (int 20))
(eval (ePlus (ePlus (eInt 1) (eSymbol "x"))
(eFoo (eSymbol "y") (eInt 2)))
envTest)
,
assertEqual "eval max x y"
(EvalOk (int 7))
(eval (eMax (eSymbol "x") (eSymbol "y"))
envTest)
,
assertEqual "eval max 42 12"
(EvalOk (int 42))
(eval (eMax (eInt 42) (eInt 12)) envTest)
,
assertEqual "eval fact 0"
(EvalOk (int 1))
(eval (eFact (eInt 0)) envTest)
,
assertEqual "eval fact 5"
(EvalOk (int 120))
(eval (eFact (eInt 5)) envTest)
,
assertEqual "eval literal"
(EvalOk (int 345))
(eval (eInt 345) env0)
,
assertEqual "eval variable"
(EvalOk (int 331))
(eval (eSymbol "w3c")
(makeEnv ["w3c"] [int 331]))
,
assertEqual "eval if false"
(EvalOk (int 281))
(eval (ifExpr False 279 281) env0)
,
assertEqual "eval if true"
(EvalOk (int 279))
(eval (ifExpr True 279 281) env0)
,
assertEqual "eval function call"
(EvalOk (int 5))
(eval (plusExpr 2 3) envTest)
,
assertEqual "eval function call with unbound variable"
(EvalError "unbound variable: j")
(eval (ePlus (eSymbol "j") (eInt 1)) envTest)
,
assertEqual "eval head okay"
(EvalOk (int 5))
(eval (eCall "head" [EList [eInt 5, eInt 7]])
envTest)
,
assertEqual "eval head with error"
(EvalError "head: empty list")
(eval (eCall "head" [EList []]) envTest)
,
assertEqual "eval div by zero"
(EvalError
"div: zero divisor ([VNumber 3,VNumber 0])")
(eval (eCall "div" [eSymbol "x", eInt 0])
envTest)
]
testEvalTree :: Test
testEvalTree = assertAll
[let t = evalTree (exprToTree (plusExpr 5 7)) envTest
ENode _ mvalue = rootLabel t
in assertEqual "evalTree: plus" (EvalOk (int 12)) mvalue,
let t = evalTree (exprToTree (ifExpr True 8 21)) env0
ENode _ mvalue = rootLabel t
in assertEqual "evalTree: if true" (EvalOk (int 8)) mvalue,
let t = evalTree (exprToTree (ifExpr False 17 35)) env0
ENode _ mvalue = rootLabel t
in assertEqual "evalTree: if false" (EvalOk (int 35)) mvalue,
let t = evalTree (exprToTree (ePlus (eSymbol "j") (eInt 1))) envTest
ENode _ mvalue = rootLabel t
in assertEqual "evalTree: function call with unbound variable"
(EvalError "unbound variable: j")
mvalue
]
testUnevalTree :: Test
testUnevalTree = TestCase $
let t1 = exprToTree (ePlus (eSymbol "a") (eTimes (eSymbol "b") (eInt 3)))
t2 = evalTree t1 (makeEnv ["a", "b"] (map int [7, 5]))
in assertEqual "unevalTree" t1 (unevalTree t2)
testExprSymbols :: Test
testExprSymbols =
let e1 = ePlus (eSymbol "x") (eSymbol "y")
e2 = eTimes (ePlus (eSymbol "horse") (eInt 5))
(eMinus (eInt 6)
(eTimes (eSymbol "neck") (eSymbol "tail")))
in assertAll
[
assertEqual "exprSymbols: 0"
(map Symbol ["x", "y", "+"]) (exprSymbols e1),
assertEqual "exprSymbols: 1"
["x", "y"] (exprVarNames e1),
assertEqual "exprSymbols: 2"
(map Symbol ["horse", "+", "neck", "tail", "*", "-"])
(exprSymbols e2),
assertEqual "exprSymbols: 3"
["horse", "neck"]
(exprVarNames e2)
]
testLambda :: Test
testLambda =
let vx = ESymbol (Symbol "x")
vy = ESymbol (Symbol "y")
body = ePlus vx vy
in assertAll
[assertEqual "lambda ()"
(Fail "toLambdaExpr: no arguments; at least one needed")
(toLambdaExpr [] body)
, assertEqual "lambda (x)"
(Succ (ELambda (Symbol "x") body))
(toLambdaExpr ["x"] body)
, assertEqual "lambda (x y)"
(Succ (ELambda (Symbol "x")
(ELambda (Symbol "y") body)))
(toLambdaExpr ["x", "y"] body)
]
testAppCall :: Test
testAppCall =
let callFoo ns = ECall (Symbol "foo") (map eInt ns)
call1 = callFoo [1]
call2 = callFoo [1, 2]
call3 = callFoo [1, 2, 3]
appFoo n = EApp (ESymbol (Symbol "foo")) (eInt n)
app1 = appFoo 1
app2 = EApp app1 (eInt 2)
app3 = EApp app2 (eInt 3)
in assertAll
[assertEqual "call to app 1" app1 (callToApp call1)
, assertEqual "call to app 2" app2 (callToApp call2)
, assertEqual "call to app 3" app3 (callToApp call3)
, assertEqual "app to call 1" call1 (appToCall app1)
, assertEqual "app to call 2" call2 (appToCall app2)
, assertEqual "app to call 3" call3 (appToCall app3)
]
tests :: Test
tests = TestList [TestLabel "repr" testRepr,
TestLabel "env" testEnv,
TestLabel "expr tree" testExprTree,
TestLabel "eval" testEval,
TestLabel "eval tree" testEvalTree,
TestLabel "uneval tree" testUnevalTree,
TestLabel "expr symbols" testExprSymbols,
TestLabel "expr lambda" testLambda,
TestLabel "ECall <-> EApp exprs" testAppCall
]
runU :: IO ()
runU = utestloop tests