packages feed

sifflet-2.3.0: tests/Testing/Unit/ParserTests.hs

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