Commits

Bryan O'Sullivan  committed dc31c00

Refactor test suit into bytestring and text portions.

  • Participants
  • Parent commits 6fc6fce

Comments (0)

Files changed (4)

File attoparsec.cabal

   type:           exitcode-stdio-1.0
   hs-source-dirs: tests
   main-is:        QC.hs
+  other-modules:  QC.ByteString
+                  QC.Text
 
   ghc-options:
     -Wall -threaded -rtsopts
-{-# LANGUAGE OverloadedStrings #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 module Main (main) where
 
-import Control.Applicative ((<$>))
-import Prelude hiding (takeWhile)
+import qualified QC.ByteString as ByteString
+import qualified QC.Text as Text
 import Test.Framework (defaultMain, testGroup)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.QuickCheck
-import qualified Data.Attoparsec as P
-import qualified Data.ByteString as B
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Lazy as L
-
-instance Arbitrary S.ByteString where
-    arbitrary   = S.pack <$> arbitrary
-
-instance Arbitrary L.ByteString where
-    arbitrary   = sized $ \n -> resize (round (sqrt (toEnum n :: Double)))
-                  ((L.fromChunks . map (S.pack . nonEmpty)) <$> arbitrary)
-      where nonEmpty (NonEmpty a) = a
-
--- Naming.
-
-{-
-label (NonEmpty s) = case parse (anyWord8 <?> s) B.empty of
-                            (_, Left err) -> s `isInfixOf` err
-                            _             -> False
--}
-
--- Basic byte-level combinators.
-
-maybeP p s = case P.parse p s `P.feed` B.empty of
-               P.Done _ i -> Just i
-               _          -> Nothing
-
-defP p s = P.parse p s `P.feed` B.empty
-
-satisfy w s = maybeP (P.satisfy (<=w)) (B.cons w s) == Just w
-
-word8 w s = maybeP (P.word8 w) (B.cons w s) == Just w
-
-anyWord8 s = maybeP P.anyWord8 s == if B.null s
-                                    then Nothing
-                                    else Just (B.head s)
-
-notWord8 w (NonEmpty s) = maybeP (P.notWord8 w) bs == if v == w
-                                                      then Nothing
-                                                      else Just v
-    where v = B.head bs
-          bs = B.pack s
-
-string s = maybeP (P.string s) s == Just s
-
-skipWhile w s =
-    let t = B.dropWhile (<=w) s
-    in case defP (P.skipWhile (<=w)) s of
-         P.Done t' () -> t == t'
-         _            -> False
-
-takeCount (Positive k) s =
-    case maybeP (P.take k) s of
-      Nothing -> k > B.length s
-      Just s' -> k <= B.length s
-
-takeWhile w s =
-    let (h,t) = B.span (==w) s
-    in case defP (P.takeWhile (==w)) s of
-         P.Done t' h' -> t == t' && h == h'
-         _            -> False
-
-takeWhile1 w s =
-    let s'    = B.cons w s
-        (h,t) = B.span (<=w) s'
-    in case defP (P.takeWhile1 (<=w)) s' of
-         P.Done t' h' -> t == t' && h == h'
-         _            -> False
-
-takeTill w s =
-    let (h,t) = B.break (==w) s
-    in case defP (P.takeTill (==w)) s of
-         P.Done t' h' -> t == t' && h == h'
-         _            -> False
-
-takeWhile1_empty = maybeP (P.takeWhile1 undefined) B.empty == Nothing
-
-endOfInput s = maybeP P.endOfInput s == if B.null s
-                                        then Just ()
-                                        else Nothing
 
 main = defaultMain tests
 
 tests = [
-  testGroup "fnord" [
-    testProperty "satisfy" satisfy,
-    testProperty "word8" word8,
-    testProperty "notWord8" notWord8,
-    testProperty "anyWord8" anyWord8,
-    testProperty "string" string,
-    testProperty "skipWhile" skipWhile,
-    testProperty "takeCount" takeCount,
-    testProperty "takeWhile" takeWhile,
-    testProperty "takeWhile1" takeWhile1,
-    testProperty "takeWhile1_empty" takeWhile1_empty,
-    testProperty "takeTill" takeTill,
-    testProperty "endOfInput" endOfInput
-    ]
+    testGroup "bs" ByteString.tests
+  , testGroup "text" Text.tests
   ]

File tests/QC/ByteString.hs

+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module QC.ByteString (tests) where
+
+import Control.Applicative ((<$>))
+import Prelude hiding (takeWhile)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck
+import qualified Data.Attoparsec.ByteString as P
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
+
+instance Arbitrary B.ByteString where
+    arbitrary   = B.pack <$> arbitrary
+
+instance Arbitrary L.ByteString where
+    arbitrary   = sized $ \n -> resize (round (sqrt (toEnum n :: Double)))
+                  ((L.fromChunks . map (B.pack . nonEmpty)) <$> arbitrary)
+      where nonEmpty (NonEmpty a) = a
+
+-- Naming.
+
+{-
+label (NonEmpty s) = case parse (anyWord8 <?> s) B.empty of
+                            (_, Left err) -> s `isInfixOf` err
+                            _             -> False
+-}
+
+-- Basic byte-level combinators.
+
+maybeP p s = case P.parse p s `P.feed` B.empty of
+               P.Done _ i -> Just i
+               _          -> Nothing
+
+defP p s = P.parse p s `P.feed` B.empty
+
+satisfy w s = maybeP (P.satisfy (<=w)) (B.cons w s) == Just w
+
+word8 w s = maybeP (P.word8 w) (B.cons w s) == Just w
+
+anyWord8 s = maybeP P.anyWord8 s == if B.null s
+                                    then Nothing
+                                    else Just (B.head s)
+
+notWord8 w (NonEmpty s) = maybeP (P.notWord8 w) bs == if v == w
+                                                      then Nothing
+                                                      else Just v
+    where v = B.head bs
+          bs = B.pack s
+
+string s = maybeP (P.string s) s == Just s
+
+skipWhile w s =
+    let t = B.dropWhile (<=w) s
+    in case defP (P.skipWhile (<=w)) s of
+         P.Done t' () -> t == t'
+         _            -> False
+
+takeCount (Positive k) s =
+    case maybeP (P.take k) s of
+      Nothing -> k > B.length s
+      Just s' -> k <= B.length s
+
+takeWhile w s =
+    let (h,t) = B.span (==w) s
+    in case defP (P.takeWhile (==w)) s of
+         P.Done t' h' -> t == t' && h == h'
+         _            -> False
+
+takeWhile1 w s =
+    let s'    = B.cons w s
+        (h,t) = B.span (<=w) s'
+    in case defP (P.takeWhile1 (<=w)) s' of
+         P.Done t' h' -> t == t' && h == h'
+         _            -> False
+
+takeTill w s =
+    let (h,t) = B.break (==w) s
+    in case defP (P.takeTill (==w)) s of
+         P.Done t' h' -> t == t' && h == h'
+         _            -> False
+
+takeWhile1_empty = maybeP (P.takeWhile1 undefined) B.empty == Nothing
+
+endOfInput s = maybeP P.endOfInput s == if B.null s
+                                        then Just ()
+                                        else Nothing
+
+tests = [
+    testProperty "satisfy" satisfy,
+    testProperty "word8" word8,
+    testProperty "notWord8" notWord8,
+    testProperty "anyWord8" anyWord8,
+    testProperty "string" string,
+    testProperty "skipWhile" skipWhile,
+    testProperty "takeCount" takeCount,
+    testProperty "takeWhile" takeWhile,
+    testProperty "takeWhile1" takeWhile1,
+    testProperty "takeWhile1_empty" takeWhile1_empty,
+    testProperty "takeTill" takeTill,
+    testProperty "endOfInput" endOfInput
+  ]

File tests/QC/Text.hs

+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module QC.Text (tests) where
+
+import Control.Applicative ((<$>))
+import Prelude hiding (takeWhile)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.QuickCheck
+import qualified Data.Attoparsec.Text as P
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as L
+
+instance Arbitrary T.Text where
+    arbitrary   = T.pack <$> arbitrary
+
+instance Arbitrary L.Text where
+    arbitrary   = sized $ \n -> resize (round (sqrt (toEnum n :: Double)))
+                  ((L.fromChunks . map (T.pack . nonEmpty)) <$> arbitrary)
+      where nonEmpty (NonEmpty a) = a
+
+-- Naming.
+
+{-
+label (NonEmpty s) = case parse (anyWord8 <?> s) B.empty of
+                            (_, Left err) -> s `isInfixOf` err
+                            _             -> False
+-}
+
+-- Basic byte-level combinators.
+
+maybeP p s = case P.parse p s `P.feed` T.empty of
+               P.Done _ i -> Just i
+               _          -> Nothing
+
+defP p s = P.parse p s `P.feed` T.empty
+
+satisfy w s = maybeP (P.satisfy (<=w)) (T.cons w s) == Just w
+
+char c s = maybeP (P.char c) (T.cons c s) == Just c
+
+anyChar s = maybeP P.anyChar s == if T.null s
+                                  then Nothing
+                                  else Just (T.head s)
+
+notChar c (NonEmpty s) = maybeP (P.notChar c) bs == if v == c
+                                                    then Nothing
+                                                    else Just v
+    where v = T.head bs
+          bs = T.pack s
+
+string s = maybeP (P.string s) s == Just s
+
+skipWhile w s =
+    let t = T.dropWhile (<=w) s
+    in case defP (P.skipWhile (<=w)) s of
+         P.Done t' () -> t == t'
+         _            -> False
+
+takeCount (Positive k) s =
+    case maybeP (P.take k) s of
+      Nothing -> k > T.length s
+      Just s' -> k <= T.length s
+
+takeWhile w s =
+    let (h,t) = T.span (==w) s
+    in case defP (P.takeWhile (==w)) s of
+         P.Done t' h' -> t == t' && h == h'
+         _            -> False
+
+takeWhile1 w s =
+    let s'    = T.cons w s
+        (h,t) = T.span (<=w) s'
+    in case defP (P.takeWhile1 (<=w)) s' of
+         P.Done t' h' -> t == t' && h == h'
+         _            -> False
+
+takeTill w s =
+    let (h,t) = T.break (==w) s
+    in case defP (P.takeTill (==w)) s of
+         P.Done t' h' -> t == t' && h == h'
+         _            -> False
+
+takeWhile1_empty = maybeP (P.takeWhile1 undefined) T.empty == Nothing
+
+endOfInput s = maybeP P.endOfInput s == if T.null s
+                                        then Just ()
+                                        else Nothing
+
+tests = [
+    testProperty "satisfy" satisfy,
+    testProperty "char" char,
+    testProperty "notChar" notChar,
+    testProperty "anyChar" anyChar,
+    testProperty "string" string,
+    testProperty "skipWhile" skipWhile,
+    testProperty "takeCount" takeCount,
+    testProperty "takeWhile" takeWhile,
+    testProperty "takeWhile1" takeWhile1,
+    testProperty "takeWhile1_empty" takeWhile1_empty,
+    testProperty "takeTill" takeTill,
+    testProperty "endOfInput" endOfInput
+  ]