Commits

Bryan O'Sullivan committed f1bb65c Merge

Merge

Comments (0)

Files changed (6)

File contents unchanged.

Data/Attoparsec.hs

     , I.string
     , I.skipWhile
     , I.stringTransform
+    , I.take
     , I.takeTill
     , I.takeWhile
     , I.takeWhile1
-tests: TestFastSet.out
+all: TestFastSet.out QC.out
 
-%.out: %.hs
-	runghc $< > $<.tmp
+%.out: %.exe
+	./$< | tee $<.tmp
 	mv $<.tmp $@
+
+%.exe: %.hs
+	ghc -O -fno-warn-orphans --make -o $@ $<
+
+clean:
+	-rm -f *.hi *.o *.exe *.out
+module Main (main) where
+
+import Control.Applicative
+import Data.Attoparsec as P
+import Data.List (isInfixOf)
+import Data.Maybe (isJust)
+import Data.Word (Word8)
+import Control.Monad (forM_)
+import Debug.Trace
+import System.IO
+import Test.QuickCheck
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+import System.Environment
+import QCSupport
+
+-- Make sure that structures whose types claim they are non-empty
+-- really are.
+
+prop_nonEmptyList l = length (nonEmpty l) > 0
+    where types = l :: NonEmpty [Int]
+prop_nonEmptyBS l = S.length (nonEmpty l) > 0
+prop_nonEmptyLBS l = L.length (nonEmpty l) > 0
+
+-- Naming.
+
+prop_label (NonEmpty s) = case parse (anyWord8 <?> s) L.empty of
+                            (_, Left err) -> s `isInfixOf` err
+                            _             -> False
+
+-- Basic byte-level combinators.
+
+prop_word8 (NonEmpty s) = maybeP (word8 w) s == Just w
+    where w = L.head s
+
+prop_anyWord8 (NonEmpty s) = isJust $ maybeP anyWord8 s
+
+prop_notWord8 (w, NonEmpty s) = v /= w ==> maybeP (notWord8 w) s == Just v
+    where v = L.head s
+
+prop_string s = maybeP (string s) s == Just s
+
+prop_skipWhile (w,s) =
+    let (h,t) = L.span (==w) s
+    in case parse (skipWhile (==w)) s of
+         (t',Right ()) -> t == t'
+         _ -> False
+
+prop_takeCount (k,s) =
+    k >= 0 ==>
+    case maybeP (takeCount k) s of
+      Nothing -> j > L.length s
+      Just s' -> j <= L.length s
+  where j = fromIntegral k
+
+prop_takeWhile (w,s) =
+    let (h,t) = L.span (==w) s
+    in case parse (P.takeWhile (==w)) s of
+         (t',Right h') -> t == t' && h == h'
+         _ -> False
+
+prop_takeWhile1 (w, NonEmpty s) =
+    let (h,t) = L.span (==w) s
+    in case parse (P.takeWhile (==w)) s of
+         (t',Right h') -> t == t' && h == h'
+         _ -> False
+
+prop_takeTill (w, s) =
+    let (h,t) = L.break (==w) s
+    in case parse (P.takeTill (==w)) s of
+         (t',Right h') -> t == t' && h == h'
+         _ -> False
+
+prop_takeWhile1_empty = maybeP (P.takeWhile1 undefined) L.empty == Nothing
+
+prop_notEmpty_string s = case maybeP (notEmpty (string s)) s of
+                           Nothing -> L.null s
+                           Just s' -> not (L.null s) && s == s'
+
+main :: IO ()
+main = do
+  args <- getArgs
+  let n = case args of
+            []  -> 500
+            [k] -> read k
+            _   -> error "too many arguments"
+  forM_ tests $ \(name,prop) -> do
+      putStr name
+      putStr (replicate (40 - length name) ' ')
+      hFlush stdout
+      prop n
+
+p :: Testable a => a -> Int -> IO ()
+p prop count = limCheck count prop
+
+tests :: [(String, Int -> IO ())]
+tests = [
+  ("nonEmptyList", p prop_nonEmptyList),
+  ("nonEmptyBS", p prop_nonEmptyBS),
+  ("nonEmptyLBS", p prop_nonEmptyLBS),
+  ("word8", p prop_word8),
+  ("notWord8", p prop_notWord8),
+  ("anyWord8", p prop_anyWord8),
+  ("string", p prop_string),
+  ("skipWhile", p prop_skipWhile),
+  ("takeCount", p prop_takeCount),
+  ("takeWhile", p prop_takeWhile),
+  ("takeWhile1", p prop_takeWhile1),
+  ("takeWhile1_empty", p prop_takeWhile1_empty),
+  ("takeTill", p prop_takeTill),
+  ("notEmpty_string", p prop_notEmpty_string)
+  ]

tests/QCSupport.hs

+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
+module QCSupport
+    (
+      NonEmpty(..)
+    , limCheck
+    , maybeP
+    ) where
+
+import Control.Applicative ((<$>))
+import Data.Attoparsec
+import Data.Word (Word8)
+-- import Debug.Trace
+import System.Random (RandomGen, Random(..))
+import Test.QuickCheck
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+
+integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
+integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
+                                        fromIntegral b :: Integer) g of
+                            (x,g') -> (fromIntegral x, g')
+
+newtype NonEmpty a = NonEmpty { nonEmpty :: a }
+    deriving (Eq, Ord, Read, Show)
+
+instance Functor NonEmpty where
+    fmap f (NonEmpty a) = NonEmpty (f a)
+
+instance Applicative NonEmpty where
+    NonEmpty f <*> NonEmpty a = NonEmpty (f a)
+    pure a                    = NonEmpty a
+
+instance Arbitrary a => Arbitrary (NonEmpty [a]) where
+    arbitrary   = NonEmpty <$> sized (\n -> choose (1,n+1) >>= vector)
+    coarbitrary = coarbitrary . nonEmpty
+
+instance Arbitrary S.ByteString where
+    arbitrary   = S.pack <$> arbitrary
+    coarbitrary = coarbitrary . S.unpack
+
+instance Arbitrary (NonEmpty S.ByteString) where
+    arbitrary   = fmap S.pack <$> arbitrary
+    coarbitrary = coarbitrary . S.unpack . nonEmpty
+
+instance Arbitrary L.ByteString where
+    arbitrary   = sized $ \n -> resize (round (sqrt (toEnum n :: Double)))
+                  ((L.fromChunks . map nonEmpty) <$> arbitrary)
+    coarbitrary = coarbitrary . L.unpack
+
+instance Arbitrary (NonEmpty L.ByteString) where
+    arbitrary   = sized $ \n -> resize (round (sqrt (toEnum n :: Double)))
+                  (fmap (L.fromChunks . map nonEmpty) <$> arbitrary)
+    coarbitrary = coarbitrary . L.unpack . nonEmpty
+
+instance Random Word8 where
+    randomR = integralRandomR
+    random  = randomR (minBound,maxBound)
+
+instance Arbitrary Word8 where
+    arbitrary     = choose (minBound, maxBound)
+    coarbitrary _ = variant 0
+
+instance Arbitrary Char where
+    arbitrary     = choose (minBound, maxBound)
+    coarbitrary _ = variant 0
+
+maybeP :: Parser a -> L.ByteString -> Maybe a
+maybeP p s = case parse p s of
+               (_, Left _err) -> Nothing
+               (_, Right a)   -> Just a
+
+limCheck :: Testable a => Int -> a -> IO ()
+limCheck limit = check defaultConfig {
+                   configMaxTest = limit
+                 , configEvery = \_ _ -> ""
+                 }

tests/TestFastSet.hs

-module TestFastSet where
+module Main (main) where
 
 import Data.Word (Word8)
-import qualified Data.ParserCombinators.Attoparsec.FastSet as F
+import qualified Data.Attoparsec.FastSet as F
 import System.Random (Random(..), RandomGen)
 import Test.QuickCheck