mirror of
https://github.com/mrkkrp/megaparsec.git
synced 2024-11-23 19:38:05 +03:00
tests: various improvements and corrections
Some cosmetic whims as well as new tests.
This commit is contained in:
mrkkrp
parent
92d28bb7e8
commit
aa11968514
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
22
tests/Pos.hs
@ -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
109
tests/Prim.hs
@ -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"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user