husky-0.1: test/PropertyTest.hs
{-----------------------------------------------------------------
(c) 2008-2009 Markus Dittrich
This program is free software; you can redistribute it
and/or modify it under the terms of the GNU General Public
License Version 3 as published by the Free Software Foundation.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License Version 3 for more details.
You should have received a copy of the GNU General Public
License along with this program; if not, write to the Free
Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.
--------------------------------------------------------------------}
-- | use QuickCheck to test some properties
module Main where
-- import
import Control.Monad.Writer
import System.Exit
-- local imports
import CalculatorParser
import CalculatorState
import PrettyPrint
import TokenParser
-- | top level main routine
-- we use the Writer monad to capture the results for all tests
-- and then examine the results afterward
main :: IO ()
main = do
let simple = execWriter $ test_driver defaultCalcState simpleTests
status1 <- examine_output simple
let failing = execWriter $ test_driver defaultCalcState failingTests
status2 <- examine_output failing
let vars = execWriter $ test_driver defaultCalcState variableTests
status3 <- examine_output vars
let status = status1 && status2 && status3
if status == True then
exitWith ExitSuccess
else
exitWith $ ExitFailure 1
-- | helper function for examining the output of a test run
-- prints out the result for each test, collects the number
-- of successes/failures and returns True in case all tests
-- succeeded and False otherwise
examine_output :: [TestResult] -> IO Bool
examine_output = foldM examine_output_h True
where
examine_output_h :: Bool -> TestResult -> IO Bool
examine_output_h acc (TestResult status token target actual) = do
if status == True then do
putStr $ color_string Blue "["
putStr $ color_string White "OK"
putStr $ color_string Blue "] "
putStr $ color_string Green " Successfully evaluated "
putStrLn $ color_string Yellow token
return $ acc && True
else do
putStr $ color_string Blue "["
putStr $ color_string Red "TROUBLE"
putStr $ color_string Blue "] "
putStr $ color_string Green " Failed to evaluate "
putStrLn $ color_string Yellow token
putStrLn $ color_string Green "\t\texpected : "
++ (convert target)
putStrLn $ color_string Green "\t\tgot : "
++ (convert actual)
return False
where
convert :: Maybe Double -> String
convert x = case x of
Nothing -> "Nothing"
Just a -> show a
-- | main test routine
test_driver :: CalcState -> [TestCase] -> Writer [TestResult] ()
test_driver _ [] = return ()
test_driver state (x:xs) = do
let tok = fst x
let expected = snd x
case runParser calculator state "" tok of
Left er -> tell [TestResult False tok expected Nothing]
Right (result, newState) -> examine_result expected result tok
where
-- NOTE: when we compare target and actual result we
-- probably need to be more careful and can't use ==
-- if we are dealing with Doubles!!!
examine_result :: Maybe Double -> Maybe Double -> String
-> Writer [TestResult] ()
examine_result target actual token =
if target == actual
then do
tell [TestResult True token target actual]
test_driver newState xs
else do
tell [TestResult False token target actual]
test_driver newState xs
-- | our test results consist of a bool indicating success
-- or failure, the test token as well as the expected and
-- received result
data TestResult = TestResult { status :: Bool
, token :: String
, target :: Maybe Double
, actual :: Maybe Double
}
defaultResult :: TestResult
defaultResult = TestResult False "" Nothing Nothing
-- | our test tokens are simple pairs of expressions and
-- their result
type TestCase = (String, Maybe Double)
-- NOTE: For each "run" of test_driver we thread a common
-- calculator state to be able to test variable assignment
-- and use. Therefore, the order of which tests appear in
-- a [TestCase] may matter if variable definitions are involved.
-- I.e., think twice when changing the order, or keep order
-- dependend and independent sets in different lists
simpleTests :: [TestCase]
simpleTests = [ simpleTest1, simpleTest2, simpleTest3, simpleTest4
, simpleTest5, simpleTest6, simpleTest7
, simpleTest8, simpleTest9, simpleTest10, simpleTest11
, simpleTest12, simpleTest13, simpleTest14]
-- list of simple tests
simpleTest1 :: TestCase
simpleTest1 = ("3+4", Just 7.0)
simpleTest2 :: TestCase
simpleTest2 = ("3*3", Just 9.0)
simpleTest3 :: TestCase
simpleTest3 = ("(3*3)+(3*4)", Just 21.0)
simpleTest4 :: TestCase
simpleTest4 = ("(3.0*3.0)+(3.0*4.0)", Just 21.0)
simpleTest5 :: TestCase
simpleTest5 = ("(3+3)*(9+8)", Just 102.0)
simpleTest6 :: TestCase
simpleTest6 = ("(3.0+3.0)*(9.0+8.0)", Just 102.0)
simpleTest7 :: TestCase
simpleTest7 = ("(((((((3.0+3.0)*(9.0+8.0)))))))", Just 102.0)
simpleTest8 :: TestCase
simpleTest8 = ("(((((((3.0+3.0)))))*(((((9.0+8.0)))))))", Just 102.0)
simpleTest9 :: TestCase
simpleTest9 = ("3+3*99.0", Just 300.0)
simpleTest10 :: TestCase
simpleTest10 = ("3+3*8+4*3*2+1*4*3+5", Just 68.0)
simpleTest11 :: TestCase
simpleTest11 = ("(3+3)*(8+4)*3*(2+1)*4*(3+5)", Just 20736.0)
simpleTest12 :: TestCase
simpleTest12 = (" 3 +3* 99.0", Just 300.0)
simpleTest13 :: TestCase
simpleTest13 = (" 3 + 3*8+4 *3 *2+1* 4*3+5 ", Just 68.0)
simpleTest14 :: TestCase
simpleTest14 = ("(3+3) *(8+4)*3 * (2+1 )*4*( 3+5)", Just 20736.0)
-- a few tests that are failing
failingTests :: [TestCase]
failingTests = [ failingTest1, failingTest2, failingTest3
, failingTest4, failingTest5, failingTest6
, failingTest7, failingTest8, failingTest9
, failingTest10, failingTest11, failingTest12 ]
-- list of failing tests
failingTest1 :: TestCase
failingTest1 = ("3+4b", Nothing)
failingTest2 :: TestCase
failingTest2 = ("3*a3", Nothing)
failingTest3 :: TestCase
failingTest3 = ("(3*3)B+(3*4)", Nothing)
failingTest4 :: TestCase
failingTest4 = ("(3.0*3.0)+3.0*4.0)", Nothing)
failingTest5 :: TestCase
failingTest5 = ("(3y3)*(9+8)", Nothing)
failingTest6 :: TestCase
failingTest6 = ("(3.0+3.0)*(9.0+8.0", Nothing)
failingTest7 :: TestCase
failingTest7 = ("(((((((3.0+3.0)*(9.0+8.0))))))", Nothing)
failingTest8 :: TestCase
failingTest8 = ("(((((((3.0+3.0))))*((((((9.0+8.0)))))))", Nothing)
failingTest9 :: TestCase
failingTest9 = ("a3+3*99.0", Nothing)
failingTest10 :: TestCase
failingTest10 = ("3+3*8+4*3++2+1*4*3+5", Nothing)
failingTest11 :: TestCase
failingTest11 = ("(3+3)**(8+4)*3*(2+1)*4*(3+5)", Nothing)
failingTest12 :: TestCase
failingTest12 = ("b", Nothing)
-- a few tests involving variables
variableTests :: [TestCase]
variableTests = [ variableTest1, variableTest2, variableTest3
, variableTest4, variableTest5, variableTest6
, variableTest7, variableTest8, variableTest9 ]
{- , variableTest10, variableTest11, variableTest12 ] -}
-- list of failing tests
variableTest1 :: TestCase
variableTest1 = ("b = 4", Just 4)
variableTest2 :: TestCase
variableTest2 = ("3 * b ", Just 12)
variableTest3 :: TestCase
variableTest3 = ("(b*b)", Just 16)
variableTest4 :: TestCase
variableTest4 = ("a = 12", Just 12)
variableTest5 :: TestCase
variableTest5 = ("a * b", Just 48)
variableTest6 :: TestCase
variableTest6 = ("a - b * b", Just (-4))
variableTest7 :: TestCase
variableTest7 = ("3 * b - a", Just 0)
variableTest8 :: TestCase
variableTest8 = ("kjhdskfsd123hjksdf = a * b", Just 48)
variableTest9 :: TestCase
variableTest9 = ("(a*b) - kjhdskfsd123hjksdf", Just 0)
variableTest10 :: TestCase
variableTest10 = ("c = 2", Nothing)
variableTest11 :: TestCase
variableTest11 = ("a-b-c + ( a + b + c ) + (a*a)", Just 168)
variableTest12 :: TestCase
variableTest12 = ("b^a - c", Just 16777214)