aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/Main.hs4
-rw-r--r--tests/Properties.hs38
2 files changed, 24 insertions, 18 deletions
diff --git a/tests/Main.hs b/tests/Main.hs
index c4e0d9b..87dedbc 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -1,6 +1,6 @@
1module Main where 1module Main where
2 2
3import Properties 3import Properties (runTests)
4import Test.QuickCheck 4import Test.QuickCheck
5 5
6main = tests 6main = runTests
diff --git a/tests/Properties.hs b/tests/Properties.hs
index e50c7e8..b9550c0 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -1,25 +1,31 @@
1{-# LANGUAGE TemplateHaskell #-} 1{-# LANGUAGE TemplateHaskell #-}
2module Properties where 2module Properties (
3 runTests
4 ) where
3 5
6import Data.Maybe (fromJust)
7import Error.Base (unwrap)
8import Evaluator (eval)
9import Operators (primitives)
4import Parser (Expr (..), parseLispValue, parseQuote) 10import Parser (Expr (..), parseLispValue, parseQuote)
5
6import Test.QuickCheck 11import Test.QuickCheck
7 12
8-- some tests would go here hopefully 13addition = fromJust $ lookup "+" primitives
14multiplication = fromJust $ lookup "*" primitives
9 15
10-- a filler test to test the test suite :^) 16prop_commutativeAdd :: [Integer] -> Property
11qsort :: (Ord a) => [a] -> [a] 17prop_commutativeAdd xs =
12qsort [] = [] 18 not (null xs) ==> rhs == lhs
13qsort [x] = [x] 19 where rhs = (unwrap . addition) exprs
14qsort (x:xs) = qsort left ++ [x] ++ qsort right 20 lhs = (unwrap . addition . reverse) exprs
15 where left = filter (<= x) xs 21 exprs = map IntLiteral xs
16 right = filter (> x) xs
17 22
18checkList :: (Ord a) => [a] -> Bool 23prop_commutativeMul :: [Integer] -> Property
19checkList = ordered . qsort 24prop_commutativeMul xs =
20 where ordered [] = True 25 not (null xs) ==> rhs == lhs
21 ordered [x] = True 26 where rhs = (unwrap . multiplication) exprs
22 ordered (x:y:xs) = x <= y && ordered (y:xs) 27 lhs = (unwrap . multiplication . reverse) exprs
28 exprs = map IntLiteral xs
23 29
24return [] 30return []
25tests = $quickCheckAll 31runTests = $quickCheckAll