mirror of
https://github.com/mrkkrp/megaparsec.git
synced 2024-11-23 19:38:05 +03:00
Improve coverage of older primitives
This commit is contained in:
parent
3baa263eab
commit
1285699b74
@ -144,10 +144,12 @@ test-suite tests
|
||||
, Prim
|
||||
, Util
|
||||
build-depends: base >= 4.6 && < 5
|
||||
, HUnit >= 1.2 && < 1.4
|
||||
, QuickCheck >= 2.4 && < 3
|
||||
, megaparsec >= 4.3
|
||||
, mtl == 2.*
|
||||
, test-framework >= 0.6 && < 1
|
||||
, test-framework-hunit >= 0.3 && < 0.4
|
||||
, test-framework-quickcheck2 >= 0.3 && < 0.4
|
||||
, transformers >= 0.4 && < 0.6
|
||||
default-extensions: CPP
|
||||
|
@ -47,8 +47,10 @@ import qualified Control.Monad.Writer.Lazy as L
|
||||
import qualified Control.Monad.Writer.Strict as S
|
||||
|
||||
import Test.Framework
|
||||
import Test.Framework.Providers.HUnit (testCase)
|
||||
import Test.Framework.Providers.QuickCheck2 (testProperty)
|
||||
import Test.QuickCheck hiding (label)
|
||||
import Test.HUnit (Assertion, (@?=))
|
||||
|
||||
import Text.Megaparsec.Char
|
||||
import Text.Megaparsec.Error
|
||||
@ -96,9 +98,15 @@ tests = testGroup "Primitive parser combinators"
|
||||
, testProperty "combinator lookAhead" prop_lookAhead_0
|
||||
, testProperty "combinator lookAhead hints" prop_lookAhead_1
|
||||
, testProperty "combinator lookAhead messages" prop_lookAhead_2
|
||||
, testCase "combinator lookAhead cerr" case_lookAhead_3
|
||||
, testProperty "combinator notFollowedBy" prop_notFollowedBy_0
|
||||
, testProperty "combinator notFollowedBy twice" prop_notFollowedBy_1
|
||||
, testProperty "combinator notFollowedBy eof" prop_notFollowedBy_2
|
||||
, testCase "combinator notFollowedBy cerr" case_notFollowedBy_3a
|
||||
, testCase "combinator notFollowedBy cerr" case_notFollowedBy_3b
|
||||
, testCase "combinator notFollowedBy eerr" case_notFollowedBy_4a
|
||||
, testCase "combinator notFollowedBy eerr" case_notFollowedBy_4b
|
||||
, testCase "combinator eof return value" case_eof
|
||||
, testProperty "combinator token" prop_token
|
||||
, testProperty "combinator tokens" prop_tokens
|
||||
, testProperty "parser state position" prop_state_pos
|
||||
@ -203,7 +211,7 @@ prop_alternative_6 a b c = checkParser p r s
|
||||
r | c = posErr ab s $ [uneCh 'c', exEof] ++
|
||||
[exCh 'a' | not a && not b] ++ [exCh 'b' | not b]
|
||||
| otherwise = Right s
|
||||
s = abcRow' a b c
|
||||
s = abcRow a b c
|
||||
ab = fromEnum a + fromEnum b
|
||||
|
||||
-- Monad instance
|
||||
@ -363,7 +371,7 @@ prop_lookAhead_0 a b c = checkParser p r s
|
||||
| h == 'b' = posErr 0 s [uneCh 'b', exCh 'a']
|
||||
| h == 'c' = posErr 0 s [uneCh 'c', exSpec "label"]
|
||||
| otherwise = posErr 1 s [uneCh (s !! 1), exEof]
|
||||
s = abcRow' a b c
|
||||
s = abcRow a b c
|
||||
|
||||
prop_lookAhead_1 :: String -> Property
|
||||
prop_lookAhead_1 s = checkParser p r s
|
||||
@ -379,7 +387,13 @@ prop_lookAhead_2 a b c = checkParser p r s
|
||||
r | null s = posErr 0 s [uneEof, exCh 'a']
|
||||
| a = posErr 0 s [uneCh 'a', exCh 'b']
|
||||
| otherwise = posErr 0 s [uneCh (head s), exCh 'a']
|
||||
s = abcRow' a b c
|
||||
s = abcRow a b c
|
||||
|
||||
case_lookAhead_3 :: Assertion
|
||||
case_lookAhead_3 = parse p "" s @?= posErr 1 s [msg emsg]
|
||||
where p = lookAhead (char 'a' *> fail emsg) :: Parser String
|
||||
emsg = "ops!"
|
||||
s = "abc"
|
||||
|
||||
prop_notFollowedBy_0 :: NonNegative Int -> NonNegative Int
|
||||
-> NonNegative Int -> Property
|
||||
@ -410,8 +424,26 @@ prop_notFollowedBy_2 a' b' c' = checkParser p r s
|
||||
| otherwise = posErr a s [uneEof, exCh 'a']
|
||||
s = abcRow a b c
|
||||
|
||||
-- We omit tests for 'eof' here because it's used virtually everywhere, it's
|
||||
-- already thoroughly tested.
|
||||
case_notFollowedBy_3a :: Assertion
|
||||
case_notFollowedBy_3a = parse p "" "ab" @?= Right ()
|
||||
where p = notFollowedBy (char 'a' *> char 'c')
|
||||
|
||||
case_notFollowedBy_3b :: Assertion
|
||||
case_notFollowedBy_3b = parse p "" s @?= posErr 0 s [uneCh 'a', exCh 'c']
|
||||
where p = notFollowedBy (char 'a' *> char 'd') <* char 'c'
|
||||
s = "ab"
|
||||
|
||||
case_notFollowedBy_4a :: Assertion
|
||||
case_notFollowedBy_4a = parse p "" "ab" @?= Right ()
|
||||
where p = notFollowedBy (fail "ops!")
|
||||
|
||||
case_notFollowedBy_4b :: Assertion
|
||||
case_notFollowedBy_4b = parse p "" s @?= posErr 0 s [uneCh 'a', exCh 'c']
|
||||
where p = notFollowedBy (fail "ops!") <* char 'c'
|
||||
s = "ab"
|
||||
|
||||
case_eof :: Assertion
|
||||
case_eof = parse eof "" "" @?= Right ()
|
||||
|
||||
prop_token :: String -> Property
|
||||
prop_token s = checkParser p r s
|
||||
|
@ -34,7 +34,6 @@ module Util
|
||||
, (/=\)
|
||||
, (!=!)
|
||||
, abcRow
|
||||
, abcRow'
|
||||
, posErr
|
||||
, uneCh
|
||||
, uneStr
|
||||
@ -132,15 +131,9 @@ n !=! m = simpleParse n "" === simpleParse m ""
|
||||
-- @a@ times, character “b” repeated @b@ times, and finally character “c”
|
||||
-- repeated @c@ times.
|
||||
|
||||
abcRow :: Int -> Int -> Int -> String
|
||||
abcRow a b c = replicate a 'a' ++ replicate b 'b' ++ replicate c 'c'
|
||||
|
||||
-- | @abcRow' a b c@ generates string that includes character “a” if @a@ is
|
||||
-- 'True', then optionally character “b” if @b@ is 'True', then character
|
||||
-- “c” if @c@ is 'True'.
|
||||
|
||||
abcRow' :: Bool -> Bool -> Bool -> String
|
||||
abcRow' a b c = abcRow (fromEnum a) (fromEnum b) (fromEnum c)
|
||||
abcRow :: Enum a => a -> a -> a -> String
|
||||
abcRow a b c = f a 'a' ++ f b 'b' ++ f c 'c'
|
||||
where f x = replicate (fromEnum x)
|
||||
|
||||
-- | @posErr pos s ms@ is an easy way to model result of parser that
|
||||
-- fails. @pos@ is how many tokens (characters) has been consumed before
|
||||
|
Loading…
Reference in New Issue
Block a user