mrkkrp/megaparsec
1
1
Fork 0
mirror of https://github.com/mrkkrp/megaparsec.git synced 2024-11-23 19:38:05 +03:00
Code Issues Projects Releases Wiki Activity

tests: various improvements and corrections

Browse Source 
Some cosmetic whims as well as new tests.
This commit is contained in:
mrkkrp 2015-10-28 17:51:35 +06:00
parent 92d28bb7e8
commit aa11968514
6 changed files with 112 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
tests/Char.hs
View File

@ -245,9 +245,7 @@ prop_string'_0 a = checkString (string' a) a casei (showToken a)
-- | Randomly change the case in the given string.
fuzzyCase :: String -> Gen String
fuzzyCase s = do
b <- vector (length s)
return $ zipWith f s b
fuzzyCase s = zipWith f s <$> vector (length s)
where f k True = if isLower k then toUpper k else toLower k
f k False = k

28
tests/Error.hs
View File

@ -49,20 +49,20 @@ import Data.Monoid (mempty)
tests :: Test
tests = testGroup "Parse errors"
[ testProperty "monoid left identity" prop_monoid_left_id
, testProperty "monoid right identity" prop_monoid_right_id
, testProperty "monoid associativity" prop_monoid_assoc
, testProperty "extraction of message string" prop_messageString
, testProperty "creation of new error messages" prop_newErrorMessage
[ testProperty "monoid left identity" prop_monoid_left_id
, testProperty "monoid right identity" prop_monoid_right_id
, testProperty "monoid associativity" prop_monoid_assoc
, testProperty "extraction of message string" prop_messageString
, testProperty "creation of new error messages" prop_newErrorMessage
, testProperty "messages are always well-formed" prop_wellFormedMessages
, testProperty "copying of error positions" prop_parseErrorCopy
, testProperty "setting of error position" prop_setErrorPos
, testProperty "addition of error message" prop_addErrorMessage
, testProperty "setting of error message" prop_setErrorMessage
, testProperty "position of merged error" prop_mergeErrorPos
, testProperty "messages of merged error" prop_mergeErrorMsgs
, testProperty "position of error is visible" prop_visiblePos
, testProperty "message components are visible" prop_visibleMsgs ]
, testProperty "copying of error positions" prop_parseErrorCopy
, testProperty "setting of error position" prop_setErrorPos
, testProperty "addition of error message" prop_addErrorMessage
, testProperty "setting of error message" prop_setErrorMessage
, testProperty "position of merged error" prop_mergeErrorPos
, testProperty "messages of merged error" prop_mergeErrorMsgs
, testProperty "position of error is visible" prop_visiblePos
, testProperty "message components are visible" prop_visibleMsgs ]
instance Arbitrary Message where
arbitrary = ($) <$> elements constructors <*> arbitrary
@ -143,7 +143,7 @@ prop_visibleMsgs err = if null msgs
where shown = show err
msgs = errorMessages err
f (Unexpected s) = ["unexpected", s]
f (Expected s) = ["expecting", s]
f (Expected s) = ["expecting", s]
f (Message s) = [s]
-- | @wellFormed xs@ checks that list @xs@ is sorted and contains no

51
tests/Lexer.hs
View File

@ -61,19 +61,21 @@ import Control.Applicative ((<$>), (<*), (<*>))
tests :: Test
tests = testGroup "Lexer"
[ testProperty "space combinator" prop_space
, testProperty "symbol combinator" prop_symbol
, testProperty "symbol' combinator" prop_symbol'
, testProperty "indentGuard combinator" prop_indentGuard
, testProperty "charLiteral" prop_charLiteral
, testProperty "integer" prop_integer
, testProperty "decimal" prop_decimal
, testProperty "hexadecimal" prop_hexadecimal
, testProperty "octal" prop_octal
, testProperty "float 0" prop_float_0
, testProperty "float 1" prop_float_1
, testProperty "number" prop_number
, testProperty "signed" prop_signed ]
[ testProperty "space combinator" prop_space
, testProperty "symbol combinator" prop_symbol
, testProperty "symbol' combinator" prop_symbol'
, testProperty "indentGuard combinator" prop_indentGuard
, testProperty "charLiteral" prop_charLiteral
, testProperty "integer" prop_integer
, testProperty "decimal" prop_decimal
, testProperty "hexadecimal" prop_hexadecimal
, testProperty "octal" prop_octal
, testProperty "float 0" prop_float_0
, testProperty "float 1" prop_float_1
, testProperty "number 0" prop_number_0
, testProperty "number 1" prop_number_1
, testProperty "number 2 (signed)" prop_number_2
, testProperty "signed" prop_signed ]
newtype WhiteSpace = WhiteSpace
{ getWhiteSpace :: String }
@ -203,17 +205,22 @@ prop_float_1 n' = checkParser float r s
, exCh 'e', exSpec "digit" ]
s = maybe "" (show . getNonNegative) n'
prop_number :: Either (NonNegative Integer) (NonNegative Double)
-> Integer -> Property
prop_number n' i = checkParser number r s
where r | null s = posErr 0 s [uneEof, exSpec "number"]
| otherwise =
Right $ case n' of
prop_number_0 :: Either (NonNegative Integer) (NonNegative Double) -> Property
prop_number_0 n' = checkParser number r s
where r = Right $ case n' of
Left x -> Left $ getNonNegative x
Right x -> Right $ getNonNegative x
s = if i < 5
then ""
else either (show . getNonNegative) (show . getNonNegative) n'
s = either (show . getNonNegative) (show . getNonNegative) n'
prop_number_1 :: Property
prop_number_1 = checkParser number r s
where r = posErr 0 s [uneEof, exSpec "number"]
s = ""
prop_number_2 :: Either Integer Double -> Property
prop_number_2 n = checkParser p (Right n) s
where p = signed (hidden C.space) number
s = either show show n
prop_signed :: Integer -> Int -> Bool -> Property
prop_signed n i plus = checkParser p r s

2
tests/Perm.hs
View File

@ -44,7 +44,7 @@ import Util
tests :: Test
tests = testGroup "Permutation phrases parsers"
[ testProperty "permutation parser pure" prop_pure
, testProperty "permutation test 0" prop_perm_0 ]
, testProperty "permutation test 0" prop_perm_0 ]
data CharRows = CharRows
{ getChars :: (Char, Char, Char)

22
tests/Pos.hs
View File

@ -46,18 +46,18 @@ import Control.Applicative ((<$>), (<*>), pure)
tests :: Test
tests = testGroup "Textual source positions"
[ testProperty "components" prop_components
, testProperty "positive coordinates" prop_positive
[ testProperty "components" prop_components
, testProperty "positive coordinates" prop_positive
, testProperty "show file name in source positions" prop_showFileName
, testProperty "show line in source positions" prop_showLine
, testProperty "show column in source positions" prop_showColumn
, testProperty "initial position" prop_initialPos
, testProperty "increment source line" prop_incSourceLine
, testProperty "increment source column" prop_incSourceColumn
, testProperty "set source name" prop_setSourceName
, testProperty "set source line" prop_setSourceLine
, testProperty "set source column" prop_setSourceColumn
, testProperty "position updating" prop_updating ]
, testProperty "show line in source positions" prop_showLine
, testProperty "show column in source positions" prop_showColumn
, testProperty "initial position" prop_initialPos
, testProperty "increment source line" prop_incSourceLine
, testProperty "increment source column" prop_incSourceColumn
, testProperty "set source name" prop_setSourceName
, testProperty "set source line" prop_setSourceLine
, testProperty "set source column" prop_setSourceColumn
, testProperty "position updating" prop_updating ]
instance Arbitrary SourcePos where
arbitrary = newPos <$> fileName <*> choose (-10, 1000) <*> choose (-10, 100)

109
tests/Prim.hs
View File

@ -63,59 +63,59 @@ import Util
tests :: Test
tests = testGroup "Primitive parser combinators"
[ testProperty "ParsecT functor" prop_functor
, testProperty "ParsecT applicative (<*>)" prop_applicative_0
, testProperty "ParsecT applicative (*>)" prop_applicative_1
, testProperty "ParsecT applicative (<*)" prop_applicative_2
[ testProperty "ParsecT functor" prop_functor
, testProperty "ParsecT applicative (<*>)" prop_applicative_0
, testProperty "ParsecT applicative (*>)" prop_applicative_1
, testProperty "ParsecT applicative (<*)" prop_applicative_2
, testProperty "ParsecT alternative empty and (<|>)" prop_alternative_0
, testProperty "ParsecT alternative (<|>)" prop_alternative_1
, testProperty "ParsecT alternative (<|>) pos" prop_alternative_2
, testProperty "ParsecT alternative (<|>) hints" prop_alternative_3
, testProperty "ParsecT alternative many" prop_alternative_4
, testProperty "ParsecT alternative some" prop_alternative_5
, testProperty "ParsecT alternative optional" prop_alternative_6
, testProperty "ParsecT monad return" prop_monad_0
, testProperty "ParsecT monad (>>)" prop_monad_1
, testProperty "ParsecT monad (>>=)" prop_monad_2
, testProperty "ParsecT monad fail" prop_monad_3
, testProperty "ParsecT monad laws: left identity" prop_monad_left_id
, testProperty "ParsecT monad laws: right identity" prop_monad_right_id
, testProperty "ParsecT monad laws: associativity" prop_monad_assoc
, testProperty "ParsecT monad reader ask" prop_monad_reader_ask
, testProperty "ParsecT alternative (<|>)" prop_alternative_1
, testProperty "ParsecT alternative (<|>) pos" prop_alternative_2
, testProperty "ParsecT alternative (<|>) hints" prop_alternative_3
, testProperty "ParsecT alternative many" prop_alternative_4
, testProperty "ParsecT alternative some" prop_alternative_5
, testProperty "ParsecT alternative optional" prop_alternative_6
, testProperty "ParsecT monad return" prop_monad_0
, testProperty "ParsecT monad (>>)" prop_monad_1
, testProperty "ParsecT monad (>>=)" prop_monad_2
, testProperty "ParsecT monad fail" prop_monad_3
, testProperty "ParsecT monad laws: left identity" prop_monad_left_id
, testProperty "ParsecT monad laws: right identity" prop_monad_right_id
, testProperty "ParsecT monad laws: associativity" prop_monad_assoc
, testProperty "ParsecT monad reader ask" prop_monad_reader_ask
, testProperty "ParsecT monad reader local" prop_monad_reader_local
, testProperty "ParsecT monad state get" prop_monad_state_get
, testProperty "ParsecT monad state put" prop_monad_state_put
, testProperty "ParsecT monad cont" prop_monad_cont
, testProperty "ParsecT monad state get" prop_monad_state_get
, testProperty "ParsecT monad state put" prop_monad_state_put
, testProperty "ParsecT monad cont" prop_monad_cont
, testProperty "ParsecT monad error: throw" prop_monad_error_throw
, testProperty "ParsecT monad error: catch" prop_monad_error_catch
, testProperty "combinator unexpected" prop_unexpected
, testProperty "combinator failure" prop_failure
, testProperty "combinator label" prop_label
, testProperty "combinator hidden hints" prop_hidden_0
, testProperty "combinator hidden error" prop_hidden_1
, testProperty "combinator try" prop_try
, testProperty "combinator lookAhead" prop_lookAhead_0
, testProperty "combinator lookAhead hints" prop_lookAhead_1
, testProperty "combinator lookAhead messages" prop_lookAhead_2
, testProperty "combinator notFollowedBy" prop_notFollowedBy_0
, testProperty "combinator unexpected" prop_unexpected
, testProperty "combinator failure" prop_failure
, testProperty "combinator label" prop_label
, testProperty "combinator hidden hints" prop_hidden_0
, testProperty "combinator hidden error" prop_hidden_1
, testProperty "combinator try" prop_try
, testProperty "combinator lookAhead" prop_lookAhead_0
, testProperty "combinator lookAhead hints" prop_lookAhead_1
, testProperty "combinator lookAhead messages" prop_lookAhead_2
, testProperty "combinator notFollowedBy" prop_notFollowedBy_0
, testProperty "combinator notFollowedBy twice" prop_notFollowedBy_1
, testProperty "combinator notFollowedBy eof" prop_notFollowedBy_2
, testProperty "combinator token" prop_token
, testProperty "combinator tokens" prop_tokens
, testProperty "parser state position" prop_state_pos
, testProperty "parser state input" prop_state_input
, testProperty "parser state tab width" prop_state_tab
, testProperty "parser state general" prop_state
, testProperty "custom state parsing" prop_runParser'
, testProperty "custom state parsing (transformer)" prop_runParserT'
, testProperty "IdentityT try" prop_IdentityT_try
, testProperty "IdentityT notFollowedBy" prop_IdentityT_notFollowedBy
, testProperty "ReaderT try" prop_ReaderT_try
, testProperty "ReaderT notFollowedBy" prop_ReaderT_notFollowedBy
, testProperty "combinator notFollowedBy eof" prop_notFollowedBy_2
, testProperty "combinator token" prop_token
, testProperty "combinator tokens" prop_tokens
, testProperty "parser state position" prop_state_pos
, testProperty "parser state input" prop_state_input
, testProperty "parser state tab width" prop_state_tab
, testProperty "parser state general" prop_state
, testProperty "custom state parsing" prop_runParser'
, testProperty "custom state parsing (transformer)" prop_runParserT'
, testProperty "IdentityT try" prop_IdentityT_try
, testProperty "IdentityT notFollowedBy" prop_IdentityT_notFollowedBy
, testProperty "ReaderT try" prop_ReaderT_try
, testProperty "ReaderT notFollowedBy" prop_ReaderT_notFollowedBy
, testProperty "StateT alternative (<|>)" prop_StateT_alternative
, testProperty "StateT lookAhead" prop_StateT_lookAhead
, testProperty "StateT notFollowedBy" prop_StateT_notFollowedBy
, testProperty "WriterT" prop_WriterT ]
, testProperty "StateT lookAhead" prop_StateT_lookAhead
, testProperty "StateT notFollowedBy" prop_StateT_notFollowedBy
, testProperty "WriterT" prop_WriterT ]
instance Arbitrary (State String) where
arbitrary = State <$> arbitrary <*> arbitrary <*> choose (1, 20)
@ -527,16 +527,18 @@ prop_ReaderT_notFollowedBy a' b' c' = checkParser (runReaderT p 'a') r s
-- StateT instance of MonadParsec
prop_StateT_alternative :: Integer -> Property
prop_StateT_alternative n = checkParser (L.evalStateT p 0) (Right n) "" .&&.
checkParser (S.evalStateT p' 0) (Right n) ""
prop_StateT_alternative n =
checkParser (L.evalStateT p 0) (Right n) "" .&&.
checkParser (S.evalStateT p' 0) (Right n) ""
where p = L.put n >> ((L.modify (* 2) >>
void (string "xxx")) <|> return ()) >> L.get
p' = S.put n >> ((S.modify (* 2) >>
void (string "xxx")) <|> return ()) >> S.get
prop_StateT_lookAhead :: Integer -> Property
prop_StateT_lookAhead n = checkParser (L.evalStateT p 0) (Right n) "" .&&.
checkParser (S.evalStateT p' 0) (Right n) ""
prop_StateT_lookAhead n =
checkParser (L.evalStateT p 0) (Right n) "" .&&.
checkParser (S.evalStateT p' 0) (Right n) ""
where p = L.put n >> lookAhead (L.modify (* 2) >> eof) >> L.get
p' = S.put n >> lookAhead (S.modify (* 2) >> eof) >> S.get
@ -556,8 +558,9 @@ prop_StateT_notFollowedBy n = checkParser (L.runStateT p 0) r "abx" .&&.
-- WriterT instance of MonadParsec
prop_WriterT :: String -> String -> Property
prop_WriterT pre post = checkParser (L.runWriterT p) r "abx" .&&.
checkParser (S.runWriterT p') r "abx"
prop_WriterT pre post =
checkParser (L.runWriterT p) r "abx" .&&.
checkParser (S.runWriterT p') r "abx"
where logged_letter = letterChar >>= \x -> L.tell [x] >> return x
logged_letter' = letterChar >>= \x -> L.tell [x] >> return x
logged_eof = eof >> L.tell "EOF"