-- | Testing for Language.Sifflet.Export.ToScheme module Testing.Unit.ToSchemeTests (tests, runU, testExpr, testExampleDef, ted , t6, mt0, mt1, mt2, t7, t8 , test', testf') where import Test.HUnit import Data.Number.Sifflet import Language.Sifflet.Export.ToScheme import Language.Sifflet.Expr import Language.Sifflet.Examples import Text.Sifflet.Repr import Text.Sifflet.Pretty import Testing.TestUtil (utestloop) -- | Test expr labels labels :: [String] labels = ["undefined", "symbol foo", "False", "True", "char c", "if True then 7 else 88", "nested list"] -- | Test expressions exprs :: [Expr] exprs = [EUndefined , ESymbol (Symbol "foo") , EBool False , EBool True , EChar 'c' , EIf (EBool True) (ENumber (Exact 7)) (ENumber (Exact 88)) , EList [EBool True, EChar 'x', ENumber (Exact 35), ENumber (Inexact 4.6), EString "cozy", EList [], EList [EBool False, EChar 'y', EString "", EList []]] ] -- | Corresponding S-expressions sexprs :: [SExpr] sexprs = [SAtom (SSymbol "*sifflet-undefined*") , SAtom (SSymbol "foo") , SAtom (SBool False) , SAtom (SBool True) , SAtom (SChar 'c') , SList [SAtom (SSymbol "if"), SAtom (SBool True), SAtom (SInt 7), SAtom (SInt 88)] , SList [SAtom (SSymbol "list"), SAtom (SBool True), SAtom (SChar 'x'), SAtom (SInt 35), SAtom (SFloat 4.6), SAtom (SString "cozy"), SList [SAtom (SSymbol "list")], SList [SAtom (SSymbol "list"), SAtom (SBool False), SAtom (SChar 'y'), SAtom (SString ""), SList [SAtom (SSymbol "list")]]] ] -- | Corresponding repr strings reprStrings :: [String] reprStrings = ["*sifflet-undefined*" , "foo" , "#f" , "#t" , "'c'" , "(if #t 7 88)" , "(list #t 'x' 35 4.6 \"cozy\" (list) (list #f 'y' \"\" (list)))" ] -- | Corresponding pretty strings pretties :: [String] pretties = ["*sifflet-undefined*" , "foo" , "#f" , "#t" , "'c'" , "(if #t 7 88)" , concat [ "(list #t" , "\n 'x'" , "\n 35" , "\n 4.6" , "\n \"cozy\"" , "\n (list)" , "\n (list #f" , "\n 'y'" , "\n \"\"" , "\n (list)))" ] ] moreLabels :: [String] moreLabels = ["empty list" , "flat list" , "nested list" , "if expr" , "list expression with evaluation" , "list expression without evaluation" ] eint :: Integer -> Expr eint n = ENumber (Exact n) moreExprs :: [Expr] moreExprs = [EList [] , EList [eint 1 , EBool False , EString "thunder"] , EList [EList [eint 1, eint 2] , EList [eint 3, eint 4, eint 5] , EList [] , EList [eint 6, eint 7]] , let sa = ESymbol (Symbol "a") sb = ESymbol (Symbol "b") in EIf (ECall (Symbol ">") [sa, sb]) (ECall (Symbol "+") [sa, eint 5]) (ECall (Symbol "-") [sb, eint 20]) , EList [ENumber (Exact 6), ENumber (Exact 7)] ] morePretties :: [String] morePretties = ["(list)" , "(list 1 #f \"thunder\")" , concat [ "(list (list 1 2)" , "\n (list 3 4 5)" , "\n (list)" , "\n (list 6 7))" ] , concat [ "(if (> a b)" , "\n (+ a 5)" , "\n (- b 20))" ] , "(list 6 7)" ] sexprTests :: [Test] sexprTests = map (makeTestCase "exprToSExpr" exprToSExpr) (zip3 exprs sexprs labels) reprTests :: [Test] reprTests = map (makeTestCase "exprToSchemeRepr" exprToSchemeRepr) (zip3 exprs reprStrings labels) prettyTests :: [Test] prettyTests = map (makeTestCase "exprToSchemePretty" exprToSchemePretty) (zip3 exprs pretties labels) morePrettyTests :: [Test] morePrettyTests = map (makeTestCase "exprToSchemePretty" exprToSchemePretty) (zip3 moreExprs morePretties moreLabels) makeTestCase :: (Eq a, Show a) => String -> (Expr -> a) -> (Expr, a, String) -> Test makeTestCase fname f (expr, result, label) = TestCase (assertEqual (fname ++ " " ++ label) result (f expr)) -- | Test for function definition makeDefTest :: SchemeOptions -> (String, String) -> Test makeDefTest options (name, result) = let f = envGetFunction exampleEnv name sdef = defToSExpr options (functionToDef f) in TestCase (assertEqual ("define " ++ name) result (pretty sdef)) -- Tests of function definition using lambda expressions defTests1 :: [Test] defTests1 = map (makeDefTest (SchemeOptions {defineWithLambda = True})) (zip defTestNames1 defTestResults1) defTestNames1 :: [String] defTestNames1 = ["bonus2"] defTestResults1 :: [String] defTestResults1 = [concat [ "(define bonus2" , "\n (lambda (salesA salesB)" , "\n (bonus1 (grossProfit salesA salesB))))"]] -- | Tests of function definition with default Scheme options (no lambda) defTests2 :: [Test] defTests2 = map (makeDefTest (SchemeOptions {defineWithLambda = False})) (zip defTestNames2 defTestResults2) defTestNames2 :: [String] defTestNames2 = ["grossProfit" , "fact" , "rmul" , "fib1" , "length" ] defTestResults2 :: [String] defTestResults2 = [concat ["(define (grossProfit salesA salesB)" , "\n (+ (* 0.12 salesA)" , "\n (* 0.25 salesB)))" ] , concat ["(define (fact n)" , "\n (if (zero? n)" , "\n 1" , "\n (* n" , "\n (fact (sifflet-sub1 n)))))" ] , concat ["(define (rmul m n)" , "\n (if (zero? n)" , "\n 0" , "\n (+ m" , "\n (rmul m" , "\n (sifflet-sub1 n)))))" ] , concat ["(define (fib1 n)" , "\n (if (equal? n 1)" , "\n 1" , "\n (if (equal? n 2)" , "\n 1" , "\n (+ (fib1 (- n 2))" , "\n (fib1 (- n 1))))))" ] , concat ["(define (length xs)" , "\n (if (null? xs)" , "\n 0" , "\n (+ 1" , "\n (length (cdr xs)))))" ] ] tests :: Test tests = TestList $ concat [sexprTests , reprTests , prettyTests , morePrettyTests , defTests1 , defTests2 ] runU :: IO () runU = utestloop tests putLabeledString :: String -> String -> IO () putLabeledString label string = putStrLn (label ++ ": " ++ string) testExpr :: Expr -> IO () testExpr expr = let pls = putLabeledString in pls "Expr" (show expr) >> pls "SExpr" (show (exprToSExpr expr)) >> pls "Repr" (exprToSchemeRepr expr) >> pls "Pretty" ("\n" ++ exprToSchemePretty expr) testExampleDef :: String -> IO () testExampleDef name = let f = envGetFunction exampleEnv name def = functionToDef f sdef = defToSExpr defaultSchemeOptions def pls = putLabeledString plss label thing = pls label (show thing) in pls "Name" name >> plss "Value" f >> -- ??? plss "SExpr" sdef >> pls "Repr" (repr sdef) >> pls "Pretty" ("\n" ++ pretty sdef) ted :: String -> IO () ted = testExampleDef t6, mt0, mt1, mt2 :: IO () t6 = testExpr (exprs !! 6) mt0 = testExpr (moreExprs !! 0) mt1 = testExpr (moreExprs !! 1) mt2 = testExpr (moreExprs !! 2) e7 :: Expr e7 = EList [EList [eint 1, eint 2] , EList [EList [eint 3 , EList [eint 4, eint 5] , EList [] , EList [eint 6 , EList [eint 7, eint 8] , eint 9 ] , eint 10 ] , EList [eint 11, eint 12, eint 13 , EList [eint 14, eint 15] ] ] ] t7 :: IO () t7 = testExpr e7 e8 :: Expr e8 = let sym name = ESymbol (Symbol name) in EList [sym "cat" , EList [sym "dog", sym "mouse"] , EList [sym "broccoli" , EList [sym "potatoes" , sym "catsup" , sym "mustard" ] ] ] t8 :: IO () t8 = testExpr e8 test' :: Expr -> IO () test' expr = let pls = putLabeledString sexpr = exprToSExpr expr in pls "Expr" (show expr) >> pls "SExpr" (show sexpr) >> pls "Repr" (repr sexpr) >> pls "Pretty" ("\n" ++ pretty sexpr) testf' :: String -> IO () testf' name = let f = envGetFunction exampleEnv name def = functionToDef f sdef = defToSExpr defaultSchemeOptions def pls = putLabeledString plss label thing = pls label (show thing) in pls "Name" name >> plss "Value" f >> -- ??? plss "SExpr" sdef >> pls "Repr" (repr sdef) >> pls "Pretty" ("\n" ++ pretty sdef)