module Testing.Unit.ParserTests (int, float, runU, tests) where import Text.ParserCombinators.Parsec import Test.HUnit import Data.Number.Sifflet import Language.Sifflet.Expr import Language.Sifflet.Parser import Language.Sifflet.Util (SuccFail(..)) import Testing.TestUtil (assertAll, utestloop) int :: Integer -> Value int = VNumber . Exact float :: Double -> Value float = VNumber . Inexact -- Tests for the parser testParseExpr :: Test testParseExpr = assertAll [assertEqual "parseExpr: int" (Succ (eInt 1)) (parseExpr "1"), assertEqual "parseExpr: float" (Succ (eFloat 12.5)) (parseExpr "12.5"), assertEqual "parseExpr: char" (Succ (eChar 'c')) (parseExpr "'c'"), assertEqual "parseExpr: string" (Succ (eString "five ducks")) (parseExpr "\"five ducks\""), -- parser does not recognize symbols; should it? -- assertEqual "parseExpr: symbol" (Succ (eSymbol "henry_viii")) -- (parseExpr "henry_viii"), assertEqual "parseExpr: list of int" (Succ (EList [eInt 1, eInt 6, eInt 33])) (parseExpr "[1, 6, 33]"), assertEqual "parseExpr: list of mixed type" (Succ (EList [eInt 15, eString "horses", eChar 'y', eFloat 6.2])) (parseExpr "[15, \"horses\", 'y', 6.2]"), assertEqual "parseExpr: bool" (Succ eFalse) (parseExpr "False"), assertEqual "parseExpr: input error 1" -- an unterminated list (Fail "\"user input\" (line 1, column 22):\nunexpected end of input\nexpecting space, \",\" or \"]\"") (parseExpr "[1, \"horse\", 'y', 12."), assertEqual "parseExpr: input error 2" (Fail "\"user input\" (line 1, column 2):\nunexpected 'f'\nexpecting digit, space or end of input") (parseTypedInput2 ("7figs", typeNum))] testExprToValue :: Test testExprToValue = assertAll [assertEqual "exprToValue: int" (Succ (int 1)) (exprToValue (eInt 1)), assertEqual "exprToValue: float" (Succ (float 12.5)) (exprToValue (eFloat 12.5)), assertEqual "exprToValue: string" (Succ (VString "cow")) (exprToValue (eString "cow")), assertEqual "exprToValue: if" (Succ (int 7)) (exprToValue (eIf eTrue (eInt 7) (eInt 11))), assertEqual "exprToValue: call" (Succ (int 18)) (exprToValue (ePlus (eInt 7) (eInt 11)))] testStringToValue :: Test testStringToValue = assertAll [assertEqual "parseValue: int" (Succ (int 8)) (parseValue "8"), assertEqual "parseValue: float" (Succ (float (-1.5))) (parseValue "-1.5"), assertEqual "parseValue: string" (Succ (VString "patty cake")) (parseValue "\"patty cake\""), assertEqual "parseValue: list of mixed type" (Succ (VList [int 12, float 1.7, VString "harry", VList []])) (parseValue "[12, 1.7, \"harry\", []]"), assertEqual "parseValue: bool" (Succ (VBool True)) (parseValue "True"), assertEqual "parseValue: incomplete list" (Fail ("\"user input\" (line 1, column 8):\n" ++ "unexpected end of input\n" ++ "expecting space, boolean, character, " ++ "string, real number, integer or list")) (parseValue "[1, 2, ") ] -- BEGIN NEW TESTS data ParseResult = PE {peColumn :: Column, peUnexpected :: String, peExpecting :: String} | PV Value deriving (Eq, Show) dquote :: String -> String dquote s = "\"" ++ s ++ "\"" squote :: Char -> String squote c = ['\'', c, '\''] parseResult :: Parser Value -> String -> ParseResult parseResult p s = case parse p "test input" s of Left err -> let pos = errorPos err col = sourceColumn pos msgLines = tail (lines (show err)) theUnexpected = unwords (tail (words (msgLines !! 0))) expecting = unwords (tail (words (msgLines !! 1))) in PE {peColumn = col, peUnexpected = theUnexpected, peExpecting = expecting} Right v -> PV v parseAssert :: Type -> String -> ParseResult -> Assertion parseAssert t s expectedResult = let description = "parse " ++ s ++ " as " ++ show t ++ (case expectedResult of PV _ -> "succeeds" _ -> "fails") in assertEqual description expectedResult (parseResult (nothingBut (typedValue t)) s) testBool :: Test testBool = assertAll [parseAssert typeBool "True" (PV (VBool True)) , parseAssert typeBool "False" (PV (VBool False)) , parseAssert typeBool "123" (PE 1 (dquote "1") "space or boolean") , parseAssert typeBool "Truex" (PE 5 (squote 'x') "space or end of input") , parseAssert typeBool "Truck" (PE 1 (dquote "T") "space or boolean") ] testChar :: Test testChar = let close = "closing single quote" in assertAll [parseAssert typeChar "'c'" (PV (VChar 'c')) , parseAssert typeChar "'\\\\'" (PV (VChar '\\')) , parseAssert typeChar "'\\n'" (PV (VChar '\n')) , parseAssert typeChar "'\\r'" (PV (VChar '\r')) , parseAssert typeChar "'\\t'" (PV (VChar '\t')) , parseAssert typeChar "'cd'" (PE 3 (dquote "d") close) , parseAssert typeChar "'\\x'" (PE 3 (dquote "x") close) , parseAssert typeChar "\"\"\"" (PE 1 "\"\\\"\"" "space or character") -- ?? ] testString :: Test testString = assertAll [parseAssert typeString (dquote "abc") (PV (VString "abc")) , parseAssert typeString (dquote "1 2 3 4") (PV (VString "1 2 3 4")) , parseAssert typeString "\"1 2 3" (PE 7 "end of input" "close of quotation") , parseAssert typeString "1 2 3\"" (PE 1 (dquote "1") "space or string") ] testNum :: Test testNum = assertAll [parseAssert typeNum "12" (PV (int 12)) , parseAssert typeNum "+155" (PV (int 155)) , parseAssert typeNum "-279" (PV (int (-279))) , parseAssert typeNum "-000279" (PV (int (-279))) , parseAssert typeNum "000279" (PV (int 279)) , parseAssert typeNum "+000279" (PV (int 279)) , parseAssert typeNum "0" (PV (int 0)) , parseAssert typeNum "-0" (PV (int 0)) , parseAssert typeNum "0.0" (PV (float 0.0)) , parseAssert typeNum "0." (PV (float 0.0)) , parseAssert typeNum ".0" (PV (float 0.0)) , parseAssert typeNum "-.0" (PV (float 0.0)) , parseAssert typeNum "+.0" (PV (float 0.0)) , parseAssert typeNum "12.5" (PV (float 12.5)) , parseAssert typeNum "+12.5" (PV (float 12.5)) , parseAssert typeNum "-12.5" (PV (float (-12.5))) , parseAssert typeNum "1.25e2" (PV (float 125.0)) , parseAssert typeNum "1.25e+2" (PV (float 125.0)) , parseAssert typeNum "1.25e-3" (PV (float 0.00125)) , parseAssert typeNum "-7.25e-3" (PV (float (-0.00725))) , parseAssert typeNum "00.0625" (PV (float 0.0625)) , parseAssert typeNum "++987" (PE 2 (dquote "+") "digit") , parseAssert typeNum "'987'" (PE 1 (dquote "'") "space or number") , parseAssert typeNum "x987" (PE 1 (dquote "x") "space or number") , parseAssert typeNum "987x" (PE 4 (squote 'x') "digit, space or end of input") , parseAssert typeNum "9.87.9" (PE 5 (squote '.') "digit, space or end of input") , parseAssert typeNum "9 87.9" (PE 3 (squote '8') "space or end of input") ] testList :: Test testList = assertAll [parseAssert (typeList typeNum) "[1,3,5]" (PV (VList [int 1, int 3, int 5])) , parseAssert (typeList typeNum) "[]" (PV (VList [])) , parseAssert (typeList typeBool) "[]" (PV (VList [])) , parseAssert (typeList typeChar) " [ 'c', 'a', 't' ] " (PV (VList [VChar 'c', VChar 'a', VChar 't'])) , parseAssert (typeList typeBool) "[1, 2, 3]" (PE 2 (dquote "1") "space, boolean or \"]\"") , parseAssert (typeList typeNum) "[12 , 34 56]" (PE 10 (dquote "5") "space or \"]\"") ] tests :: Test tests = TestList [TestLabel "parse expr" testParseExpr, TestLabel "expr to value" testExprToValue, TestLabel "string to value" testStringToValue, TestLabel "parse bool" testBool, TestLabel "parse char" testChar, TestLabel "parse string" testString, TestLabel "parse num" testNum, TestLabel "parse list" testList] runU :: IO () runU = utestloop tests