Commits

Bryan O'Sullivan committed 59bfa31

Get tests compiling with test-framework-quickcheck2.

Comments (0)

Files changed (2)

 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 Test.QuickCheck hiding (NonEmpty)
+import qualified Data.ByteString as B
 import System.Environment
 import QCSupport
+import Test.Framework (defaultMain, testGroup)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
 
 -- 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
+prop_nonEmptyBS l = B.length (nonEmpty l) > 0
 
 -- Naming.
 
-prop_label (NonEmpty s) = case parse (anyWord8 <?> s) L.empty of
+{-
+prop_label (NonEmpty s) = case parse (anyWord8 <?> s) B.empty of
                             (_, Left err) -> s `isInfixOf` err
                             _             -> False
+-}
 
 -- Basic byte-level combinators.
 
+maybeP p s = case parse p s `feed` B.empty of
+               Done _ i -> Just i
+               _        -> Nothing
+
+defP p s = parse p s `feed` B.empty
+
 prop_word8 (NonEmpty s) = maybeP (word8 w) s == Just w
-    where w = L.head s
+    where w = B.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
+    where v = B.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
+    let (h,t) = B.span (==w) s
+    in case defP (skipWhile (==w)) s of
+         Done t' () -> 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
+    case maybeP (P.take k) s of
+      Nothing -> j > B.length s
+      Just s' -> j <= B.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
+    let (h,t) = B.span (==w) s
+    in case defP (P.takeWhile (==w)) s of
+         Done t' 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
+    let (h,t) = B.span (==w) s
+    in case defP (P.takeWhile1 (==w)) s of
+         Done t' 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
+    let (h,t) = B.break (==w) s
+    in case defP (P.takeTill (==w)) s of
+         Done t' h' -> t == t' && h == h'
+         _          -> False
 
-prop_takeWhile1_empty = maybeP (P.takeWhile1 undefined) L.empty == Nothing
+prop_takeWhile1_empty = maybeP (P.takeWhile1 undefined) B.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 = defaultMain tests
 
-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)
+  testGroup "fnord" [
+    testProperty "nonEmptyList" prop_nonEmptyList,
+    testProperty "nonEmptyBS" prop_nonEmptyBS,
+    testProperty "word8" prop_word8,
+    testProperty "notWord8" prop_notWord8,
+    testProperty "anyWord8" prop_anyWord8,
+    testProperty "string" prop_string,
+    testProperty "skipWhile" prop_skipWhile,
+    testProperty "takeCount" prop_takeCount,
+    testProperty "takeWhile" prop_takeWhile,
+    testProperty "takeWhile1" prop_takeWhile1,
+    testProperty "takeWhile1_empty" prop_takeWhile1_empty,
+    testProperty "takeTill" prop_takeTill
+    ]
   ]

tests/QCSupport.hs

 module QCSupport
     (
       NonEmpty(..)
-    , limCheck
-    , maybeP
     ) where
 
-import Control.Applicative ((<$>))
+import Control.Applicative
 import Data.Attoparsec
 import Data.Word (Word8)
--- import Debug.Trace
 import System.Random (RandomGen, Random(..))
-import Test.QuickCheck
+import Test.QuickCheck hiding (NonEmpty)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 
 
 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
 
 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 = \_ _ -> ""
-                 }