import TestInfrastructure
import Text.ParserCombinators.Parsec
+import Text.ParserCombinators.Parsec.Error
+{- | Test a parser, forcing it to apply to all input. -}
p parser input =
- case parse parser "(none)" input of
- Left e -> Left (show e)
- Right y -> Right y
+ case parse parseTest "(none)" input of
+ Left _ -> Nothing
+ Right y -> Just y
+ where parseTest = do r <- parser
+ eof
+ return r
prop_quoted :: String -> Result
prop_quoted s =
- p quoted quotedString @?= Right s
- where quotedString = '"' : concatMap quoteChar s ++ "\""
- quoteChar '\\' = "\\\\"
+ p quoted (gen_quoted s) @?= Just s
+
+gen_quoted :: String -> String
+gen_quoted s = '"' : concatMap quoteChar s ++ "\""
+ where quoteChar '\\' = "\\\\"
quoteChar '"' = "\\\""
quoteChar x = [x]
-allt = [q "quoted" prop_quoted
+prop_literal :: String -> Result
+prop_literal s =
+ p literal (gen_literal s) @?= Just s
+
+gen_literal :: String -> String
+gen_literal s =
+ "{" ++ show (length s) ++ "}\r\n" ++ s
+
+gen_string3501 :: String -> Bool -> String
+gen_string3501 s True = gen_quoted s
+gen_string3501 s False = gen_literal s
+
+prop_string3501 :: String -> Bool -> Result
+prop_string3501 s useQuoted = p string3501 (gen_string3501 s useQuoted) @?= Just s
+
+prop_atom :: String -> Result
+prop_atom s =
+ p atom s @?= if isvalid
+ then Just s
+ else Nothing
+ where isvalid = not (null s) && all (`notElem` atomSpecials) s
+
+prop_astring_basic :: String -> Result
+prop_astring_basic s =
+ p astring s @?= if isValidAtom s
+ then Just s
+ else Nothing
+
+isValidAtom s = not (null s) && all isValidChar s
+ where isValidChar c =
+ c `notElem` atomSpecials ||
+ c `elem` respSpecials
+
+prop_astring :: String -> Bool -> Result
+prop_astring s useQuoted =
+ if isValidAtom s
+ then p astring s @=? Just s
+ else p astring (gen_string3501 s useQuoted) @=? Just s
+
+prop_text :: String -> Result
+prop_text s =
+ p text s @=? if isValid
+ then Just s
+ else Nothing
+ where isValid = not (null s) && all (`notElem` crlf) s
+
+prop_tag :: String -> Result
+prop_tag s =
+ p tag s @=? if isValid
+ then Just s
+ else Nothing
+ where isValid = not (null s) && all isValidChar s
+ isValidChar c =
+ c `notElem` ('+' : atomSpecials) ||
+ c `elem` respSpecials
+
+allt = [q "quoted" prop_quoted,
+ q "literal" prop_literal,
+ q "string3501" prop_string3501,
+ q "atom" prop_atom,
+ q "astring basic" prop_astring_basic,
+ q "astring full" prop_astring,
+ q "text" prop_text,
+ q "tag" prop_tag
]
+