From 1285699b74bb5d1f45860ae2a1db2339da184b64 Mon Sep 17 00:00:00 2001 From: mrkkrp Date: Thu, 18 Feb 2016 00:12:27 +0600 Subject: [PATCH] Improve coverage of older primitives --- megaparsec.cabal | 2 ++ tests/Prim.hs | 42 +++++++++++++++++++++++++++++++++++++----- tests/Util.hs | 13 +++---------- 3 files changed, 42 insertions(+), 15 deletions(-) diff --git a/megaparsec.cabal b/megaparsec.cabal index f2f8921..821fdaf 100644 --- a/megaparsec.cabal +++ b/megaparsec.cabal @@ -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 diff --git a/tests/Prim.hs b/tests/Prim.hs index 7ab6cd6..8c50360 100644 --- a/tests/Prim.hs +++ b/tests/Prim.hs @@ -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 diff --git a/tests/Util.hs b/tests/Util.hs index 5e99593..3f89328 100644 --- a/tests/Util.hs +++ b/tests/Util.hs @@ -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