diff options
Diffstat (limited to 'testsuite/tests/lib/Data.ByteString')
16 files changed, 5183 insertions, 0 deletions
diff --git a/testsuite/tests/lib/Data.ByteString/Makefile b/testsuite/tests/lib/Data.ByteString/Makefile new file mode 100644 index 0000000000..9101fbd40a --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/Makefile @@ -0,0 +1,3 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/lib/Data.ByteString/all.T b/testsuite/tests/lib/Data.ByteString/all.T new file mode 100644 index 0000000000..75c5574302 --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/all.T @@ -0,0 +1,18 @@ +test('bytestring001', + [skip, # This is designed for an earlier version of bytestring + reqlib('QuickCheck')], + compile_and_run, + ['-package bytestring -package QuickCheck']) +test('bytestring002', normal, compile_and_run, ['-package bytestring']) +test('bytestring003', normal, compile_and_run, ['-package bytestring']) +test('bytestring004', + [skip, # This is designed for an earlier version of bytestring + reqlib('QuickCheck')], + compile_and_run, + ['-package bytestring -package QuickCheck']) +test('bytestring005', + [skip, # This is designed for an earlier version of bytestring + reqlib('QuickCheck')], + compile_and_run, + ['-package bytestring -package QuickCheck']) +test('bytestring006', normal, compile_and_run, ['-package bytestring']) diff --git a/testsuite/tests/lib/Data.ByteString/bytestring001.hs b/testsuite/tests/lib/Data.ByteString/bytestring001.hs new file mode 100644 index 0000000000..00cfcb3763 --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring001.hs @@ -0,0 +1,948 @@ +#!/usr/bin/env runhaskell +-- +-- Uses multi-param type classes +-- + +import Test.QuickCheck.Batch +import Test.QuickCheck +import Text.Show.Functions + +import Data.Char +import Data.Int +import Data.List +import Data.Maybe +import Data.Word + +import System.IO +import System.Environment +import System.IO.Unsafe +import System.Random + +import Control.Monad ( liftM2 ) +import Control.Monad.Instances () + +import Text.Printf +import Debug.Trace + +import Foreign.Ptr + +import Data.ByteString.Lazy (ByteString(..), pack , unpack) +import qualified Data.ByteString.Lazy as L + +import Data.ByteString.Fusion +import qualified Data.ByteString as P +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Internal as L + +import qualified Data.ByteString.Char8 as PC +import qualified Data.ByteString.Lazy.Char8 as LC +import qualified Data.ByteString as P +import qualified Data.ByteString.Internal as P +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy.Char8 as D +import Data.ByteString.Fusion + +import Prelude hiding (abs) + +-- Enable this to get verbose test output. Including the actual tests. +debug = False + +mytest :: Testable a => a -> Int -> IO () +mytest a n = mycheck defaultConfig + { configMaxTest=n + , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a + +mycheck :: Testable a => Config -> a -> IO () +mycheck config a = + do let rnd = mkStdGen 99 + mytests config (evaluate a) rnd 0 0 [] + +mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO () +mytests config gen rnd0 ntest nfail stamps + | ntest == configMaxTest config = do done "OK," ntest stamps + | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps + | otherwise = + do putStr (configEvery config ntest (arguments result)) >> hFlush stdout + case ok result of + Nothing -> + mytests config gen rnd1 ntest (nfail+1) stamps + Just True -> + mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps) + Just False -> + putStr ( "Falsifiable after " + ++ show ntest + ++ " tests:\n" + ++ unlines (arguments result) + ) >> hFlush stdout + where + result = generate (configSize config ntest) rnd2 gen + (rnd1,rnd2) = split rnd0 + +done :: String -> Int -> [[String]] -> IO () +done mesg ntest stamps = + do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table ) + where + table = display + . map entry + . reverse + . sort + . map pairLength + . group + . sort + . filter (not . null) + $ stamps + + display [] = ".\n" + display [x] = " (" ++ x ++ ").\n" + display xs = ".\n" ++ unlines (map (++ ".") xs) + + pairLength xss@(xs:_) = (length xss, xs) + entry (n, xs) = percentage n ntest + ++ " " + ++ concat (intersperse ", " xs) + + percentage n m = show ((100 * n) `div` m) ++ "%" + +------------------------------------------------------------------------ + +instance Arbitrary Char where + arbitrary = choose ('a', 'i') + coarbitrary c = variant (ord c `rem` 4) + +instance (Arbitrary a, Arbitrary b) => Arbitrary (PairS a b) where + arbitrary = liftM2 (:*:) arbitrary arbitrary + coarbitrary (a :*: b) = coarbitrary a . coarbitrary b + +instance Arbitrary Word8 where + arbitrary = choose (97, 105) + coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4)) + +instance Arbitrary Int64 where + arbitrary = sized $ \n -> choose (-fromIntegral n,fromIntegral n) + coarbitrary n = variant (fromIntegral (if n >= 0 then 2*n else 2*(-n) + 1)) + +instance Arbitrary a => Arbitrary (MaybeS a) where + arbitrary = do a <- arbitrary ; elements [NothingS, JustS a] + coarbitrary NothingS = variant 0 + coarbitrary _ = variant 1 -- ok? + +{- +instance Arbitrary Char where + arbitrary = choose ('\0', '\255') -- since we have to test words, unlines too + coarbitrary c = variant (ord c `rem` 16) + +instance Arbitrary Word8 where + arbitrary = choose (minBound, maxBound) + coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 16)) +-} + +instance Random Word8 where + randomR = integralRandomR + random = randomR (minBound,maxBound) + +instance Random Int64 where + randomR = integralRandomR + random = randomR (minBound,maxBound) + +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) + +instance Arbitrary L.ByteString where + arbitrary = arbitrary >>= return . L.fromChunks . filter (not. P.null) -- maintain the invariant. + coarbitrary s = coarbitrary (L.unpack s) + +instance Arbitrary P.ByteString where + arbitrary = P.pack `fmap` arbitrary + coarbitrary s = coarbitrary (P.unpack s) + +------------------------------------------------------------------------ +-- +-- We're doing two forms of testing here. Firstly, model based testing. +-- For our Lazy and strict bytestring types, we have model types: +-- +-- i.e. Lazy == Byte +-- \\ // +-- List +-- +-- That is, the Lazy type can be modeled by functions in both the Byte +-- and List type. For each of the 3 models, we have a set of tests that +-- check those types match. +-- +-- The Model class connects a type and its model type, via a conversion +-- function. +-- +-- +class Model a b where + model :: a -> b -- get the abstract vale from a concrete value + +-- +-- Connecting our Lazy and Strict types to their models. We also check +-- the data invariant on Lazy types. +-- +-- These instances represent the arrows in the above diagram +-- +instance Model B P where model = abstr . checkInvariant +instance Model P [W] where model = P.unpack +instance Model P [Char] where model = PC.unpack +instance Model B [W] where model = L.unpack . checkInvariant +instance Model B [Char] where model = LC.unpack . checkInvariant + +-- Types are trivially modeled by themselves +instance Model Bool Bool where model = id +instance Model Int Int where model = id +instance Model Int64 Int64 where model = id +instance Model Int64 Int where model = fromIntegral +instance Model Word8 Word8 where model = id +instance Model Ordering Ordering where model = id + +-- More structured types are modeled recursively, using the NatTrans class from Gofer. +class (Functor f, Functor g) => NatTrans f g where + eta :: f a -> g a + +-- The transformation of the same type is identity +instance NatTrans [] [] where eta = id +instance NatTrans Maybe Maybe where eta = id +instance NatTrans ((->) X) ((->) X) where eta = id +instance NatTrans ((->) W) ((->) W) where eta = id + +-- We have a transformation of pairs, if the pairs are in Model +instance Model f g => NatTrans ((,) f) ((,) g) where eta (f,a) = (model f, a) + +-- And finally, we can take any (m a) to (n b), if we can Model m n, and a b +instance (NatTrans m n, Model a b) => Model (m a) (n b) where model x = fmap model (eta x) + +------------------------------------------------------------------------ + +-- In a form more useful for QC testing (and it's lazy) +checkInvariant :: L.ByteString -> L.ByteString +checkInvariant cs0 = check cs0 + where check L.Empty = L.Empty + check (L.Chunk c cs) + | P.null c = error ("invariant violation: " ++ show cs0) + | otherwise = L.Chunk c (check cs) + +abstr :: L.ByteString -> P.ByteString +abstr = P.concat . L.toChunks + + +-- Some short hand. +type X = Int +type W = Word8 +type P = P.ByteString +type B = L.ByteString + +------------------------------------------------------------------------ +-- +-- These comparison functions handle wrapping and equality. +-- +-- A single class for these would be nice, but note that they differe in +-- the number of arguments, and those argument types, so we'd need HList +-- tricks. See here: http://okmij.org/ftp/Haskell/vararg-fn.lhs +-- + +eq1 f g = \a -> + model (f a) == g (model a) +eq2 f g = \a b -> + model (f a b) == g (model a) (model b) +eq3 f g = \a b c -> + model (f a b c) == g (model a) (model b) (model c) +eq4 f g = \a b c d -> + model (f a b c d) == g (model a) (model b) (model c) (model d) +eq5 f g = \a b c d e -> + model (f a b c d e) == g (model a) (model b) (model c) (model d) (model e) + +-- +-- And for functions that take non-null input +-- +eqnotnull1 f g = \x -> (not (isNull x)) ==> eq1 f g x +eqnotnull2 f g = \x y -> (not (isNull y)) ==> eq2 f g x y +eqnotnull3 f g = \x y z -> (not (isNull z)) ==> eq3 f g x y z + +class IsNull t where isNull :: t -> Bool +instance IsNull L.ByteString where isNull = L.null +instance IsNull P.ByteString where isNull = P.null + +------------------------------------------------------------------------ + + +-- +-- ByteString.Lazy <=> ByteString +-- + +prop_concatBP = L.concat `eq1` P.concat +prop_nullBP = L.null `eq1` P.null +prop_reverseBP = L.reverse `eq1` P.reverse +prop_transposeBP = L.transpose `eq1` P.transpose +prop_groupBP = L.group `eq1` P.group +prop_initsBP = L.inits `eq1` P.inits +prop_tailsBP = L.tails `eq1` P.tails +prop_allBP = L.all `eq2` P.all +prop_anyBP = L.any `eq2` P.any +prop_appendBP = L.append `eq2` P.append +prop_breakBP = L.break `eq2` P.break +-- prop_concatMapBP = L.concatMap `eq2` P.concatMap +prop_consBP = L.cons `eq2` P.cons +prop_countBP = L.count `eq2` P.count +prop_dropBP = L.drop `eq2` P.drop +prop_dropWhileBP = L.dropWhile `eq2` P.dropWhile +prop_filterBP = L.filter `eq2` P.filter +prop_findBP = L.find `eq2` P.find +prop_findIndexBP = L.findIndex `eq2` P.findIndex +prop_findIndicesBP = L.findIndices `eq2` P.findIndices +prop_isPrefixOfBP = L.isPrefixOf `eq2` P.isPrefixOf +prop_mapBP = L.map `eq2` P.map +prop_replicateBP = L.replicate `eq2` P.replicate +prop_snocBP = L.snoc `eq2` P.snoc +prop_spanBP = L.span `eq2` P.span +prop_splitBP = L.split `eq2` P.split +prop_splitAtBP = L.splitAt `eq2` P.splitAt +prop_takeBP = L.take `eq2` P.take +prop_takeWhileBP = L.takeWhile `eq2` P.takeWhile +prop_elemBP = L.elem `eq2` P.elem +prop_notElemBP = L.notElem `eq2` P.notElem +prop_elemIndexBP = L.elemIndex `eq2` P.elemIndex +prop_elemIndicesBP = L.elemIndices `eq2` P.elemIndices +prop_lengthBP = L.length `eq1` (fromIntegral . P.length :: P.ByteString -> Int64) +prop_readIntBP = D.readInt `eq1` C.readInt +prop_linesBP = D.lines `eq1` C.lines + +prop_headBP = L.head `eqnotnull1` P.head +prop_initBP = L.init `eqnotnull1` P.init +prop_lastBP = L.last `eqnotnull1` P.last +prop_maximumBP = L.maximum `eqnotnull1` P.maximum +prop_minimumBP = L.minimum `eqnotnull1` P.minimum +prop_tailBP = L.tail `eqnotnull1` P.tail +prop_foldl1BP = L.foldl1 `eqnotnull2` P.foldl1 +prop_foldl1BP' = L.foldl1' `eqnotnull2` P.foldl1' +prop_foldr1BP = L.foldr1 `eqnotnull2` P.foldr1 +prop_scanlBP = L.scanl `eqnotnull3` P.scanl + +prop_eqBP = eq2 + ((==) :: B -> B -> Bool) + ((==) :: P -> P -> Bool) +prop_compareBP = eq2 + ((compare) :: B -> B -> Ordering) + ((compare) :: P -> P -> Ordering) +prop_foldlBP = eq3 + (L.foldl :: (X -> W -> X) -> X -> B -> X) + (P.foldl :: (X -> W -> X) -> X -> P -> X) +prop_foldlBP' = eq3 + (L.foldl' :: (X -> W -> X) -> X -> B -> X) + (P.foldl' :: (X -> W -> X) -> X -> P -> X) +prop_foldrBP = eq3 + (L.foldr :: (W -> X -> X) -> X -> B -> X) + (P.foldr :: (W -> X -> X) -> X -> P -> X) +prop_mapAccumLBP = eq3 + (L.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B)) + (P.mapAccumL :: (X -> W -> (X,W)) -> X -> P -> (X, P)) + +prop_unfoldrBP = eq3 + ((\n f a -> L.take (fromIntegral n) $ + L.unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> B) + ((\n f a -> fst $ + P.unfoldrN n f a) :: Int -> (X -> Maybe (W,X)) -> X -> P) + +-- +-- properties comparing ByteString.Lazy `eq1` List +-- + +prop_concatBL = L.concat `eq1` (concat :: [[W]] -> [W]) +prop_lengthBL = L.length `eq1` (length :: [W] -> Int) +prop_nullBL = L.null `eq1` (null :: [W] -> Bool) +prop_reverseBL = L.reverse `eq1` (reverse :: [W] -> [W]) +prop_transposeBL = L.transpose `eq1` (transpose :: [[W]] -> [[W]]) +prop_groupBL = L.group `eq1` (group :: [W] -> [[W]]) +prop_initsBL = L.inits `eq1` (inits :: [W] -> [[W]]) +prop_tailsBL = L.tails `eq1` (tails :: [W] -> [[W]]) +prop_allBL = L.all `eq2` (all :: (W -> Bool) -> [W] -> Bool) +prop_anyBL = L.any `eq2` (any :: (W -> Bool) -> [W] -> Bool) +prop_appendBL = L.append `eq2` ((++) :: [W] -> [W] -> [W]) +prop_breakBL = L.break `eq2` (break :: (W -> Bool) -> [W] -> ([W],[W])) +-- prop_concatMapBL = L.concatMap `eq2` (concatMap :: (W -> [W]) -> [W] -> [W]) +prop_consBL = L.cons `eq2` ((:) :: W -> [W] -> [W]) +prop_dropBL = L.drop `eq2` (drop :: Int -> [W] -> [W]) +prop_dropWhileBL = L.dropWhile `eq2` (dropWhile :: (W -> Bool) -> [W] -> [W]) +prop_filterBL = L.filter `eq2` (filter :: (W -> Bool ) -> [W] -> [W]) +prop_findBL = L.find `eq2` (find :: (W -> Bool) -> [W] -> Maybe W) +prop_findIndicesBL = L.findIndices `eq2` (findIndices:: (W -> Bool) -> [W] -> [Int]) +prop_findIndexBL = L.findIndex `eq2` (findIndex :: (W -> Bool) -> [W] -> Maybe Int) +prop_isPrefixOfBL = L.isPrefixOf `eq2` (isPrefixOf:: [W] -> [W] -> Bool) +prop_mapBL = L.map `eq2` (map :: (W -> W) -> [W] -> [W]) +prop_replicateBL = L.replicate `eq2` (replicate :: Int -> W -> [W]) +prop_snocBL = L.snoc `eq2` ((\xs x -> xs ++ [x]) :: [W] -> W -> [W]) +prop_spanBL = L.span `eq2` (span :: (W -> Bool) -> [W] -> ([W],[W])) +prop_splitAtBL = L.splitAt `eq2` (splitAt :: Int -> [W] -> ([W],[W])) +prop_takeBL = L.take `eq2` (take :: Int -> [W] -> [W]) +prop_takeWhileBL = L.takeWhile `eq2` (takeWhile :: (W -> Bool) -> [W] -> [W]) +prop_elemBL = L.elem `eq2` (elem :: W -> [W] -> Bool) +prop_notElemBL = L.notElem `eq2` (notElem :: W -> [W] -> Bool) +prop_elemIndexBL = L.elemIndex `eq2` (elemIndex :: W -> [W] -> Maybe Int) +prop_elemIndicesBL = L.elemIndices `eq2` (elemIndices:: W -> [W] -> [Int]) +prop_linesBL = D.lines `eq1` (lines :: String -> [String]) + +prop_foldl1BL = L.foldl1 `eqnotnull2` (foldl1 :: (W -> W -> W) -> [W] -> W) +prop_foldl1BL' = L.foldl1' `eqnotnull2` (foldl1' :: (W -> W -> W) -> [W] -> W) +prop_foldr1BL = L.foldr1 `eqnotnull2` (foldr1 :: (W -> W -> W) -> [W] -> W) +prop_headBL = L.head `eqnotnull1` (head :: [W] -> W) +prop_initBL = L.init `eqnotnull1` (init :: [W] -> [W]) +prop_lastBL = L.last `eqnotnull1` (last :: [W] -> W) +prop_maximumBL = L.maximum `eqnotnull1` (maximum :: [W] -> W) +prop_minimumBL = L.minimum `eqnotnull1` (minimum :: [W] -> W) +prop_tailBL = L.tail `eqnotnull1` (tail :: [W] -> [W]) + +prop_eqBL = eq2 + ((==) :: B -> B -> Bool) + ((==) :: [W] -> [W] -> Bool) +prop_compareBL = eq2 + ((compare) :: B -> B -> Ordering) + ((compare) :: [W] -> [W] -> Ordering) +prop_foldlBL = eq3 + (L.foldl :: (X -> W -> X) -> X -> B -> X) + ( foldl :: (X -> W -> X) -> X -> [W] -> X) +prop_foldlBL' = eq3 + (L.foldl' :: (X -> W -> X) -> X -> B -> X) + ( foldl' :: (X -> W -> X) -> X -> [W] -> X) +prop_foldrBL = eq3 + (L.foldr :: (W -> X -> X) -> X -> B -> X) + ( foldr :: (W -> X -> X) -> X -> [W] -> X) +prop_mapAccumLBL = eq3 + (L.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B)) + ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) +prop_unfoldrBL = eq3 + ((\n f a -> L.take (fromIntegral n) $ + L.unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> B) + ((\n f a -> take n $ + unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> [W]) + +-- +-- And finally, check correspondance between Data.ByteString and List +-- + +prop_lengthPL = (fromIntegral.P.length :: P -> Int) `eq1` (length :: [W] -> Int) +prop_nullPL = P.null `eq1` (null :: [W] -> Bool) +prop_reversePL = P.reverse `eq1` (reverse :: [W] -> [W]) +prop_transposePL = P.transpose `eq1` (transpose :: [[W]] -> [[W]]) +prop_groupPL = P.group `eq1` (group :: [W] -> [[W]]) +prop_initsPL = P.inits `eq1` (inits :: [W] -> [[W]]) +prop_tailsPL = P.tails `eq1` (tails :: [W] -> [[W]]) +prop_concatPL = P.concat `eq1` (concat :: [[W]] -> [W]) +prop_allPL = P.all `eq2` (all :: (W -> Bool) -> [W] -> Bool) +prop_anyPL = P.any `eq2` (any :: (W -> Bool) -> [W] -> Bool) +prop_appendPL = P.append `eq2` ((++) :: [W] -> [W] -> [W]) +prop_breakPL = P.break `eq2` (break :: (W -> Bool) -> [W] -> ([W],[W])) +-- prop_concatMapPL = P.concatMap `eq2` (concatMap :: (W -> [W]) -> [W] -> [W]) +prop_consPL = P.cons `eq2` ((:) :: W -> [W] -> [W]) +prop_dropPL = P.drop `eq2` (drop :: Int -> [W] -> [W]) +prop_dropWhilePL = P.dropWhile `eq2` (dropWhile :: (W -> Bool) -> [W] -> [W]) +prop_filterPL = P.filter `eq2` (filter :: (W -> Bool ) -> [W] -> [W]) +prop_findPL = P.find `eq2` (find :: (W -> Bool) -> [W] -> Maybe W) +prop_findIndexPL = P.findIndex `eq2` (findIndex :: (W -> Bool) -> [W] -> Maybe Int) +prop_isPrefixOfPL = P.isPrefixOf`eq2` (isPrefixOf:: [W] -> [W] -> Bool) +prop_mapPL = P.map `eq2` (map :: (W -> W) -> [W] -> [W]) +prop_replicatePL = P.replicate `eq2` (replicate :: Int -> W -> [W]) +prop_snocPL = P.snoc `eq2` ((\xs x -> xs ++ [x]) :: [W] -> W -> [W]) +prop_spanPL = P.span `eq2` (span :: (W -> Bool) -> [W] -> ([W],[W])) +prop_splitAtPL = P.splitAt `eq2` (splitAt :: Int -> [W] -> ([W],[W])) +prop_takePL = P.take `eq2` (take :: Int -> [W] -> [W]) +prop_takeWhilePL = P.takeWhile `eq2` (takeWhile :: (W -> Bool) -> [W] -> [W]) +prop_elemPL = P.elem `eq2` (elem :: W -> [W] -> Bool) +prop_notElemPL = P.notElem `eq2` (notElem :: W -> [W] -> Bool) +prop_elemIndexPL = P.elemIndex `eq2` (elemIndex :: W -> [W] -> Maybe Int) +prop_linesPL = C.lines `eq1` (lines :: String -> [String]) +prop_findIndicesPL= P.findIndices`eq2` (findIndices:: (W -> Bool) -> [W] -> [Int]) +prop_elemIndicesPL= P.elemIndices`eq2` (elemIndices:: W -> [W] -> [Int]) + +prop_foldl1PL = P.foldl1 `eqnotnull2` (foldl1 :: (W -> W -> W) -> [W] -> W) +prop_foldl1PL' = P.foldl1' `eqnotnull2` (foldl1' :: (W -> W -> W) -> [W] -> W) +prop_foldr1PL = P.foldr1 `eqnotnull2` (foldr1 :: (W -> W -> W) -> [W] -> W) +prop_scanlPL = P.scanl `eqnotnull3` (scanl :: (W -> W -> W) -> W -> [W] -> [W]) +prop_scanl1PL = P.scanl1 `eqnotnull2` (scanl1 :: (W -> W -> W) -> [W] -> [W]) +prop_scanrPL = P.scanr `eqnotnull3` (scanr :: (W -> W -> W) -> W -> [W] -> [W]) +prop_scanr1PL = P.scanr1 `eqnotnull2` (scanr1 :: (W -> W -> W) -> [W] -> [W]) +prop_headPL = P.head `eqnotnull1` (head :: [W] -> W) +prop_initPL = P.init `eqnotnull1` (init :: [W] -> [W]) +prop_lastPL = P.last `eqnotnull1` (last :: [W] -> W) +prop_maximumPL = P.maximum `eqnotnull1` (maximum :: [W] -> W) +prop_minimumPL = P.minimum `eqnotnull1` (minimum :: [W] -> W) +prop_tailPL = P.tail `eqnotnull1` (tail :: [W] -> [W]) + +prop_eqPL = eq2 + ((==) :: P -> P -> Bool) + ((==) :: [W] -> [W] -> Bool) +prop_comparePL = eq2 + ((compare) :: P -> P -> Ordering) + ((compare) :: [W] -> [W] -> Ordering) +prop_foldlPL = eq3 + (P.foldl :: (X -> W -> X) -> X -> P -> X) + ( foldl :: (X -> W -> X) -> X -> [W] -> X) +prop_foldlPL' = eq3 + (P.foldl' :: (X -> W -> X) -> X -> P -> X) + ( foldl' :: (X -> W -> X) -> X -> [W] -> X) +prop_foldrPL = eq3 + (P.foldr :: (W -> X -> X) -> X -> P -> X) + ( foldr :: (W -> X -> X) -> X -> [W] -> X) +prop_mapAccumLPL= eq3 + (P.mapAccumL :: (X -> W -> (X,W)) -> X -> P -> (X, P)) + ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) +prop_mapAccumRPL= eq3 + (P.mapAccumR :: (X -> W -> (X,W)) -> X -> P -> (X, P)) + ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W])) +prop_unfoldrPL = eq3 + ((\n f a -> fst $ + P.unfoldrN n f a) :: Int -> (X -> Maybe (W,X)) -> X -> P) + ((\n f a -> take n $ + unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> [W]) + +------------------------------------------------------------------------ +-- +-- And check fusion RULES. +-- + +prop_lazylooploop em1 em2 start1 start2 arr = + loopL em2 start2 (loopArr (loopL em1 start1 arr)) == + loopSndAcc (loopL (em1 `fuseEFL` em2) (start1 :*: start2) arr) + where + _ = start1 :: Int + _ = start2 :: Int + +prop_looploop em1 em2 start1 start2 arr = + loopU em2 start2 (loopArr (loopU em1 start1 arr)) == + loopSndAcc (loopU (em1 `fuseEFL` em2) (start1 :*: start2) arr) + where + _ = start1 :: Int + _ = start2 :: Int + +------------------------------------------------------------------------ + +-- check associativity of sequence loops +prop_sequenceloops_assoc n m o x y z a1 a2 a3 xs = + + k ((f * g) * h) == k (f * (g * h)) -- associativity + + where + (*) = sequenceLoops + f = (sel n) x a1 + g = (sel m) y a2 + h = (sel o) z a3 + + _ = a1 :: Int; _ = a2 :: Int; _ = a3 :: Int + k g = loopArr (loopWrapper g xs) + +-- check wrapper elimination +prop_loop_loop_wrapper_elimination n m x y a1 a2 xs = + loopWrapper g (loopArr (loopWrapper f xs)) == + loopSndAcc (loopWrapper (sequenceLoops f g) xs) + where + f = (sel n) x a1 + g = (sel m) y a2 + _ = a1 :: Int; _ = a2 :: Int + +sel :: Bool + -> (acc -> Word8 -> PairS acc (MaybeS Word8)) + -> acc + -> Ptr Word8 + -> Ptr Word8 + -> Int + -> IO (PairS (PairS acc Int) Int) +sel False = doDownLoop +sel True = doUpLoop + +------------------------------------------------------------------------ +-- +-- Test fusion forms +-- + +prop_up_up_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doUpLoop f1 acc1) (doUpLoop f2 acc2)) == + k (doUpLoop (f1 `fuseAccAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int; k g = loopWrapper g xs + +prop_down_down_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doDownLoop f1 acc1) (doDownLoop f2 acc2)) == + k (doDownLoop (f1 `fuseAccAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int ; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_noAcc_noAcc_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doNoAccLoop f1 acc1) (doNoAccLoop f2 acc2)) == + k (doNoAccLoop (f1 `fuseNoAccNoAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int ; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_noAcc_up_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doNoAccLoop f1 acc1) (doUpLoop f2 acc2)) == + k (doUpLoop (f1 `fuseNoAccAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int; k g = loopWrapper g xs + +prop_up_noAcc_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doUpLoop f1 acc1) (doNoAccLoop f2 acc2)) == + k (doUpLoop (f1 `fuseAccNoAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int; k g = loopWrapper g xs + +prop_noAcc_down_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doNoAccLoop f1 acc1) (doDownLoop f2 acc2)) == + k (doDownLoop (f1 `fuseNoAccAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_down_noAcc_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doDownLoop f1 acc1) (doNoAccLoop f2 acc2)) == + k (doDownLoop (f1 `fuseAccNoAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int; k g = loopWrapper g xs + +prop_map_map_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doMapLoop f1 acc1) (doMapLoop f2 acc2)) == + k (doMapLoop (f1 `fuseMapMapEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_filter_filter_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doFilterLoop f1 acc1) (doFilterLoop f2 acc2)) == + k (doFilterLoop (f1 `fuseFilterFilterEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_map_filter_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doMapLoop f1 acc1) (doFilterLoop f2 acc2)) == + k (doNoAccLoop (f1 `fuseMapFilterEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_filter_map_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doFilterLoop f1 acc1) (doMapLoop f2 acc2)) == + k (doNoAccLoop (f1 `fuseFilterMapEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_map_noAcc_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doMapLoop f1 acc1) (doNoAccLoop f2 acc2)) == + k (doNoAccLoop (f1 `fuseMapNoAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_noAcc_map_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doNoAccLoop f1 acc1) (doMapLoop f2 acc2)) == + k (doNoAccLoop (f1 `fuseNoAccMapEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_map_up_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doMapLoop f1 acc1) (doUpLoop f2 acc2)) == + k (doUpLoop (f1 `fuseMapAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_up_map_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doUpLoop f1 acc1) (doMapLoop f2 acc2)) == + k (doUpLoop (f1 `fuseAccMapEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_map_down_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doMapLoop f1 acc1) (doDownLoop f2 acc2)) == + k (doDownLoop (f1 `fuseMapAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_down_map_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doDownLoop f1 acc1) (doMapLoop f2 acc2)) == + k (doDownLoop (f1 `fuseAccMapEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_filter_noAcc_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doFilterLoop f1 acc1) (doNoAccLoop f2 acc2)) == + k (doNoAccLoop (f1 `fuseFilterNoAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_noAcc_filter_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doNoAccLoop f1 acc1) (doFilterLoop f2 acc2)) == + k (doNoAccLoop (f1 `fuseNoAccFilterEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_filter_up_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doFilterLoop f1 acc1) (doUpLoop f2 acc2)) == + k (doUpLoop (f1 `fuseFilterAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_up_filter_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doUpLoop f1 acc1) (doFilterLoop f2 acc2)) == + k (doUpLoop (f1 `fuseAccFilterEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_filter_down_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doFilterLoop f1 acc1) (doDownLoop f2 acc2)) == + k (doDownLoop (f1 `fuseFilterAccEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +prop_down_filter_loop_fusion f1 f2 acc1 acc2 xs = + k (sequenceLoops (doDownLoop f1 acc1) (doFilterLoop f2 acc2)) == + k (doDownLoop (f1 `fuseAccFilterEFL` f2) (acc1 :*: acc2)) + where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs + +------------------------------------------------------------------------ + +prop_length_loop_fusion_1 f1 acc1 xs = + P.length (loopArr (loopWrapper (doUpLoop f1 acc1) xs)) == + P.foldl' (const . (+1)) 0 (loopArr (loopWrapper (doUpLoop f1 acc1) xs)) + where _ = acc1 :: Int + +prop_length_loop_fusion_2 f1 acc1 xs = + P.length (loopArr (loopWrapper (doDownLoop f1 acc1) xs)) == + P.foldl' (const . (+1)) 0 (loopArr (loopWrapper (doDownLoop f1 acc1) xs)) + where _ = acc1 :: Int + +prop_length_loop_fusion_3 f1 acc1 xs = + P.length (loopArr (loopWrapper (doMapLoop f1 acc1) xs)) == + P.foldl' (const . (+1)) 0 (loopArr (loopWrapper (doMapLoop f1 acc1) xs)) + where _ = acc1 :: Int + +prop_length_loop_fusion_4 f1 acc1 xs = + P.length (loopArr (loopWrapper (doFilterLoop f1 acc1) xs)) == + P.foldl' (const . (+1)) 0 (loopArr (loopWrapper (doFilterLoop f1 acc1) xs)) + where _ = acc1 :: Int + +------------------------------------------------------------------------ +-- The entry point + +main :: IO () +main = myrun tests + +myrun :: [(String, Int -> IO ())] -> IO () +myrun tests = do + x <- getArgs + let n = if null x then 100 else read . head $ x + mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests + +-- +-- And now a list of all the properties to test. +-- + +tests = misc_tests + ++ bl_tests + ++ bp_tests + ++ pl_tests + ++ fusion_tests + +misc_tests = + [("invariant", mytest prop_invariant)] + +------------------------------------------------------------------------ +-- ByteString.Lazy <=> List + +bl_tests = + [("all", mytest prop_allBL) + ,("any", mytest prop_anyBL) + ,("append", mytest prop_appendBL) + ,("compare", mytest prop_compareBL) + ,("concat", mytest prop_concatBL) + ,("cons", mytest prop_consBL) + ,("eq", mytest prop_eqBL) + ,("filter", mytest prop_filterBL) + ,("find", mytest prop_findBL) + ,("findIndex", mytest prop_findIndexBL) + ,("findIndices", mytest prop_findIndicesBL) + ,("foldl", mytest prop_foldlBL) + ,("foldl'", mytest prop_foldlBL') + ,("foldl1", mytest prop_foldl1BL) + ,("foldl1'", mytest prop_foldl1BL') + ,("foldr", mytest prop_foldrBL) + ,("foldr1", mytest prop_foldr1BL) + ,("mapAccumL", mytest prop_mapAccumLBL) + ,("unfoldr", mytest prop_unfoldrBL) + ,("head", mytest prop_headBL) + ,("init", mytest prop_initBL) + ,("isPrefixOf", mytest prop_isPrefixOfBL) + ,("last", mytest prop_lastBL) + ,("length", mytest prop_lengthBL) + ,("map", mytest prop_mapBL) + ,("maximum", mytest prop_maximumBL) + ,("minimum", mytest prop_minimumBL) + ,("null", mytest prop_nullBL) + ,("reverse", mytest prop_reverseBL) + ,("snoc", mytest prop_snocBL) + ,("tail", mytest prop_tailBL) + ,("transpose", mytest prop_transposeBL) + ,("replicate", mytest prop_replicateBL) + ,("take", mytest prop_takeBL) + ,("drop", mytest prop_dropBL) + ,("splitAt", mytest prop_splitAtBL) + ,("takeWhile", mytest prop_takeWhileBL) + ,("dropWhile", mytest prop_dropWhileBL) + ,("break", mytest prop_breakBL) + ,("span", mytest prop_spanBL) + ,("group", mytest prop_groupBL) + ,("inits", mytest prop_initsBL) + ,("tails", mytest prop_tailsBL) + ,("elem", mytest prop_elemBL) + ,("notElem", mytest prop_notElemBL) + ,("lines", mytest prop_linesBL) + ,("elemIndex", mytest prop_elemIndexBL) + ,("elemIndices", mytest prop_elemIndicesBL) +-- ,("concatMap", mytest prop_concatMapBL) + ] + +------------------------------------------------------------------------ +-- ByteString.Lazy <=> ByteString + +bp_tests = + [("all", mytest prop_allBP) + ,("any", mytest prop_anyBP) + ,("append", mytest prop_appendBP) + ,("compare", mytest prop_compareBP) + ,("concat", mytest prop_concatBP) + ,("cons", mytest prop_consBP) + ,("eq", mytest prop_eqBP) + ,("filter", mytest prop_filterBP) + ,("find", mytest prop_findBP) + ,("findIndex", mytest prop_findIndexBP) + ,("findIndices", mytest prop_findIndicesBP) + ,("foldl", mytest prop_foldlBP) + ,("foldl'", mytest prop_foldlBP') + ,("foldl1", mytest prop_foldl1BP) + ,("foldl1'", mytest prop_foldl1BP') + ,("foldr", mytest prop_foldrBP) + ,("foldr1", mytest prop_foldr1BP) + ,("mapAccumL", mytest prop_mapAccumLBP) + ,("unfoldr", mytest prop_unfoldrBP) + ,("head", mytest prop_headBP) + ,("init", mytest prop_initBP) + ,("isPrefixOf", mytest prop_isPrefixOfBP) + ,("last", mytest prop_lastBP) + ,("length", mytest prop_lengthBP) + ,("readInt", mytest prop_readIntBP) + ,("lines", mytest prop_linesBP) + ,("map", mytest prop_mapBP) + ,("maximum ", mytest prop_maximumBP) + ,("minimum" , mytest prop_minimumBP) + ,("null", mytest prop_nullBP) + ,("reverse", mytest prop_reverseBP) + ,("snoc", mytest prop_snocBP) + ,("tail", mytest prop_tailBP) + ,("scanl", mytest prop_scanlBP) + ,("transpose", mytest prop_transposeBP) + ,("replicate", mytest prop_replicateBP) + ,("take", mytest prop_takeBP) + ,("drop", mytest prop_dropBP) + ,("splitAt", mytest prop_splitAtBP) + ,("takeWhile", mytest prop_takeWhileBP) + ,("dropWhile", mytest prop_dropWhileBP) + ,("break", mytest prop_breakBP) + ,("span", mytest prop_spanBP) + ,("split", mytest prop_splitBP) + ,("count", mytest prop_countBP) + ,("group", mytest prop_groupBP) + ,("inits", mytest prop_initsBP) + ,("tails", mytest prop_tailsBP) + ,("elem", mytest prop_elemBP) + ,("notElem", mytest prop_notElemBP) + ,("elemIndex", mytest prop_elemIndexBP) + ,("elemIndices", mytest prop_elemIndicesBP) +-- ,("concatMap", mytest prop_concatMapBP) + ] + +------------------------------------------------------------------------ +-- ByteString <=> List + +pl_tests = + [("all", mytest prop_allPL) + ,("any", mytest prop_anyPL) + ,("append", mytest prop_appendPL) + ,("compare", mytest prop_comparePL) + ,("concat", mytest prop_concatPL) + ,("cons", mytest prop_consPL) + ,("eq", mytest prop_eqPL) + ,("filter", mytest prop_filterPL) + ,("find", mytest prop_findPL) + ,("findIndex", mytest prop_findIndexPL) + ,("findIndices", mytest prop_findIndicesPL) + ,("foldl", mytest prop_foldlPL) + ,("foldl'", mytest prop_foldlPL') + ,("foldl1", mytest prop_foldl1PL) + ,("foldl1'", mytest prop_foldl1PL') + ,("foldr1", mytest prop_foldr1PL) + ,("foldr", mytest prop_foldrPL) + ,("mapAccumL", mytest prop_mapAccumLPL) + ,("mapAccumR", mytest prop_mapAccumRPL) + ,("unfoldr", mytest prop_unfoldrPL) + ,("scanl", mytest prop_scanlPL) + ,("scanl1", mytest prop_scanl1PL) + ,("scanr", mytest prop_scanrPL) + ,("scanr1", mytest prop_scanr1PL) + ,("head", mytest prop_headPL) + ,("init", mytest prop_initPL) + ,("last", mytest prop_lastPL) + ,("maximum", mytest prop_maximumPL) + ,("minimum", mytest prop_minimumPL) + ,("tail", mytest prop_tailPL) + ,("isPrefixOf", mytest prop_isPrefixOfPL) + ,("length", mytest prop_lengthPL) + ,("map", mytest prop_mapPL) + ,("null", mytest prop_nullPL) + ,("reverse", mytest prop_reversePL) + ,("snoc", mytest prop_snocPL) + ,("transpose", mytest prop_transposePL) + ,("replicate", mytest prop_replicatePL) + ,("take", mytest prop_takePL) + ,("drop", mytest prop_dropPL) + ,("splitAt", mytest prop_splitAtPL) + ,("takeWhile", mytest prop_takeWhilePL) + ,("dropWhile", mytest prop_dropWhilePL) + ,("break", mytest prop_breakPL) + ,("span", mytest prop_spanPL) + ,("group", mytest prop_groupPL) + ,("inits", mytest prop_initsPL) + ,("tails", mytest prop_tailsPL) + ,("elem", mytest prop_elemPL) + ,("notElem", mytest prop_notElemPL) + ,("lines", mytest prop_linesBL) + ,("elemIndex", mytest prop_elemIndexPL) + ,("elemIndices", mytest prop_elemIndicesPL) +-- ,("concatMap", mytest prop_concatMapPL) + ] + +------------------------------------------------------------------------ +-- Fusion rules + +fusion_tests = +-- v1 fusion + [ ("lazy loop/loop fusion", mytest prop_lazylooploop) + , ("loop/loop fusion", mytest prop_looploop) + +-- v2 fusion + ,("loop/loop wrapper elim", mytest prop_loop_loop_wrapper_elimination) + ,("sequence association", mytest prop_sequenceloops_assoc) + + ,("up/up loop fusion", mytest prop_up_up_loop_fusion) + ,("down/down loop fusion", mytest prop_down_down_loop_fusion) + ,("noAcc/noAcc loop fusion", mytest prop_noAcc_noAcc_loop_fusion) + ,("noAcc/up loop fusion", mytest prop_noAcc_up_loop_fusion) + ,("up/noAcc loop fusion", mytest prop_up_noAcc_loop_fusion) + ,("noAcc/down loop fusion", mytest prop_noAcc_down_loop_fusion) + ,("down/noAcc loop fusion", mytest prop_down_noAcc_loop_fusion) + ,("map/map loop fusion", mytest prop_map_map_loop_fusion) + ,("filter/filter loop fusion", mytest prop_filter_filter_loop_fusion) + ,("map/filter loop fusion", mytest prop_map_filter_loop_fusion) + ,("filter/map loop fusion", mytest prop_filter_map_loop_fusion) + ,("map/noAcc loop fusion", mytest prop_map_noAcc_loop_fusion) + ,("noAcc/map loop fusion", mytest prop_noAcc_map_loop_fusion) + ,("map/up loop fusion", mytest prop_map_up_loop_fusion) + ,("up/map loop fusion", mytest prop_up_map_loop_fusion) + ,("map/down loop fusion", mytest prop_map_down_fusion) + ,("down/map loop fusion", mytest prop_down_map_loop_fusion) + ,("filter/noAcc loop fusion", mytest prop_filter_noAcc_loop_fusion) + ,("noAcc/filter loop fusion", mytest prop_noAcc_filter_loop_fusion) + ,("filter/up loop fusion", mytest prop_filter_up_loop_fusion) + ,("up/filter loop fusion", mytest prop_up_filter_loop_fusion) + ,("filter/down loop fusion", mytest prop_filter_down_fusion) + ,("down/filter loop fusion", mytest prop_down_filter_loop_fusion) + + ,("length/loop fusion", mytest prop_length_loop_fusion_1) + ,("length/loop fusion", mytest prop_length_loop_fusion_2) + ,("length/loop fusion", mytest prop_length_loop_fusion_3) + ,("length/loop fusion", mytest prop_length_loop_fusion_4) + ] + + +------------------------------------------------------------------------ +-- +-- These are miscellaneous tests left over. Or else they test some +-- property internal to a type (i.e. head . sort == minimum), without +-- reference to a model type. +-- + +invariant :: L.ByteString -> Bool +invariant L.Empty = True +invariant (L.Chunk c cs) = not (P.null c) && invariant cs + +prop_invariant = invariant + diff --git a/testsuite/tests/lib/Data.ByteString/bytestring001.stdout b/testsuite/tests/lib/Data.ByteString/bytestring001.stdout new file mode 100644 index 0000000000..e2b220dc41 --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring001.stdout @@ -0,0 +1,185 @@ +invariant : OK, 100 tests. +all : OK, 100 tests. +any : OK, 100 tests. +append : OK, 100 tests. +compare : OK, 100 tests. +concat : OK, 100 tests. +cons : OK, 100 tests. +eq : OK, 100 tests. +filter : OK, 100 tests. +find : OK, 100 tests. +findIndex : OK, 100 tests. +findIndices : OK, 100 tests. +foldl : OK, 100 tests. +foldl' : OK, 100 tests. +foldl1 : OK, 100 tests. +foldl1' : OK, 100 tests. +foldr : OK, 100 tests. +foldr1 : OK, 100 tests. +mapAccumL : OK, 100 tests. +unfoldr : OK, 100 tests. +head : OK, 100 tests. +init : OK, 100 tests. +isPrefixOf : OK, 100 tests. +last : OK, 100 tests. +length : OK, 100 tests. +map : OK, 100 tests. +maximum : OK, 100 tests. +minimum : OK, 100 tests. +null : OK, 100 tests. +reverse : OK, 100 tests. +snoc : OK, 100 tests. +tail : OK, 100 tests. +transpose : OK, 100 tests. +replicate : OK, 100 tests. +take : OK, 100 tests. +drop : OK, 100 tests. +splitAt : OK, 100 tests. +takeWhile : OK, 100 tests. +dropWhile : OK, 100 tests. +break : OK, 100 tests. +span : OK, 100 tests. +group : OK, 100 tests. +inits : OK, 100 tests. +tails : OK, 100 tests. +elem : OK, 100 tests. +notElem : OK, 100 tests. +lines : OK, 100 tests. +elemIndex : OK, 100 tests. +elemIndices : OK, 100 tests. +all : OK, 100 tests. +any : OK, 100 tests. +append : OK, 100 tests. +compare : OK, 100 tests. +concat : OK, 100 tests. +cons : OK, 100 tests. +eq : OK, 100 tests. +filter : OK, 100 tests. +find : OK, 100 tests. +findIndex : OK, 100 tests. +findIndices : OK, 100 tests. +foldl : OK, 100 tests. +foldl' : OK, 100 tests. +foldl1 : OK, 100 tests. +foldl1' : OK, 100 tests. +foldr : OK, 100 tests. +foldr1 : OK, 100 tests. +mapAccumL : OK, 100 tests. +unfoldr : OK, 100 tests. +head : OK, 100 tests. +init : OK, 100 tests. +isPrefixOf : OK, 100 tests. +last : OK, 100 tests. +length : OK, 100 tests. +readInt : OK, 100 tests. +lines : OK, 100 tests. +map : OK, 100 tests. +maximum : OK, 100 tests. +minimum : OK, 100 tests. +null : OK, 100 tests. +reverse : OK, 100 tests. +snoc : OK, 100 tests. +tail : OK, 100 tests. +scanl : OK, 100 tests. +transpose : OK, 100 tests. +replicate : OK, 100 tests. +take : OK, 100 tests. +drop : OK, 100 tests. +splitAt : OK, 100 tests. +takeWhile : OK, 100 tests. +dropWhile : OK, 100 tests. +break : OK, 100 tests. +span : OK, 100 tests. +split : OK, 100 tests. +count : OK, 100 tests. +group : OK, 100 tests. +inits : OK, 100 tests. +tails : OK, 100 tests. +elem : OK, 100 tests. +notElem : OK, 100 tests. +elemIndex : OK, 100 tests. +elemIndices : OK, 100 tests. +all : OK, 100 tests. +any : OK, 100 tests. +append : OK, 100 tests. +compare : OK, 100 tests. +concat : OK, 100 tests. +cons : OK, 100 tests. +eq : OK, 100 tests. +filter : OK, 100 tests. +find : OK, 100 tests. +findIndex : OK, 100 tests. +findIndices : OK, 100 tests. +foldl : OK, 100 tests. +foldl' : OK, 100 tests. +foldl1 : OK, 100 tests. +foldl1' : OK, 100 tests. +foldr1 : OK, 100 tests. +foldr : OK, 100 tests. +mapAccumL : OK, 100 tests. +mapAccumR : OK, 100 tests. +unfoldr : OK, 100 tests. +scanl : OK, 100 tests. +scanl1 : OK, 100 tests. +scanr : OK, 100 tests. +scanr1 : OK, 100 tests. +head : OK, 100 tests. +init : OK, 100 tests. +last : OK, 100 tests. +maximum : OK, 100 tests. +minimum : OK, 100 tests. +tail : OK, 100 tests. +isPrefixOf : OK, 100 tests. +length : OK, 100 tests. +map : OK, 100 tests. +null : OK, 100 tests. +reverse : OK, 100 tests. +snoc : OK, 100 tests. +transpose : OK, 100 tests. +replicate : OK, 100 tests. +take : OK, 100 tests. +drop : OK, 100 tests. +splitAt : OK, 100 tests. +takeWhile : OK, 100 tests. +dropWhile : OK, 100 tests. +break : OK, 100 tests. +span : OK, 100 tests. +group : OK, 100 tests. +inits : OK, 100 tests. +tails : OK, 100 tests. +elem : OK, 100 tests. +notElem : OK, 100 tests. +lines : OK, 100 tests. +elemIndex : OK, 100 tests. +elemIndices : OK, 100 tests. +lazy loop/loop fusion : OK, 100 tests. +loop/loop fusion : OK, 100 tests. +loop/loop wrapper elim : OK, 100 tests. +sequence association : OK, 100 tests. +up/up loop fusion: OK, 100 tests. +down/down loop fusion: OK, 100 tests. +noAcc/noAcc loop fusion: OK, 100 tests. +noAcc/up loop fusion: OK, 100 tests. +up/noAcc loop fusion: OK, 100 tests. +noAcc/down loop fusion: OK, 100 tests. +down/noAcc loop fusion: OK, 100 tests. +map/map loop fusion: OK, 100 tests. +filter/filter loop fusion: OK, 100 tests. +map/filter loop fusion: OK, 100 tests. +filter/map loop fusion: OK, 100 tests. +map/noAcc loop fusion: OK, 100 tests. +noAcc/map loop fusion: OK, 100 tests. +map/up loop fusion: OK, 100 tests. +up/map loop fusion: OK, 100 tests. +map/down loop fusion: OK, 100 tests. +down/map loop fusion: OK, 100 tests. +filter/noAcc loop fusion: OK, 100 tests. +noAcc/filter loop fusion: OK, 100 tests. +filter/up loop fusion: OK, 100 tests. +up/filter loop fusion: OK, 100 tests. +filter/down loop fusion: OK, 100 tests. +down/filter loop fusion: OK, 100 tests. +length/loop fusion : OK, 100 tests. +length/loop fusion : OK, 100 tests. +length/loop fusion : OK, 100 tests. +length/loop fusion : OK, 100 tests. diff --git a/testsuite/tests/lib/Data.ByteString/bytestring002.hs b/testsuite/tests/lib/Data.ByteString/bytestring002.hs new file mode 100644 index 0000000000..23d6cf270f --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring002.hs @@ -0,0 +1,6 @@ +-- +-- The unix wc -l program +-- +import qualified Data.ByteString as B + +main = print . B.count 10 =<< B.getContents diff --git a/testsuite/tests/lib/Data.ByteString/bytestring002.stdin b/testsuite/tests/lib/Data.ByteString/bytestring002.stdin new file mode 100644 index 0000000000..abffbabe44 --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring002.stdin @@ -0,0 +1,1000 @@ +A +a +aa +aal +aalii +aam +Aani +aardvark +aardwolf +Aaron +Aaronic +Aaronical +Aaronite +Aaronitic +Aaru +Ab +aba +Ababdeh +Ababua +abac +abaca +abacate +abacay +abacinate +abacination +abaciscus +abacist +aback +abactinal +abactinally +abaction +abactor +abaculus +abacus +Abadite +abaff +abaft +abaisance +abaiser +abaissed +abalienate +abalienation +abalone +Abama +abampere +abandon +abandonable +abandoned +abandonedly +abandonee +abandoner +abandonment +Abanic +Abantes +abaptiston +Abarambo +Abaris +abarthrosis +abarticular +abarticulation +abas +abase +abased +abasedly +abasedness +abasement +abaser +Abasgi +abash +abashed +abashedly +abashedness +abashless +abashlessly +abashment +abasia +abasic +abask +Abassin +abastardize +abatable +abate +abatement +abater +abatis +abatised +abaton +abator +abattoir +Abatua +abature +abave +abaxial +abaxile +abaze +abb +Abba +abbacomes +abbacy +Abbadide +abbas +abbasi +abbassi +Abbasside +abbatial +abbatical +abbess +abbey +abbeystede +Abbie +abbot +abbotcy +abbotnullius +abbotship +abbreviate +abbreviately +abbreviation +abbreviator +abbreviatory +abbreviature +Abby +abcoulomb +abdal +abdat +Abderian +Abderite +abdest +abdicable +abdicant +abdicate +abdication +abdicative +abdicator +Abdiel +abditive +abditory +abdomen +abdominal +Abdominales +abdominalian +abdominally +abdominoanterior +abdominocardiac +abdominocentesis +abdominocystic +abdominogenital +abdominohysterectomy +abdominohysterotomy +abdominoposterior +abdominoscope +abdominoscopy +abdominothoracic +abdominous +abdominovaginal +abdominovesical +abduce +abducens +abducent +abduct +abduction +abductor +Abe +abeam +abear +abearance +abecedarian +abecedarium +abecedary +abed +abeigh +Abel +abele +Abelia +Abelian +Abelicea +Abelite +abelite +Abelmoschus +abelmosk +Abelonian +abeltree +Abencerrages +abenteric +abepithymia +Aberdeen +aberdevine +Aberdonian +Aberia +aberrance +aberrancy +aberrant +aberrate +aberration +aberrational +aberrator +aberrometer +aberroscope +aberuncator +abet +abetment +abettal +abettor +abevacuation +abey +abeyance +abeyancy +abeyant +abfarad +abhenry +abhiseka +abhominable +abhor +abhorrence +abhorrency +abhorrent +abhorrently +abhorrer +abhorrible +abhorring +Abhorson +abidal +abidance +abide +abider +abidi +abiding +abidingly +abidingness +Abie +Abies +abietate +abietene +abietic +abietin +Abietineae +abietineous +abietinic +Abiezer +Abigail +abigail +abigailship +abigeat +abigeus +abilao +ability +abilla +abilo +abintestate +abiogenesis +abiogenesist +abiogenetic +abiogenetical +abiogenetically +abiogenist +abiogenous +abiogeny +abiological +abiologically +abiology +abiosis +abiotic +abiotrophic +abiotrophy +Abipon +abir +abirritant +abirritate +abirritation +abirritative +abiston +Abitibi +abiuret +abject +abjectedness +abjection +abjective +abjectly +abjectness +abjoint +abjudge +abjudicate +abjudication +abjunction +abjunctive +abjuration +abjuratory +abjure +abjurement +abjurer +abkar +abkari +Abkhas +Abkhasian +ablach +ablactate +ablactation +ablare +ablastemic +ablastous +ablate +ablation +ablatitious +ablatival +ablative +ablator +ablaut +ablaze +able +ableeze +ablegate +ableness +ablepharia +ablepharon +ablepharous +Ablepharus +ablepsia +ableptical +ableptically +abler +ablest +ablewhackets +ablins +abloom +ablow +ablude +abluent +ablush +ablution +ablutionary +abluvion +ably +abmho +Abnaki +abnegate +abnegation +abnegative +abnegator +Abner +abnerval +abnet +abneural +abnormal +abnormalism +abnormalist +abnormality +abnormalize +abnormally +abnormalness +abnormity +abnormous +abnumerable +Abo +aboard +Abobra +abode +abodement +abody +abohm +aboil +abolish +abolisher +abolishment +abolition +abolitionary +abolitionism +abolitionist +abolitionize +abolla +aboma +abomasum +abomasus +abominable +abominableness +abominably +abominate +abomination +abominator +abomine +Abongo +aboon +aborad +aboral +aborally +abord +aboriginal +aboriginality +aboriginally +aboriginary +aborigine +abort +aborted +aborticide +abortient +abortifacient +abortin +abortion +abortional +abortionist +abortive +abortively +abortiveness +abortus +abouchement +abound +abounder +abounding +aboundingly +about +abouts +above +aboveboard +abovedeck +aboveground +aboveproof +abovestairs +abox +abracadabra +abrachia +abradant +abrade +abrader +Abraham +Abrahamic +Abrahamidae +Abrahamite +Abrahamitic +abraid +Abram +Abramis +abranchial +abranchialism +abranchian +Abranchiata +abranchiate +abranchious +abrasax +abrase +abrash +abrasiometer +abrasion +abrasive +abrastol +abraum +abraxas +abreact +abreaction +abreast +abrenounce +abret +abrico +abridge +abridgeable +abridged +abridgedly +abridger +abridgment +abrim +abrin +abristle +abroach +abroad +Abrocoma +abrocome +abrogable +abrogate +abrogation +abrogative +abrogator +Abroma +Abronia +abrook +abrotanum +abrotine +abrupt +abruptedly +abruption +abruptly +abruptness +Abrus +Absalom +absampere +Absaroka +absarokite +abscess +abscessed +abscession +abscessroot +abscind +abscise +abscision +absciss +abscissa +abscissae +abscisse +abscission +absconce +abscond +absconded +abscondedly +abscondence +absconder +absconsa +abscoulomb +absence +absent +absentation +absentee +absenteeism +absenteeship +absenter +absently +absentment +absentmindedly +absentness +absfarad +abshenry +Absi +absinthe +absinthial +absinthian +absinthiate +absinthic +absinthin +absinthine +absinthism +absinthismic +absinthium +absinthol +absit +absmho +absohm +absolute +absolutely +absoluteness +absolution +absolutism +absolutist +absolutistic +absolutistically +absolutive +absolutization +absolutize +absolutory +absolvable +absolvatory +absolve +absolvent +absolver +absolvitor +absolvitory +absonant +absonous +absorb +absorbability +absorbable +absorbed +absorbedly +absorbedness +absorbefacient +absorbency +absorbent +absorber +absorbing +absorbingly +absorbition +absorpt +absorptance +absorptiometer +absorptiometric +absorption +absorptive +absorptively +absorptiveness +absorptivity +absquatulate +abstain +abstainer +abstainment +abstemious +abstemiously +abstemiousness +abstention +abstentionist +abstentious +absterge +abstergent +abstersion +abstersive +abstersiveness +abstinence +abstinency +abstinent +abstinential +abstinently +abstract +abstracted +abstractedly +abstractedness +abstracter +abstraction +abstractional +abstractionism +abstractionist +abstractitious +abstractive +abstractively +abstractiveness +abstractly +abstractness +abstractor +abstrahent +abstricted +abstriction +abstruse +abstrusely +abstruseness +abstrusion +abstrusity +absume +absumption +absurd +absurdity +absurdly +absurdness +absvolt +Absyrtus +abterminal +abthain +abthainrie +abthainry +abthanage +Abu +abu +abucco +abulia +abulic +abulomania +abuna +abundance +abundancy +abundant +Abundantia +abundantly +abura +aburabozu +aburban +aburst +aburton +abusable +abuse +abusedly +abusee +abuseful +abusefully +abusefulness +abuser +abusion +abusious +abusive +abusively +abusiveness +abut +Abuta +Abutilon +abutment +abuttal +abutter +abutting +abuzz +abvolt +abwab +aby +abysm +abysmal +abysmally +abyss +abyssal +Abyssinian +abyssobenthonic +abyssolith +abyssopelagic +acacatechin +acacatechol +acacetin +Acacia +Acacian +acaciin +acacin +academe +academial +academian +Academic +academic +academical +academically +academicals +academician +academicism +academism +academist +academite +academization +academize +Academus +academy +Acadia +acadialite +Acadian +Acadie +Acaena +acajou +acaleph +Acalepha +Acalephae +acalephan +acalephoid +acalycal +acalycine +acalycinous +acalyculate +Acalypha +Acalypterae +Acalyptrata +Acalyptratae +acalyptrate +Acamar +acampsia +acana +acanaceous +acanonical +acanth +acantha +Acanthaceae +acanthaceous +acanthad +Acantharia +Acanthia +acanthial +acanthin +acanthine +acanthion +acanthite +acanthocarpous +Acanthocephala +acanthocephalan +Acanthocephali +acanthocephalous +Acanthocereus +acanthocladous +Acanthodea +acanthodean +Acanthodei +Acanthodes +acanthodian +Acanthodidae +Acanthodii +Acanthodini +acanthoid +Acantholimon +acanthological +acanthology +acantholysis +acanthoma +Acanthomeridae +acanthon +Acanthopanax +Acanthophis +acanthophorous +acanthopod +acanthopodous +acanthopomatous +acanthopore +acanthopteran +Acanthopteri +acanthopterous +acanthopterygian +Acanthopterygii +acanthosis +acanthous +Acanthuridae +Acanthurus +acanthus +acapnia +acapnial +acapsular +acapu +acapulco +acara +Acarapis +acardia +acardiac +acari +acarian +acariasis +acaricidal +acaricide +acarid +Acarida +Acaridea +acaridean +acaridomatium +acariform +Acarina +acarine +acarinosis +acarocecidium +acarodermatitis +acaroid +acarol +acarologist +acarology +acarophilous +acarophobia +acarotoxic +acarpelous +acarpous +Acarus +Acastus +acatalectic +acatalepsia +acatalepsy +acataleptic +acatallactic +acatamathesia +acataphasia +acataposis +acatastasia +acatastatic +acate +acategorical +acatery +acatharsia +acatharsy +acatholic +acaudal +acaudate +acaulescent +acauline +acaulose +acaulous +acca +accede +accedence +acceder +accelerable +accelerando +accelerant +accelerate +accelerated +acceleratedly +acceleration +accelerative +accelerator +acceleratory +accelerograph +accelerometer +accend +accendibility +accendible +accension +accensor +accent +accentless +accentor +accentuable +accentual +accentuality +accentually +accentuate +accentuation +accentuator +accentus +accept +acceptability +acceptable +acceptableness +acceptably +acceptance +acceptancy +acceptant +acceptation +accepted +acceptedly +accepter +acceptilate +acceptilation +acception +acceptive +acceptor +acceptress +accerse +accersition +accersitor +access +accessarily +accessariness +accessary +accessaryship +accessibility +accessible +accessibly +accession +accessional +accessioner +accessive +accessively +accessless +accessorial +accessorily +accessoriness +accessorius +accessory +accidence +accidency +accident +accidental +accidentalism +accidentalist +accidentality +accidentally +accidentalness +accidented +accidential +accidentiality +accidently +accidia +accidie +accinge +accipient +Accipiter +accipitral +accipitrary +Accipitres +accipitrine +accismus +accite +acclaim +acclaimable +acclaimer +acclamation +acclamator +acclamatory +acclimatable +acclimatation +acclimate +acclimatement +acclimation +acclimatizable +acclimatization +acclimatize +acclimatizer +acclimature +acclinal +acclinate +acclivitous +acclivity +acclivous +accloy +accoast +accoil +accolade +accoladed +accolated +accolent +accolle +accombination +accommodable +accommodableness +accommodate +accommodately +accommodateness +accommodating +accommodatingly +accommodation +accommodational +accommodative +accommodativeness +accommodator +accompanier +accompaniment +accompanimental +accompanist +accompany +accompanyist +accompletive +accomplice +accompliceship +accomplicity +accomplish +accomplishable +accomplished +accomplisher +accomplishment +accomplisht +accompt +accord +accordable +accordance +accordancy +accordant diff --git a/testsuite/tests/lib/Data.ByteString/bytestring002.stdout b/testsuite/tests/lib/Data.ByteString/bytestring002.stdout new file mode 100644 index 0000000000..83b33d238d --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring002.stdout @@ -0,0 +1 @@ +1000 diff --git a/testsuite/tests/lib/Data.ByteString/bytestring003.hs b/testsuite/tests/lib/Data.ByteString/bytestring003.hs new file mode 100644 index 0000000000..c31ab8d17f --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring003.hs @@ -0,0 +1,36 @@ +{-# OPTIONS -cpp #-} + +-- +-- 'sums' benchmark from the great language shootout +-- + +import System.IO +import qualified Data.ByteString as B +import Data.ByteString (ByteString) +import Data.ByteString.Unsafe (unsafeTail,unsafeIndex) +import Data.Char -- seems to help! + +#define STRICT2(f) f a b | a `seq` b `seq` False = undefined + +main = print . go 0 =<< B.getContents + +STRICT2(go) +go i ps + | B.null ps = i + | x == 45 = neg 0 xs + | otherwise = pos (parse x) xs + where + (x, xs) = (ps `unsafeIndex` 0, unsafeTail ps) + + STRICT2(neg) + neg n qs | x == 10 = go (i-n) xs + | otherwise = neg (parse x + (10 * n)) xs + where (x, xs) = (qs `unsafeIndex` 0, unsafeTail qs) + + STRICT2(pos) + pos n qs | x == 10 = go (i+n) xs + | otherwise = pos (parse x + (10 * n)) xs + where (x, xs) = (qs `unsafeIndex` 0, unsafeTail qs) + +parse w = fromIntegral (w - 48) :: Int +{-# INLINE parse #-} diff --git a/testsuite/tests/lib/Data.ByteString/bytestring003.stdin b/testsuite/tests/lib/Data.ByteString/bytestring003.stdin new file mode 100644 index 0000000000..956aba1447 --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring003.stdin @@ -0,0 +1,1000 @@ +276 +498 +-981 +770 +-401 +702 +966 +950 +-853 +-53 +-293 +604 +288 +892 +-697 +204 +96 +408 +880 +-7 +-817 +422 +-261 +-485 +-77 +826 +184 +864 +-751 +626 +812 +-369 +-353 +-371 +488 +-83 +-659 +24 +524 +-21 +840 +-757 +-17 +-973 +-843 +260 +858 +-389 +-521 +-99 +482 +-561 +-213 +630 +766 +932 +112 +-419 +-877 +762 +266 +-837 +170 +834 +746 +764 +922 +-89 +576 +-63 +90 +684 +316 +506 +-959 +708 +70 +252 +-747 +342 +-593 +-895 +-937 +-707 +350 +588 +-201 +-683 +-113 +-511 +-867 +322 +202 +472 +150 +-9 +-643 +28 +336 +86 +-925 +836 +-473 +-451 +-971 +-805 +-619 +84 +-67 +806 +270 +366 +334 +-555 +-557 +-331 +-409 +-553 +-145 +-71 +528 +490 +492 +828 +628 +-961 +536 +-859 +-271 +974 +-671 +-749 +414 +-257 +778 +56 +598 +-437 +-899 +-785 +-987 +32 +-999 +132 +-821 +-209 +402 +-543 +194 +-967 +294 +-943 +-285 +-483 +-97 +660 +-481 +-829 +-309 +-597 +-855 +80 +-355 +192 +-823 +436 +916 +282 +-629 +612 +-329 +-535 +780 +-47 +706 +110 +756 +-857 +-933 +-345 +-523 +718 +-31 +902 +678 +540 +698 +456 +-399 +126 +412 +-563 +-321 +-487 +-641 +-195 +-199 +-955 +772 +570 +18 +-217 +886 +984 +-721 +-995 +46 +-989 +946 +64 +716 +-719 +-869 +-579 +776 +450 +936 +980 +-439 +-977 +-455 +-997 +6 +268 +-269 +-421 +328 +352 +578 +-575 +476 +976 +-57 +-469 +544 +582 +-43 +510 +-939 +-581 +-337 +-203 +-737 +-827 +852 +-279 +-803 +-911 +-865 +548 +48 +-75 +416 +-275 +688 +-255 +-687 +-461 +-233 +420 +912 +-901 +-299 +12 +568 +694 +-411 +-883 +-327 +-361 +-339 +646 +-137 +-905 +670 +686 +-131 +-849 +-825 +256 +228 +-841 +68 +368 +-909 +242 +298 +118 +10 +222 +954 +-493 +-459 +-445 +608 +-765 +34 +468 +-715 +690 +-185 +-551 +-571 +-241 +292 +92 +768 +-923 +956 +614 +8 +730 +208 +-417 +300 +136 +-59 +-251 +-539 +166 +798 +866 +454 +-391 +-317 +668 +502 +-15 +994 +854 +-189 +666 +446 +-565 +-5 +42 +-227 +-87 +-779 +26 +312 +354 +754 +396 +-515 +220 +872 +654 +88 +-667 +250 +572 +952 +72 +982 +972 +-529 +-471 +-533 +-427 +538 +154 +-457 +-819 +750 +152 +452 +-41 +838 +-489 +418 +-649 +-637 +-197 +74 +394 +-653 +-727 +-435 +-23 +348 +638 +-611 +914 +-357 +-743 +-685 +580 +-247 +-577 +54 +-931 +-3 +558 +-793 +-443 +-759 +162 +-811 +384 +720 +-117 +900 +-519 +-39 +744 +432 +286 +-873 +380 +-167 +-283 +430 +-155 +-755 +206 +100 +364 +-677 +332 +-567 +382 +-605 +-181 +676 +-475 +-845 +910 +546 +14 +398 +616 +-769 +424 +992 +-235 +-239 +774 +478 +-919 +168 +-771 +-773 +-69 +-509 +930 +550 +-463 +178 +-861 +-761 +-795 +234 +-831 +-61 +-979 +-851 +-665 +-709 +896 +742 +-123 +590 +-693 +-887 +-379 +144 +-717 +20 +174 +82 +464 +30 +-969 +-349 +-531 +-799 +-661 +-647 +-623 +878 +148 +-545 +238 +-259 +554 +726 +-37 +-797 +98 +78 +-591 +-975 +962 +120 +906 +-207 +656 +-171 +652 +188 +672 +-133 +-91 +224 +818 +-333 +-839 +-499 +22 +-739 +142 +378 +-403 +-315 +370 +284 +122 +230 +-527 +-127 +442 +534 +160 +722 +262 +-657 +304 +258 +-103 +960 +-495 +-265 +634 +-101 +480 +-363 +308 +76 +-949 +-585 +904 +146 +-703 +164 +850 +246 +732 +-725 +566 +274 +-163 +-935 +-681 +-229 +254 +-733 +-547 +-273 +-903 +736 +-711 +794 +392 +-655 +-549 +808 +-429 +484 +-701 +-617 +804 +36 +-775 +-335 +-927 +714 +-177 +-325 +-413 +-963 +114 +-253 +-789 +-645 +40 +434 +898 +924 +-19 +738 +788 +280 +-121 +594 +-913 +426 +816 +-373 +-45 +340 +-109 +-323 +58 +-249 +940 +-297 +988 +998 +-607 +-745 +-633 +-115 +996 +-893 +696 +400 +848 +500 +-263 +562 +-807 +-105 +-603 +658 +-73 +-863 +448 +680 +-157 +-161 +728 +814 +-477 +-375 +1000 +-631 +-991 +362 +156 +-187 +-705 +-917 +-449 +-741 +556 +440 +-589 +-11 +-359 +-891 +-801 +-153 +-381 +938 +-173 +-243 +618 +-599 +-497 +486 +128 +790 +460 +-27 +-305 +-205 +-215 +324 +-341 +50 +458 +52 +-621 +874 +386 +560 +-569 +-51 +802 +786 +920 +-425 +466 +444 +-507 +-915 +346 +622 +-679 +784 +-689 +388 +508 +-613 +-313 +-447 +564 +-897 +-211 +-225 +-615 +-367 +186 +894 +-65 +-453 +-245 +602 +496 +-651 +-601 +820 +226 +-695 +-119 +372 +180 +94 +214 +542 +648 +-871 +592 +584 +824 +796 +374 +-945 +-311 +516 +942 +-221 +-433 +200 +-465 +-953 +870 +868 +-879 +518 +356 +-223 +682 +990 +-191 +-541 +-951 +-921 +-319 +-169 +-291 +-289 +792 +876 +306 +-491 +326 +-885 +62 +514 +-929 +318 +-231 +632 +44 +-107 +644 +-267 +-343 +-847 +934 +734 +-505 +-351 +574 +-627 +636 +-93 +-431 +-835 +428 +-183 +-151 +2 +-813 +-595 +958 +-141 +692 +-385 +610 +-179 +376 +948 +198 +-675 +964 +-907 +918 +-165 +-1 +406 +748 +-111 +532 +-55 +-281 +740 +504 +236 +-29 +662 +-713 +-537 +196 +-587 +822 +-135 +700 +-35 +674 +-407 +240 +-673 +-669 +-393 +470 +-525 +-875 +-383 +-625 +296 +-85 +-147 +-277 +800 +-691 +-143 +16 +-983 +-303 +290 +-139 +172 +320 +512 +596 +640 +664 +-791 +-783 +-387 +-735 +-467 +-301 +810 +134 +216 +278 +176 +606 +140 +-787 +978 +586 +890 +882 +-753 +-13 +970 +-941 +-175 +-777 +-809 +-441 +-347 +-377 +390 +-423 +842 +642 +190 +302 +438 +704 +310 +-49 +124 +-781 +-287 +724 +-767 +830 +620 +-295 +244 +-159 +-307 +-397 +66 +-237 +314 +-79 +624 +710 +272 +-365 +928 +856 +138 +-479 +520 +832 +862 +760 +846 +-81 +106 +-513 +-193 +650 +782 +-517 +944 +218 +712 +-663 +-559 +462 +-635 +-25 +182 +530 +844 +330 +-833 +102 +-881 +108 +-947 +-763 +-405 +232 +410 +104 +-729 +-149 +-889 +888 +360 +968 +908 +116 +-815 +-129 +522 +-723 +-993 +860 +-503 +926 +-219 +-415 +60 +158 +-609 +-501 +986 +-699 +-583 +884 +212 +210 +-957 +526 +-985 +552 +344 +-395 +-95 +338 +248 +494 +130 +404 +358 +600 +-639 +-125 +-33 +-965 +752 +474 +-731 +758 +-573 +4 +38 +264 diff --git a/testsuite/tests/lib/Data.ByteString/bytestring003.stdout b/testsuite/tests/lib/Data.ByteString/bytestring003.stdout new file mode 100644 index 0000000000..1b79f38e25 --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring003.stdout @@ -0,0 +1 @@ +500 diff --git a/testsuite/tests/lib/Data.ByteString/bytestring004.hs b/testsuite/tests/lib/Data.ByteString/bytestring004.hs new file mode 100644 index 0000000000..5c4df86a90 --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring004.hs @@ -0,0 +1,564 @@ +#!/usr/bin/env runhaskell +-- +-- Uses multi-param type classes +-- + +import Test.QuickCheck.Batch +import Test.QuickCheck +import Text.Show.Functions + +import Data.Char +import Data.Int +import Data.List +import Data.Maybe +import Data.Word + +import System.IO +import System.Environment +import System.IO.Unsafe +import System.Random + +import Control.Monad ( liftM2 ) +import Control.Monad.Instances () + +import Text.Printf +import Debug.Trace + +import Foreign.Ptr + +import Data.ByteString.Lazy (ByteString(..), pack , unpack) +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Internal as L + +import Data.ByteString.Fusion +import qualified Data.ByteString as P +import qualified Data.ByteString.Lazy as L + +import qualified Data.ByteString.Char8 as PC +import qualified Data.ByteString.Lazy.Char8 as LC +import qualified Data.ByteString as P +import qualified Data.ByteString.Internal as P +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy.Char8 as D +import Data.ByteString.Fusion + +import Prelude hiding (abs) + +-- Enable this to get verbose test output. Including the actual tests. +debug = False + +mytest :: Testable a => a -> Int -> IO () +mytest a n = mycheck defaultConfig + { configMaxTest=n + , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a + +mycheck :: Testable a => Config -> a -> IO () +mycheck config a = + do let rnd = mkStdGen 99 + mytests config (evaluate a) rnd 0 0 [] + +mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO () +mytests config gen rnd0 ntest nfail stamps + | ntest == configMaxTest config = do done "OK," ntest stamps + | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps + | otherwise = + do putStr (configEvery config ntest (arguments result)) >> hFlush stdout + case ok result of + Nothing -> + mytests config gen rnd1 ntest (nfail+1) stamps + Just True -> + mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps) + Just False -> + putStr ( "Falsifiable after " + ++ show ntest + ++ " tests:\n" + ++ unlines (arguments result) + ) >> hFlush stdout + where + result = generate (configSize config ntest) rnd2 gen + (rnd1,rnd2) = split rnd0 + +done :: String -> Int -> [[String]] -> IO () +done mesg ntest stamps = + do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table ) + where + table = display + . map entry + . reverse + . sort + . map pairLength + . group + . sort + . filter (not . null) + $ stamps + + display [] = ".\n" + display [x] = " (" ++ x ++ ").\n" + display xs = ".\n" ++ unlines (map (++ ".") xs) + + pairLength xss@(xs:_) = (length xss, xs) + entry (n, xs) = percentage n ntest + ++ " " + ++ concat (intersperse ", " xs) + + percentage n m = show ((100 * n) `div` m) ++ "%" + +------------------------------------------------------------------------ + +instance Arbitrary Char where + arbitrary = choose ('a', 'i') + coarbitrary c = variant (ord c `rem` 4) + +instance (Arbitrary a, Arbitrary b) => Arbitrary (PairS a b) where + arbitrary = liftM2 (:*:) arbitrary arbitrary + coarbitrary (a :*: b) = coarbitrary a . coarbitrary b + +instance Arbitrary Word8 where + arbitrary = choose (97, 105) + coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4)) + +instance Arbitrary Int64 where + arbitrary = sized $ \n -> choose (-fromIntegral n,fromIntegral n) + coarbitrary n = variant (fromIntegral (if n >= 0 then 2*n else 2*(-n) + 1)) + +instance Arbitrary a => Arbitrary (MaybeS a) where + arbitrary = do a <- arbitrary ; elements [NothingS, JustS a] + coarbitrary NothingS = variant 0 + coarbitrary _ = variant 1 -- ok? + +{- +instance Arbitrary Char where + arbitrary = choose ('\0', '\255') -- since we have to test words, unlines too + coarbitrary c = variant (ord c `rem` 16) + +instance Arbitrary Word8 where + arbitrary = choose (minBound, maxBound) + coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 16)) +-} + +instance Random Word8 where + randomR = integralRandomR + random = randomR (minBound,maxBound) + +instance Random Int64 where + randomR = integralRandomR + random = randomR (minBound,maxBound) + +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) + +instance Arbitrary L.ByteString where + arbitrary = arbitrary >>= return . L.fromChunks . filter (not. P.null) -- maintain the invariant. + coarbitrary s = coarbitrary (L.unpack s) + +instance Arbitrary P.ByteString where + arbitrary = P.pack `fmap` arbitrary + coarbitrary s = coarbitrary (P.unpack s) + +------------------------------------------------------------------------ +-- +-- We're doing two forms of testing here. Firstly, model based testing. +-- For our Lazy and strict bytestring types, we have model types: +-- +-- i.e. Lazy == Byte +-- \\ // +-- List +-- +-- That is, the Lazy type can be modeled by functions in both the Byte +-- and List type. For each of the 3 models, we have a set of tests that +-- check those types match. +-- +-- The Model class connects a type and its model type, via a conversion +-- function. +-- +-- +class Model a b where + model :: a -> b -- get the abstract vale from a concrete value + +-- +-- Connecting our Lazy and Strict types to their models. We also check +-- the data invariant on Lazy types. +-- +-- These instances represent the arrows in the above diagram +-- +instance Model B P where model = abstr . checkInvariant +instance Model P [W] where model = P.unpack +instance Model P [Char] where model = PC.unpack +instance Model B [W] where model = L.unpack . checkInvariant +instance Model B [Char] where model = LC.unpack . checkInvariant + +-- Types are trivially modeled by themselves +instance Model Bool Bool where model = id +instance Model Int Int where model = id +instance Model Int64 Int64 where model = id +instance Model Int64 Int where model = fromIntegral +instance Model Word8 Word8 where model = id +instance Model Ordering Ordering where model = id + +-- More structured types are modeled recursively, using the NatTrans class from Gofer. +class (Functor f, Functor g) => NatTrans f g where + eta :: f a -> g a + +-- The transformation of the same type is identity +instance NatTrans [] [] where eta = id +instance NatTrans Maybe Maybe where eta = id +instance NatTrans ((->) X) ((->) X) where eta = id +instance NatTrans ((->) W) ((->) W) where eta = id + +-- We have a transformation of pairs, if the pairs are in Model +instance Model f g => NatTrans ((,) f) ((,) g) where eta (f,a) = (model f, a) + +-- And finally, we can take any (m a) to (n b), if we can Model m n, and a b +instance (NatTrans m n, Model a b) => Model (m a) (n b) where model x = fmap model (eta x) + +------------------------------------------------------------------------ + +-- In a form more useful for QC testing (and it's lazy) +checkInvariant :: L.ByteString -> L.ByteString +checkInvariant cs0 = check cs0 + where check L.Empty = L.Empty + check (L.Chunk c cs) + | P.null c = error ("invariant violation: " ++ show cs0) + | otherwise = L.Chunk c (check cs) + +abstr :: L.ByteString -> P.ByteString +abstr = P.concat . L.toChunks + +-- Some short hand. +type X = Int +type W = Word8 +type P = P.ByteString +type B = L.ByteString + +------------------------------------------------------------------------ +-- +-- These comparison functions handle wrapping and equality. +-- +-- A single class for these would be nice, but note that they differe in +-- the number of arguments, and those argument types, so we'd need HList +-- tricks. See here: http://okmij.org/ftp/Haskell/vararg-fn.lhs +-- + +eq1 f g = \a -> + model (f a) == g (model a) +eq2 f g = \a b -> + model (f a b) == g (model a) (model b) +eq3 f g = \a b c -> + model (f a b c) == g (model a) (model b) (model c) +eq4 f g = \a b c d -> + model (f a b c d) == g (model a) (model b) (model c) (model d) +eq5 f g = \a b c d e -> + model (f a b c d e) == g (model a) (model b) (model c) (model d) (model e) + +-- +-- And for functions that take non-null input +-- +eqnotnull1 f g = \x -> (not (isNull x)) ==> eq1 f g x +eqnotnull2 f g = \x y -> (not (isNull y)) ==> eq2 f g x y +eqnotnull3 f g = \x y z -> (not (isNull z)) ==> eq3 f g x y z + +class IsNull t where isNull :: t -> Bool +instance IsNull L.ByteString where isNull = L.null +instance IsNull P.ByteString where isNull = P.null + +main = do + x <- getArgs + let n = if null x then 100 else read . head $ x + mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests + +-- +-- Test that, after loop fusion, our code behaves the same as the +-- unfused lazy or list models. Use -ddump-simpl to also check that +-- rules are firing for each case. +-- +tests = -- 29/5/06, all tests are fusing: + [("down/down list", mytest prop_downdown_list) -- checked + ,("down/filter list", mytest prop_downfilter_list) -- checked + ,("down/map list", mytest prop_downmap_list) -- checked + ,("filter/down lazy", mytest prop_filterdown_lazy) -- checked + ,("filter/down list", mytest prop_filterdown_list) -- checked + ,("filter/filter lazy", mytest prop_filterfilter_lazy) -- checked + ,("filter/filter list", mytest prop_filterfilter_list) -- checked + ,("filter/map lazy", mytest prop_filtermap_lazy) -- checked + ,("filter/map list", mytest prop_filtermap_list) -- checked + ,("filter/up lazy", mytest prop_filterup_lazy) -- checked + ,("filter/up list", mytest prop_filterup_list) -- checked + ,("map/down lazy", mytest prop_mapdown_lazy) -- checked + ,("map/down list", mytest prop_mapdown_list) -- checked + ,("map/filter lazy", mytest prop_mapfilter_lazy) -- checked + ,("map/filter list", mytest prop_mapfilter_list) -- checked + ,("map/map lazy", mytest prop_mapmap_lazy) -- checked + ,("map/map list", mytest prop_mapmap_list) -- checked + ,("map/up lazy", mytest prop_mapup_lazy) -- checked + ,("map/up list", mytest prop_mapup_list) -- checked + ,("up/filter lazy", mytest prop_upfilter_lazy) -- checked + ,("up/filter list", mytest prop_upfilter_list) -- checked + ,("up/map lazy", mytest prop_upmap_lazy) -- checked + ,("up/map list", mytest prop_upmap_list) -- checked + ,("up/up lazy", mytest prop_upup_lazy) -- checked + ,("up/up list", mytest prop_upup_list) -- checked + ,("noacc/noacc lazy", mytest prop_noacc_noacc_lazy) -- checked + ,("noacc/noacc list", mytest prop_noacc_noacc_list) -- checked + ,("noacc/up lazy", mytest prop_noacc_up_lazy) -- checked + ,("noacc/up list", mytest prop_noacc_up_list) -- checked + ,("up/noacc lazy", mytest prop_up_noacc_lazy) -- checked + ,("up/noacc list", mytest prop_up_noacc_list) -- checked + ,("map/noacc lazy", mytest prop_map_noacc_lazy) -- checked + ,("map/noacc list", mytest prop_map_noacc_list) -- checked + ,("noacc/map lazy", mytest prop_noacc_map_lazy) -- checked + ,("noacc/map list", mytest prop_noacc_map_list) -- checked + ,("filter/noacc lazy", mytest prop_filter_noacc_lazy) -- checked + ,("filter/noacc list", mytest prop_filter_noacc_list) -- checked + ,("noacc/filter lazy", mytest prop_noacc_filter_lazy) -- checked + ,("noacc/filter list", mytest prop_noacc_filter_list) -- checked + ,("noacc/down lazy", mytest prop_noacc_down_lazy) -- checked + ,("noacc/down list", mytest prop_noacc_down_list) -- checked +-- ,("down/noacc lazy", mytest prop_down_noacc_lazy) -- checked + ,("down/noacc list", mytest prop_down_noacc_list) -- checked + + + ,("length/loop list", mytest prop_lengthloop_list) +-- ,("length/loop lazy", mytest prop_lengthloop_lazy) + ,("maximum/loop list", mytest prop_maximumloop_list) +-- ,("maximum/loop lazy", mytest prop_maximumloop_lazy) + ,("minimum/loop list", mytest prop_minimumloop_list) +-- ,("minimum/loop lazy", mytest prop_minimumloop_lazy) + + ] + +prop_upup_list = eq3 + (\f g -> P.foldl f (0::Int) . P.scanl g (0::W)) + ((\f g -> foldl f (0::Int) . scanl g (0::W)) :: (X -> W -> X) -> (W -> W -> W) -> [W] -> X) + +prop_upup_lazy = eq3 + (\f g -> L.foldl f (0::X) . L.scanl g (0::W)) + (\f g -> P.foldl f (0::X) . P.scanl g (0::W)) + +prop_mapmap_list = eq3 + (\f g -> P.map f . P.map g) + ((\f g -> map f . map g) :: (W -> W) -> (W -> W) -> [W] -> [W]) + +prop_mapmap_lazy = eq3 + (\f g -> L.map f . L.map g) + (\f g -> P.map f . P.map g) + +prop_filterfilter_list = eq3 + (\f g -> P.filter f . P.filter g) + ((\f g -> filter f . filter g) :: (W -> Bool) -> (W -> Bool) -> [W] -> [W]) + +prop_filterfilter_lazy = eq3 + (\f g -> L.filter f . L.filter g) + (\f g -> P.filter f . P.filter g) + +prop_mapfilter_list = eq3 + (\f g -> P.filter f . P.map g) + ((\f g -> filter f . map g) :: (W -> Bool) -> (W -> W) -> [W] -> [W]) + +prop_mapfilter_lazy = eq3 + (\f g -> L.filter f . L.map g) + (\f g -> P.filter f . P.map g) + +prop_filtermap_list = eq3 + (\f g -> P.map f . P.filter g) + ((\f g -> map f . filter g) :: (W -> W) -> (W -> Bool) -> [W] -> [W]) + +prop_filtermap_lazy = eq3 + (\f g -> L.map f . L.filter g) + (\f g -> P.map f . P.filter g) + +prop_mapup_list = eq3 + (\f g -> P.foldl g (0::W) . P.map f) + ((\f g -> foldl g (0::W) . map f) :: (W -> W) -> (W -> W -> W) -> [W] -> W) + +prop_mapup_lazy = eq3 + (\f g -> L.foldl g (0::W) . L.map f) -- n.b. scan doesn't fuse here, atm + (\f g -> P.foldl g (0::W) . P.map f) + +prop_upmap_list = eq3 + (\f g -> P.map f . P.scanl g (0::W)) + ((\f g -> map f . scanl g (0::W)) :: (W -> W) -> (W -> W -> W) -> [W] -> [W]) + +prop_upmap_lazy = eq3 + (\f g -> L.map f . L.scanl g (0::W)) + (\f g -> P.map f . P.scanl g (0::W)) + +prop_filterup_list = eq3 + (\f g -> P.foldl g (0::W) . P.filter f) + ((\f g -> foldl g (0::W) . filter f) :: (W -> Bool) -> (W -> W -> W) -> [W] -> W) + +prop_filterup_lazy = eq3 + (\f g -> L.foldl g (0::W) . L.filter f) + (\f g -> P.foldl g (0::W) . P.filter f) + +prop_upfilter_list = eq3 + (\f g -> P.filter f . P.scanl g (0::W)) + ((\f g -> filter f . scanl g (0::W)) :: (W -> Bool) -> (W -> W -> W) -> [W] -> [W]) + +prop_upfilter_lazy = eq3 + (\f g -> L.filter f . L.scanl g (0::W)) + (\f g -> P.filter f . P.scanl g (0::W)) + +prop_downdown_list = eq3 + (\f g -> P.foldr f (0::X) . P.scanr g (0::W)) + ((\f g -> foldr f (0::X) . scanr g (0::W)) :: (W -> X -> X) -> (W -> W -> W) -> [W] -> X) + +{- +-- no lazy scanr yet +prop_downdown_lazy = eq3 + (\f g -> L.foldr f (0::X) . L.scanr g (0::W)) + (\f g -> P.foldr f (0::X) . P.scanr g (0::W)) +-} + +prop_mapdown_list = eq3 + (\f g -> P.foldr g (0::W) . P.map f) + ((\f g -> foldr g (0::W) . map f) :: (W -> W) -> (W -> W -> W) -> [W] -> W) + +prop_mapdown_lazy = eq3 + (\f g -> L.foldr g (0::W) . L.map f) -- n.b. scan doesn't fuse here, atm + (\f g -> P.foldr g (0::W) . P.map f) + +prop_downmap_list = eq3 + (\f g -> P.map f . P.scanr g (0::W)) + ((\f g -> map f . scanr g (0::W)) :: (W -> W) -> (W -> W -> W) -> [W] -> [W]) + +{- +prop_downmap_lazy = eq3 + (\f g -> L.map f . L.scanr g (0::W)) + (\f g -> P.map f . P.scanr g (0::W)) +-} + +prop_filterdown_list = eq3 + (\f g -> P.foldr g (0::W) . P.filter f) + ((\f g -> foldr g (0::W) . filter f) :: (W -> Bool) -> (W -> W -> W) -> [W] -> W) + +prop_filterdown_lazy = eq3 + (\f g -> L.foldr g (0::W) . L.filter f) -- n.b. scan doesn't fuse here, atm + (\f g -> P.foldr g (0::W) . P.filter f) + +prop_downfilter_list = eq3 + (\f g -> P.filter f . P.scanr g (0::W)) + ((\f g -> filter f . scanr g (0::W)) :: (W -> Bool) -> (W -> W -> W) -> [W] -> [W]) + +{- +prop_downfilter_lazy = eq3 + (\f g -> L.filter f . L.scanr g (0::W)) + (\f g -> P.filter f . P.scanr g (0::W)) +-} + +prop_noacc_noacc_list = eq5 + (\f g h i -> (P.map f . P.filter g) . (P.map h . P.filter i)) + ((\f g h i -> ( map f . filter g) . ( map h . filter i)) + :: (W -> W) -> (W -> Bool) -> (W -> W) -> (W -> Bool) -> [W] -> [W]) + +prop_noacc_noacc_lazy = eq5 + (\f g h i -> (L.map f . L.filter g) . (L.map h . L.filter i)) + (\f g h i -> (P.map f . P.filter g) . (P.map h . P.filter i)) + +prop_noacc_up_list = eq4 + ( \g h i -> P.foldl g (0::W) . (P.map h . P.filter i)) + ((\g h i -> foldl g (0::W) . ( map h . filter i)) + :: (W -> W -> W) -> (W -> W) -> (W -> Bool) -> [W] -> W) + +prop_noacc_up_lazy = eq4 + (\g h i -> L.foldl g (0::W) . (L.map h . L.filter i)) + (\g h i -> P.foldl g (0::W) . (P.map h . P.filter i)) + +prop_up_noacc_list = eq4 + ( \g h i -> (P.map h . P.filter i) . P.scanl g (0::W)) + ((\g h i -> ( map h . filter i) . scanl g (0::W)) + :: (W -> W -> W) -> (W -> W) -> (W -> Bool) -> [W] -> [W]) + +prop_up_noacc_lazy = eq4 + (\g h i -> (L.map h . L.filter i) . L.scanl g (0::W)) + (\g h i -> (P.map h . P.filter i) . P.scanl g (0::W)) + +prop_map_noacc_list = eq4 + ( \g h i -> (P.map h . P.filter i) . P.map g) + ((\g h i -> ( map h . filter i) . map g) + :: (W -> W) -> (W -> W) -> (W -> Bool) -> [W] -> [W]) + +prop_map_noacc_lazy = eq4 + (\g h i -> (L.map h . L.filter i) . L.map g) + (\g h i -> (P.map h . P.filter i) . P.map g) + +prop_noacc_map_list = eq4 + ( \g h i -> P.map g . (P.map h . P.filter i)) + ((\g h i -> map g . ( map h . filter i)) + :: (W -> W) -> (W -> W) -> (W -> Bool) -> [W] -> [W]) + +prop_noacc_map_lazy = eq4 + (\g h i -> L.map g . (L.map h . L.filter i)) + (\g h i -> P.map g . (P.map h . P.filter i)) + +prop_filter_noacc_list = eq4 + ( \g h i -> (P.map h . P.filter i) . P.filter g) + ((\g h i -> ( map h . filter i) . filter g) + :: (W -> Bool) -> (W -> W) -> (W -> Bool) -> [W] -> [W]) + +prop_filter_noacc_lazy = eq4 + (\g h i -> (L.map h . L.filter i) . L.filter g) + (\g h i -> (P.map h . P.filter i) . P.filter g) + +prop_noacc_filter_list = eq4 + ( \g h i -> P.filter g . (P.map h . P.filter i)) + ((\g h i -> filter g . ( map h . filter i)) + :: (W -> Bool) -> (W -> W) -> (W -> Bool) -> [W] -> [W]) + +prop_noacc_filter_lazy = eq4 + (\g h i -> L.filter g . (L.map h . L.filter i)) + (\g h i -> P.filter g . (P.map h . P.filter i)) + +prop_noacc_down_list = eq4 + ( \g h i -> P.foldr g (0::W) . (P.map h . P.filter i)) + ((\g h i -> foldr g (0::W) . ( map h . filter i)) + :: (W -> W -> W) -> (W -> W) -> (W -> Bool) -> [W] -> W) + +prop_noacc_down_lazy = eq4 + (\g h i -> L.foldr g (0::W) . (L.map h . L.filter i)) + (\g h i -> P.foldr g (0::W) . (P.map h . P.filter i)) + +prop_down_noacc_list = eq4 + ( \g h i -> (P.map h . P.filter i) . P.scanr g (0::W)) + ((\g h i -> ( map h . filter i) . scanr g (0::W)) + :: (W -> W -> W) -> (W -> W) -> (W -> Bool) -> [W] -> [W]) + +{- +prop_down_noacc_lazy = eq4 + (\g h i -> (L.map h . L.filter i) . L.scanl g (0::W)) + (\g h i -> (P.map h . P.filter i) . P.scanl g (0::W)) +-} + +------------------------------------------------------------------------ + +prop_lengthloop_list = eq2 + (\f -> P.length . P.filter f) + ((\f -> length . filter f) :: (W -> Bool) -> [W] -> X) + +{- +prop_lengthloop_lazy = eq2 + (\f g -> L.length . L.filter f) -- n.b. scan doesn't fuse here, atm + (\f g -> P.length . P.filter f) +-} + +prop_maximumloop_list = eqnotnull2 + (\f -> P.maximum . P.map f) -- so we don't get null strings + ((\f -> maximum . map f) :: (W -> W) -> [W] -> W) + +{- +prop_maximumloop_lazy = eq2 + (\f g -> L.maximum . L.filter f) -- n.b. scan doesn't fuse here, atm + (\f g -> P.maximum . P.filter f) +-} + +prop_minimumloop_list = eqnotnull2 + (\f -> P.minimum . P.map f) + ((\f -> minimum . map f) :: (W -> W) -> [W] -> W) + +{- +prop_minimumloop_lazy = eq2 + (\f g -> L.minimum . L.filter f) -- n.b. scan doesn't fuse here, atm + (\f g -> P.minimum . P.filter f) +-} + diff --git a/testsuite/tests/lib/Data.ByteString/bytestring004.stdout b/testsuite/tests/lib/Data.ByteString/bytestring004.stdout new file mode 100644 index 0000000000..cbc88dbf91 --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring004.stdout @@ -0,0 +1,45 @@ +down/down list : OK, 100 tests. +down/filter list : OK, 100 tests. +down/map list : OK, 100 tests. +filter/down lazy : OK, 100 tests. +filter/down list : OK, 100 tests. +filter/filter lazy : OK, 100 tests. +filter/filter list : OK, 100 tests. +filter/map lazy : OK, 100 tests. +filter/map list : OK, 100 tests. +filter/up lazy : OK, 100 tests. +filter/up list : OK, 100 tests. +map/down lazy : OK, 100 tests. +map/down list : OK, 100 tests. +map/filter lazy : OK, 100 tests. +map/filter list : OK, 100 tests. +map/map lazy : OK, 100 tests. +map/map list : OK, 100 tests. +map/up lazy : OK, 100 tests. +map/up list : OK, 100 tests. +up/filter lazy : OK, 100 tests. +up/filter list : OK, 100 tests. +up/map lazy : OK, 100 tests. +up/map list : OK, 100 tests. +up/up lazy : OK, 100 tests. +up/up list : OK, 100 tests. +noacc/noacc lazy : OK, 100 tests. +noacc/noacc list : OK, 100 tests. +noacc/up lazy : OK, 100 tests. +noacc/up list : OK, 100 tests. +up/noacc lazy : OK, 100 tests. +up/noacc list : OK, 100 tests. +map/noacc lazy : OK, 100 tests. +map/noacc list : OK, 100 tests. +noacc/map lazy : OK, 100 tests. +noacc/map list : OK, 100 tests. +filter/noacc lazy : OK, 100 tests. +filter/noacc list : OK, 100 tests. +noacc/filter lazy : OK, 100 tests. +noacc/filter list : OK, 100 tests. +noacc/down lazy : OK, 100 tests. +noacc/down list : OK, 100 tests. +down/noacc list : OK, 100 tests. +length/loop list : OK, 100 tests. +maximum/loop list : OK, 100 tests. +minimum/loop list : OK, 100 tests. diff --git a/testsuite/tests/lib/Data.ByteString/bytestring005.hs b/testsuite/tests/lib/Data.ByteString/bytestring005.hs new file mode 100644 index 0000000000..7bd37da004 --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring005.hs @@ -0,0 +1,1138 @@ +#!/usr/bin/env runhaskell +-- +-- Uses multi-param type classes +-- + +import Test.QuickCheck +import Text.Show.Functions + +import Data.Char +import Data.Int +import Data.List +import Data.Maybe +import Data.Word + +import System.IO +import System.Environment +import System.IO.Unsafe +import System.Random + +import Control.Monad ( liftM2 ) +import Control.Monad.Instances () + +import Text.Printf +import Debug.Trace + +import Foreign.Ptr + +import Data.ByteString.Lazy (ByteString(..), pack , unpack) +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy.Internal as L + +import Data.ByteString.Fusion +import qualified Data.ByteString as P +import qualified Data.ByteString.Unsafe as P +import qualified Data.ByteString.Lazy as L + +import qualified Data.ByteString.Char8 as PC +import qualified Data.ByteString.Lazy.Char8 as LC +import qualified Data.ByteString as P +import qualified Data.ByteString.Internal as P +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy.Char8 as D +import Data.ByteString.Fusion + +import Prelude hiding (abs) + +-- Enable this to get verbose test output. Including the actual tests. +debug = False + +mytest :: Testable a => a -> Int -> IO () +mytest a n = mycheck defaultConfig + { configMaxTest=n + , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a + +mycheck :: Testable a => Config -> a -> IO () +mycheck config a = + do let rnd = mkStdGen 99 + mytests config (evaluate a) rnd 0 0 [] + +mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO () +mytests config gen rnd0 ntest nfail stamps + | ntest == configMaxTest config = do done "OK," ntest stamps + | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps + | otherwise = + do putStr (configEvery config ntest (arguments result)) >> hFlush stdout + case ok result of + Nothing -> + mytests config gen rnd1 ntest (nfail+1) stamps + Just True -> + mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps) + Just False -> + putStr ( "Falsifiable after " + ++ show ntest + ++ " tests:\n" + ++ unlines (arguments result) + ) >> hFlush stdout + where + result = generate (configSize config ntest) rnd2 gen + (rnd1,rnd2) = split rnd0 + +done :: String -> Int -> [[String]] -> IO () +done mesg ntest stamps = + do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table ) + where + table = display + . map entry + . reverse + . sort + . map pairLength + . group + . sort + . filter (not . null) + $ stamps + + display [] = ".\n" + display [x] = " (" ++ x ++ ").\n" + display xs = ".\n" ++ unlines (map (++ ".") xs) + + pairLength xss@(xs:_) = (length xss, xs) + entry (n, xs) = percentage n ntest + ++ " " + ++ concat (intersperse ", " xs) + + percentage n m = show ((100 * n) `div` m) ++ "%" + +------------------------------------------------------------------------ + +instance Arbitrary Char where + arbitrary = choose ('a', 'i') + coarbitrary c = variant (ord c `rem` 4) + +instance (Arbitrary a, Arbitrary b) => Arbitrary (PairS a b) where + arbitrary = liftM2 (:*:) arbitrary arbitrary + coarbitrary (a :*: b) = coarbitrary a . coarbitrary b + +instance Arbitrary Word8 where + arbitrary = choose (97, 105) + coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4)) + +instance Arbitrary Int64 where + arbitrary = sized $ \n -> choose (-fromIntegral n,fromIntegral n) + coarbitrary n = variant (fromIntegral (if n >= 0 then 2*n else 2*(-n) + 1)) + +instance Arbitrary a => Arbitrary (MaybeS a) where + arbitrary = do a <- arbitrary ; elements [NothingS, JustS a] + coarbitrary NothingS = variant 0 + coarbitrary _ = variant 1 -- ok? + +{- +instance Arbitrary Char where + arbitrary = choose ('\0', '\255') -- since we have to test words, unlines too + coarbitrary c = variant (ord c `rem` 16) + +instance Arbitrary Word8 where + arbitrary = choose (minBound, maxBound) + coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 16)) +-} + +instance Random Word8 where + randomR = integralRandomR + random = randomR (minBound,maxBound) + +instance Random Int64 where + randomR = integralRandomR + random = randomR (minBound,maxBound) + +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) + +instance Arbitrary L.ByteString where + arbitrary = arbitrary >>= return . L.fromChunks . filter (not. P.null) -- maintain the invariant. + coarbitrary s = coarbitrary (L.unpack s) + +instance Arbitrary P.ByteString where + arbitrary = P.pack `fmap` arbitrary + coarbitrary s = coarbitrary (P.unpack s) + +------------------------------------------------------------------------ +-- +-- We're doing two forms of testing here. Firstly, model based testing. +-- For our Lazy and strict bytestring types, we have model types: +-- +-- i.e. Lazy == Byte +-- \\ // +-- List +-- +-- That is, the Lazy type can be modeled by functions in both the Byte +-- and List type. For each of the 3 models, we have a set of tests that +-- check those types match. +-- +-- The Model class connects a type and its model type, via a conversion +-- function. +-- +-- +class Model a b where + model :: a -> b -- get the abstract vale from a concrete value + +-- +-- Connecting our Lazy and Strict types to their models. We also check +-- the data invariant on Lazy types. +-- +-- These instances represent the arrows in the above diagram +-- +instance Model B P where model = abstr . checkInvariant +instance Model P [W] where model = P.unpack +instance Model P [Char] where model = PC.unpack +instance Model B [W] where model = L.unpack . checkInvariant +instance Model B [Char] where model = LC.unpack . checkInvariant + +-- Types are trivially modeled by themselves +instance Model Bool Bool where model = id +instance Model Int Int where model = id +instance Model Int64 Int64 where model = id +instance Model Int64 Int where model = fromIntegral +instance Model Word8 Word8 where model = id +instance Model Ordering Ordering where model = id + +-- More structured types are modeled recursively, using the NatTrans class from Gofer. +class (Functor f, Functor g) => NatTrans f g where + eta :: f a -> g a + +-- The transformation of the same type is identity +instance NatTrans [] [] where eta = id +instance NatTrans Maybe Maybe where eta = id +instance NatTrans ((->) X) ((->) X) where eta = id +instance NatTrans ((->) W) ((->) W) where eta = id + +-- We have a transformation of pairs, if the pairs are in Model +instance Model f g => NatTrans ((,) f) ((,) g) where eta (f,a) = (model f, a) + +-- And finally, we can take any (m a) to (n b), if we can Model m n, and a b +instance (NatTrans m n, Model a b) => Model (m a) (n b) where model x = fmap model (eta x) + +------------------------------------------------------------------------ + +-- In a form more useful for QC testing (and it's lazy) +checkInvariant :: L.ByteString -> L.ByteString +checkInvariant cs0 = check cs0 + where check L.Empty = L.Empty + check (L.Chunk c cs) + | P.null c = error ("invariant violation: " ++ show cs0) + | otherwise = L.Chunk c (check cs) + +abstr :: L.ByteString -> P.ByteString +abstr = P.concat . L.toChunks + +-- Some short hand. +type X = Int +type W = Word8 +type P = P.ByteString +type B = L.ByteString + +------------------------------------------------------------------------ +-- +-- These comparison functions handle wrapping and equality. +-- +-- A single class for these would be nice, but note that they differe in +-- the number of arguments, and those argument types, so we'd need HList +-- tricks. See here: http://okmij.org/ftp/Haskell/vararg-fn.lhs +-- + +eq1 f g = \a -> + model (f a) == g (model a) +eq2 f g = \a b -> + model (f a b) == g (model a) (model b) +eq3 f g = \a b c -> + model (f a b c) == g (model a) (model b) (model c) +eq4 f g = \a b c d -> + model (f a b c d) == g (model a) (model b) (model c) (model d) +eq5 f g = \a b c d e -> + model (f a b c d e) == g (model a) (model b) (model c) (model d) (model e) + +-- +-- And for functions that take non-null input +-- +eqnotnull1 f g = \x -> (not (isNull x)) ==> eq1 f g x +eqnotnull2 f g = \x y -> (not (isNull y)) ==> eq2 f g x y +eqnotnull3 f g = \x y z -> (not (isNull z)) ==> eq3 f g x y z + +class IsNull t where isNull :: t -> Bool +instance IsNull L.ByteString where isNull = L.null +instance IsNull P.ByteString where isNull = P.null + +------------------------------------------------------------------------ + +-- +-- These are miscellaneous tests left over. Or else they test some +-- property internal to a type (i.e. head . sort == minimum), without +-- reference to a model type. +-- + +invariant :: L.ByteString -> Bool +invariant L.Empty = True +invariant (L.Chunk c cs) = not (P.null c) && invariant cs + +prop_invariant = invariant + +prop_eq_refl x = x == (x :: ByteString) +prop_eq_symm x y = (x == y) == (y == (x :: ByteString)) + +prop_eq1 xs = xs == (unpack . pack $ xs) +prop_eq2 xs = xs == (xs :: ByteString) +prop_eq3 xs ys = (xs == ys) == (unpack xs == unpack ys) + +prop_compare1 xs = (pack xs `compare` pack xs) == EQ +prop_compare2 xs c = (pack (xs++[c]) `compare` pack xs) == GT +prop_compare3 xs c = (pack xs `compare` pack (xs++[c])) == LT + +prop_compare4 xs = (not (null xs)) ==> (pack xs `compare` L.empty) == GT +prop_compare5 xs = (not (null xs)) ==> (L.empty `compare` pack xs) == LT +prop_compare6 xs ys = (not (null ys)) ==> (pack (xs++ys) `compare` pack xs) == GT + +prop_compare7 x y = x `compare` y == (L.singleton x `compare` L.singleton y) +prop_compare8 xs ys = xs `compare` ys == (L.pack xs `compare` L.pack ys) + +prop_empty1 = L.length L.empty == 0 +prop_empty2 = L.unpack L.empty == [] + +prop_packunpack s = (L.unpack . L.pack) s == id s +prop_unpackpack s = (L.pack . L.unpack) s == id s + +prop_null xs = null (L.unpack xs) == L.null xs + +prop_length1 xs = fromIntegral (length xs) == L.length (L.pack xs) + +prop_length2 xs = L.length xs == length1 xs + where length1 ys + | L.null ys = 0 + | otherwise = 1 + length1 (L.tail ys) + +prop_cons1 c xs = unpack (L.cons c (pack xs)) == (c:xs) +prop_cons2 c = L.singleton c == (c `L.cons` L.empty) +prop_cons3 c = unpack (L.singleton c) == (c:[]) +prop_cons4 c = (c `L.cons` L.empty) == pack (c:[]) + +prop_snoc1 xs c = xs ++ [c] == unpack ((pack xs) `L.snoc` c) + +prop_head xs = (not (null xs)) ==> head xs == (L.head . pack) xs +prop_head1 xs = not (L.null xs) ==> L.head xs == head (L.unpack xs) + +prop_tail xs = not (L.null xs) ==> L.tail xs == pack (tail (unpack xs)) +prop_tail1 xs = (not (null xs)) ==> tail xs == (unpack . L.tail . pack) xs + +prop_last xs = (not (null xs)) ==> last xs == (L.last . pack) xs + +prop_init xs = + (not (null xs)) ==> + init xs == (unpack . L.init . pack) xs + +prop_append1 xs = (xs ++ xs) == (unpack $ pack xs `L.append` pack xs) +prop_append2 xs ys = (xs ++ ys) == (unpack $ pack xs `L.append` pack ys) +prop_append3 xs ys = L.append xs ys == pack (unpack xs ++ unpack ys) + +prop_map1 f xs = L.map f (pack xs) == pack (map f xs) +prop_map2 f g xs = L.map f (L.map g xs) == L.map (f . g) xs +prop_map3 f xs = map f xs == (unpack . L.map f . pack) xs + +prop_filter1 c xs = (filter (/=c) xs) == (unpack $ L.filter (/=c) (pack xs)) +prop_filter2 p xs = (filter p xs) == (unpack $ L.filter p (pack xs)) + +prop_reverse xs = reverse xs == (unpack . L.reverse . pack) xs +prop_reverse1 xs = L.reverse (pack xs) == pack (reverse xs) +prop_reverse2 xs = reverse (unpack xs) == (unpack . L.reverse) xs + +prop_transpose xs = (transpose xs) == ((map unpack) . L.transpose . (map pack)) xs + +prop_foldl f c xs = L.foldl f c (pack xs) == foldl f c xs + where _ = c :: Char + +prop_foldr f c xs = L.foldl f c (pack xs) == foldl f c xs + where _ = c :: Char + +prop_foldl_1 xs = L.foldl (\xs c -> c `L.cons` xs) L.empty xs == L.reverse xs +prop_foldr_1 xs = L.foldr (\c xs -> c `L.cons` xs) L.empty xs == id xs + +prop_foldl1_1 xs = + (not . L.null) xs ==> + L.foldl1 (\x c -> if c > x then c else x) xs == + L.foldl (\x c -> if c > x then c else x) 0 xs + +prop_foldl1_2 xs = + (not . L.null) xs ==> + L.foldl1 const xs == L.head xs + +prop_foldl1_3 xs = + (not . L.null) xs ==> + L.foldl1 (flip const) xs == L.last xs + +prop_foldr1_1 xs = + (not . L.null) xs ==> + L.foldr1 (\c x -> if c > x then c else x) xs == + L.foldr (\c x -> if c > x then c else x) 0 xs + +prop_foldr1_2 xs = + (not . L.null) xs ==> + L.foldr1 (flip const) xs == L.last xs + +prop_foldr1_3 xs = + (not . L.null) xs ==> + L.foldr1 const xs == L.head xs + +prop_concat1 xs = (concat [xs,xs]) == (unpack $ L.concat [pack xs, pack xs]) +prop_concat2 xs = (concat [xs,[]]) == (unpack $ L.concat [pack xs, pack []]) +prop_concat3 xss = L.concat (map pack xss) == pack (concat xss) + +prop_concatMap xs = L.concatMap L.singleton xs == (pack . concatMap (:[]) . unpack) xs + +prop_any xs a = (any (== a) xs) == (L.any (== a) (pack xs)) +prop_all xs a = (all (== a) xs) == (L.all (== a) (pack xs)) + +prop_maximum xs = (not (null xs)) ==> (maximum xs) == (L.maximum ( pack xs )) +prop_minimum xs = (not (null xs)) ==> (minimum xs) == (L.minimum ( pack xs )) + +prop_replicate1 n c = + (n >= 0) ==> unpack (L.replicate (fromIntegral n) c) == replicate n c + +prop_replicate2 c = unpack (L.replicate 0 c) == replicate 0 c + +prop_take1 i xs = L.take (fromIntegral i) (pack xs) == pack (take i xs) +prop_drop1 i xs = L.drop (fromIntegral i) (pack xs) == pack (drop i xs) + +prop_splitAt i xs = collect (i >= 0 && i < length xs) $ + L.splitAt (fromIntegral i) (pack xs) == let (a,b) = splitAt i xs in (pack a, pack b) + +prop_takeWhile f xs = L.takeWhile f (pack xs) == pack (takeWhile f xs) +prop_dropWhile f xs = L.dropWhile f (pack xs) == pack (dropWhile f xs) + +prop_break f xs = L.break f (pack xs) == + let (a,b) = break f xs in (pack a, pack b) + +prop_breakspan xs c = L.break (==c) xs == L.span (/=c) xs + +prop_span xs a = (span (/=a) xs) == (let (x,y) = L.span (/=a) (pack xs) in (unpack x, unpack y)) + +-- prop_breakByte xs c = L.break (== c) xs == L.breakByte c xs + +-- prop_spanByte c xs = (L.span (==c) xs) == L.spanByte c xs + +prop_split c xs = (map L.unpack . map checkInvariant . L.split c $ xs) + == (map P.unpack . P.split c . P.pack . L.unpack $ xs) + +prop_splitWith f xs = (l1 == l2 || l1 == l2+1) && + sum (map L.length splits) == L.length xs - l2 + where splits = L.splitWith f xs + l1 = fromIntegral (length splits) + l2 = L.length (L.filter f xs) + +prop_joinsplit c xs = L.intercalate (pack [c]) (L.split c xs) == id xs + +prop_group xs = group xs == (map unpack . L.group . pack) xs +-- prop_groupBy f xs = groupBy f xs == (map unpack . L.groupBy f . pack) xs + +-- prop_joinjoinByte xs ys c = L.joinWithByte c xs ys == L.join (L.singleton c) [xs,ys] + +prop_index xs = + not (null xs) ==> + forAll indices $ \i -> (xs !! i) == L.pack xs `L.index` (fromIntegral i) + where indices = choose (0, length xs -1) + +prop_elemIndex xs c = (elemIndex c xs) == fmap fromIntegral (L.elemIndex c (pack xs)) + +prop_elemIndices xs c = elemIndices c xs == map fromIntegral (L.elemIndices c (pack xs)) + +prop_count c xs = length (L.elemIndices c xs) == fromIntegral (L.count c xs) + +prop_findIndex xs f = (findIndex f xs) == fmap fromIntegral (L.findIndex f (pack xs)) +prop_findIndicies xs f = (findIndices f xs) == map fromIntegral (L.findIndices f (pack xs)) + +prop_elem xs c = (c `elem` xs) == (c `L.elem` (pack xs)) +prop_notElem xs c = (c `notElem` xs) == (L.notElem c (pack xs)) +prop_elem_notelem xs c = c `L.elem` xs == not (c `L.notElem` xs) + +-- prop_filterByte xs c = L.filterByte c xs == L.filter (==c) xs +-- prop_filterByte2 xs c = unpack (L.filterByte c xs) == filter (==c) (unpack xs) + +-- prop_filterNotByte xs c = L.filterNotByte c xs == L.filter (/=c) xs +-- prop_filterNotByte2 xs c = unpack (L.filterNotByte c xs) == filter (/=c) (unpack xs) + +prop_find p xs = find p xs == L.find p (pack xs) + +prop_find_findIndex p xs = + L.find p xs == case L.findIndex p xs of + Just n -> Just (xs `L.index` n) + _ -> Nothing + +prop_isPrefixOf xs ys = isPrefixOf xs ys == (pack xs `L.isPrefixOf` pack ys) + +{- +prop_sort1 xs = sort xs == (unpack . L.sort . pack) xs +prop_sort2 xs = (not (null xs)) ==> (L.head . L.sort . pack $ xs) == minimum xs +prop_sort3 xs = (not (null xs)) ==> (L.last . L.sort . pack $ xs) == maximum xs +prop_sort4 xs ys = + (not (null xs)) ==> + (not (null ys)) ==> + (L.head . L.sort) (L.append (pack xs) (pack ys)) == min (minimum xs) (minimum ys) + +prop_sort5 xs ys = + (not (null xs)) ==> + (not (null ys)) ==> + (L.last . L.sort) (L.append (pack xs) (pack ys)) == max (maximum xs) (maximum ys) + +-} + +------------------------------------------------------------------------ +-- Misc ByteString properties + +prop_nil1BB = P.length P.empty == 0 +prop_nil2BB = P.unpack P.empty == [] + +prop_tailSBB xs = not (P.null xs) ==> P.tail xs == P.pack (tail (P.unpack xs)) + +prop_nullBB xs = null (P.unpack xs) == P.null xs + +prop_lengthBB xs = P.length xs == length1 xs + where + length1 ys + | P.null ys = 0 + | otherwise = 1 + length1 (P.tail ys) + +prop_lengthSBB xs = length xs == P.length (P.pack xs) + +prop_indexBB xs = + not (null xs) ==> + forAll indices $ \i -> (xs !! i) == P.pack xs `P.index` i + where indices = choose (0, length xs -1) + +prop_unsafeIndexBB xs = + not (null xs) ==> + forAll indices $ \i -> (xs !! i) == P.pack xs `P.unsafeIndex` i + where indices = choose (0, length xs -1) + +prop_mapfusionBB f g xs = P.map f (P.map g xs) == P.map (f . g) xs + +prop_filterBB f xs = P.filter f (P.pack xs) == P.pack (filter f xs) + +prop_filterfusionBB f g xs = P.filter f (P.filter g xs) == P.filter (\c -> f c && g c) xs + +prop_elemSBB x xs = P.elem x (P.pack xs) == elem x xs + +prop_takeSBB i xs = P.take i (P.pack xs) == P.pack (take i xs) +prop_dropSBB i xs = P.drop i (P.pack xs) == P.pack (drop i xs) + +prop_splitAtSBB i xs = -- collect (i >= 0 && i < length xs) $ + P.splitAt i (P.pack xs) == + let (a,b) = splitAt i xs in (P.pack a, P.pack b) + +prop_foldlBB f c xs = P.foldl f c (P.pack xs) == foldl f c xs + where types = c :: Char + +prop_scanlfoldlBB f z xs = not (P.null xs) ==> P.last (P.scanl f z xs) == P.foldl f z xs + +prop_foldrBB f c xs = P.foldl f c (P.pack xs) == foldl f c xs + where types = c :: Char + +prop_takeWhileSBB f xs = P.takeWhile f (P.pack xs) == P.pack (takeWhile f xs) +prop_dropWhileSBB f xs = P.dropWhile f (P.pack xs) == P.pack (dropWhile f xs) + +prop_spanSBB f xs = P.span f (P.pack xs) == + let (a,b) = span f xs in (P.pack a, P.pack b) + +prop_breakSBB f xs = P.break f (P.pack xs) == + let (a,b) = break f xs in (P.pack a, P.pack b) + +prop_breakspan_1BB xs c = P.break (== c) xs == P.span (/= c) xs + +prop_linesSBB xs = C.lines (C.pack xs) == map C.pack (lines xs) + +prop_unlinesSBB xss = C.unlines (map C.pack xss) == C.pack (unlines xss) + +prop_wordsSBB xs = + C.words (C.pack xs) == map C.pack (words xs) + +prop_unwordsSBB xss = C.unwords (map C.pack xss) == C.pack (unwords xss) + +prop_splitWithBB f xs = (l1 == l2 || l1 == l2+1) && + sum (map P.length splits) == P.length xs - l2 + where splits = P.splitWith f xs + l1 = length splits + l2 = P.length (P.filter f xs) + +prop_joinsplitBB c xs = P.intercalate (P.pack [c]) (P.split c xs) == xs + +-- prop_linessplitBB xs = +-- (not . C.null) xs ==> +-- C.lines' xs == C.split '\n' xs + +prop_linessplit2BB xs = + C.lines xs == C.split '\n' xs ++ (if C.last xs == '\n' then [C.empty] else []) + +prop_splitsplitWithBB c xs = P.split c xs == P.splitWith (== c) xs + +prop_bijectionBB c = (P.w2c . P.c2w) c == id c +prop_bijectionBB' w = (P.c2w . P.w2c) w == id w + +prop_packunpackBB s = (P.unpack . P.pack) s == id s +prop_packunpackBB' s = (P.pack . P.unpack) s == id s + +prop_eq1BB xs = xs == (P.unpack . P.pack $ xs) +prop_eq2BB xs = xs == xs +prop_eq3BB xs ys = (xs == ys) == (P.unpack xs == P.unpack ys) + +prop_compare1BB xs = (P.pack xs `compare` P.pack xs) == EQ +prop_compare2BB xs c = (P.pack (xs++[c]) `compare` P.pack xs) == GT +prop_compare3BB xs c = (P.pack xs `compare` P.pack (xs++[c])) == LT + +prop_compare4BB xs = (not (null xs)) ==> (P.pack xs `compare` P.empty) == GT +prop_compare5BB xs = (not (null xs)) ==> (P.empty `compare` P.pack xs) == LT +prop_compare6BB xs ys= (not (null ys)) ==> (P.pack (xs++ys) `compare` P.pack xs) == GT + +prop_compare7BB x y = x `compare` y == (C.singleton x `compare` C.singleton y) +prop_compare8BB xs ys = xs `compare` ys == (P.pack xs `compare` P.pack ys) + +prop_consBB c xs = P.unpack (P.cons c (P.pack xs)) == (c:xs) +prop_cons1BB xs = 'X' : xs == C.unpack ('X' `C.cons` (C.pack xs)) +prop_cons2BB xs c = c : xs == P.unpack (c `P.cons` (P.pack xs)) +prop_cons3BB c = C.unpack (C.singleton c) == (c:[]) +prop_cons4BB c = (c `P.cons` P.empty) == P.pack (c:[]) + +prop_snoc1BB xs c = xs ++ [c] == P.unpack ((P.pack xs) `P.snoc` c) + +prop_head1BB xs = (not (null xs)) ==> head xs == (P.head . P.pack) xs +prop_head2BB xs = (not (null xs)) ==> head xs == (P.unsafeHead . P.pack) xs +prop_head3BB xs = not (P.null xs) ==> P.head xs == head (P.unpack xs) + +prop_tailBB xs = (not (null xs)) ==> tail xs == (P.unpack . P.tail . P.pack) xs +prop_tail1BB xs = (not (null xs)) ==> tail xs == (P.unpack . P.unsafeTail. P.pack) xs + +prop_lastBB xs = (not (null xs)) ==> last xs == (P.last . P.pack) xs + +prop_initBB xs = + (not (null xs)) ==> + init xs == (P.unpack . P.init . P.pack) xs + +-- prop_null xs = (null xs) ==> null xs == (nullPS (pack xs)) + +prop_append1BB xs = (xs ++ xs) == (P.unpack $ P.pack xs `P.append` P.pack xs) +prop_append2BB xs ys = (xs ++ ys) == (P.unpack $ P.pack xs `P.append` P.pack ys) +prop_append3BB xs ys = P.append xs ys == P.pack (P.unpack xs ++ P.unpack ys) + +prop_map1BB f xs = P.map f (P.pack xs) == P.pack (map f xs) +prop_map2BB f g xs = P.map f (P.map g xs) == P.map (f . g) xs +prop_map3BB f xs = map f xs == (P.unpack . P.map f . P.pack) xs +-- prop_mapBB' f xs = P.map' f (P.pack xs) == P.pack (map f xs) + +prop_filter1BB xs = (filter (=='X') xs) == (C.unpack $ C.filter (=='X') (C.pack xs)) +prop_filter2BB p xs = (filter p xs) == (P.unpack $ P.filter p (P.pack xs)) + +prop_findBB p xs = find p xs == P.find p (P.pack xs) + +prop_find_findIndexBB p xs = + P.find p xs == case P.findIndex p xs of + Just n -> Just (xs `P.unsafeIndex` n) + _ -> Nothing + +prop_foldl1BB xs a = ((foldl (\x c -> if c == a then x else c:x) [] xs)) == + (P.unpack $ P.foldl (\x c -> if c == a then x else c `P.cons` x) P.empty (P.pack xs)) +prop_foldl2BB xs = P.foldl (\xs c -> c `P.cons` xs) P.empty (P.pack xs) == P.reverse (P.pack xs) + +prop_foldr1BB xs a = ((foldr (\c x -> if c == a then x else c:x) [] xs)) == + (P.unpack $ P.foldr (\c x -> if c == a then x else c `P.cons` x) + P.empty (P.pack xs)) + +prop_foldr2BB xs = P.foldr (\c xs -> c `P.cons` xs) P.empty (P.pack xs) == (P.pack xs) + +prop_foldl1_1BB xs = + (not . P.null) xs ==> + P.foldl1 (\x c -> if c > x then c else x) xs == + P.foldl (\x c -> if c > x then c else x) 0 xs + +prop_foldl1_2BB xs = + (not . P.null) xs ==> + P.foldl1 const xs == P.head xs + +prop_foldl1_3BB xs = + (not . P.null) xs ==> + P.foldl1 (flip const) xs == P.last xs + +prop_foldr1_1BB xs = + (not . P.null) xs ==> + P.foldr1 (\c x -> if c > x then c else x) xs == + P.foldr (\c x -> if c > x then c else x) 0 xs + +prop_foldr1_2BB xs = + (not . P.null) xs ==> + P.foldr1 (flip const) xs == P.last xs + +prop_foldr1_3BB xs = + (not . P.null) xs ==> + P.foldr1 const xs == P.head xs + +prop_takeWhileBB xs a = (takeWhile (/= a) xs) == (P.unpack . (P.takeWhile (/= a)) . P.pack) xs + +prop_dropWhileBB xs a = (dropWhile (/= a) xs) == (P.unpack . (P.dropWhile (/= a)) . P.pack) xs + +prop_takeBB xs = (take 10 xs) == (P.unpack . (P.take 10) . P.pack) xs + +prop_dropBB xs = (drop 10 xs) == (P.unpack . (P.drop 10) . P.pack) xs + +prop_splitAtBB i xs = -- collect (i >= 0 && i < length xs) $ + splitAt i xs == + let (x,y) = P.splitAt i (P.pack xs) in (P.unpack x, P.unpack y) + +prop_spanBB xs a = (span (/=a) xs) == (let (x,y) = P.span (/=a) (P.pack xs) + in (P.unpack x, P.unpack y)) + +prop_breakBB xs a = (break (/=a) xs) == (let (x,y) = P.break (/=a) (P.pack xs) + in (P.unpack x, P.unpack y)) + +prop_reverse1BB xs = (reverse xs) == (P.unpack . P.reverse . P.pack) xs +prop_reverse2BB xs = P.reverse (P.pack xs) == P.pack (reverse xs) +prop_reverse3BB xs = reverse (P.unpack xs) == (P.unpack . P.reverse) xs + +prop_elemBB xs a = (a `elem` xs) == (a `P.elem` (P.pack xs)) + +prop_notElemBB c xs = P.notElem c (P.pack xs) == notElem c xs + +-- should try to stress it +prop_concat1BB xs = (concat [xs,xs]) == (P.unpack $ P.concat [P.pack xs, P.pack xs]) +prop_concat2BB xs = (concat [xs,[]]) == (P.unpack $ P.concat [P.pack xs, P.pack []]) +prop_concatBB xss = P.concat (map P.pack xss) == P.pack (concat xss) + +prop_concatMapBB xs = C.concatMap C.singleton xs == (C.pack . concatMap (:[]) . C.unpack) xs + +prop_anyBB xs a = (any (== a) xs) == (P.any (== a) (P.pack xs)) +prop_allBB xs a = (all (== a) xs) == (P.all (== a) (P.pack xs)) + +prop_linesBB xs = (lines xs) == ((map C.unpack) . C.lines . C.pack) xs + +prop_unlinesBB xs = (unlines.lines) xs == (C.unpack. C.unlines . C.lines .C.pack) xs + +prop_wordsBB xs = + (words xs) == ((map C.unpack) . C.words . C.pack) xs +-- prop_wordstokensBB xs = C.words xs == C.tokens isSpace xs + +prop_unwordsBB xs = + (C.pack.unwords.words) xs == (C.unwords . C.words .C.pack) xs + +prop_groupBB xs = group xs == (map P.unpack . P.group . P.pack) xs + +prop_groupByBB xs = groupBy (==) xs == (map P.unpack . P.groupBy (==) . P.pack) xs +prop_groupBy1BB xs = groupBy (/=) xs == (map P.unpack . P.groupBy (/=) . P.pack) xs + +prop_joinBB xs ys = (concat . (intersperse ys) . lines) xs == + (C.unpack $ C.intercalate (C.pack ys) (C.lines (C.pack xs))) + +prop_elemIndex1BB xs = (elemIndex 'X' xs) == (C.elemIndex 'X' (C.pack xs)) +prop_elemIndex2BB xs c = (elemIndex c xs) == (C.elemIndex c (C.pack xs)) + +-- prop_lineIndices1BB xs = C.elemIndices '\n' xs == C.lineIndices xs + +prop_countBB c xs = length (P.elemIndices c xs) == P.count c xs + +prop_elemIndexEnd1BB c xs = (P.elemIndexEnd c (P.pack xs)) == + (case P.elemIndex c (P.pack (reverse xs)) of + Nothing -> Nothing + Just i -> Just (length xs -1 -i)) + +prop_elemIndexEnd2BB c xs = (P.elemIndexEnd c (P.pack xs)) == + ((-) (length xs - 1) `fmap` P.elemIndex c (P.pack $ reverse xs)) + +prop_elemIndicesBB xs c = elemIndices c xs == P.elemIndices c (P.pack xs) + +prop_findIndexBB xs a = (findIndex (==a) xs) == (P.findIndex (==a) (P.pack xs)) + +prop_findIndiciesBB xs c = (findIndices (==c) xs) == (P.findIndices (==c) (P.pack xs)) + +-- example properties from QuickCheck.Batch +prop_sort1BB xs = sort xs == (P.unpack . P.sort . P.pack) xs +prop_sort2BB xs = (not (null xs)) ==> (P.head . P.sort . P.pack $ xs) == minimum xs +prop_sort3BB xs = (not (null xs)) ==> (P.last . P.sort . P.pack $ xs) == maximum xs +prop_sort4BB xs ys = + (not (null xs)) ==> + (not (null ys)) ==> + (P.head . P.sort) (P.append (P.pack xs) (P.pack ys)) == min (minimum xs) (minimum ys) +prop_sort5BB xs ys = + (not (null xs)) ==> + (not (null ys)) ==> + (P.last . P.sort) (P.append (P.pack xs) (P.pack ys)) == max (maximum xs) (maximum ys) + +prop_intersperseBB c xs = (intersperse c xs) == (P.unpack $ P.intersperse c (P.pack xs)) + +prop_transposeBB xs = (transpose xs) == ((map P.unpack) . P.transpose . (map P.pack)) xs + +prop_maximumBB xs = (not (null xs)) ==> (maximum xs) == (P.maximum ( P.pack xs )) +prop_minimumBB xs = (not (null xs)) ==> (minimum xs) == (P.minimum ( P.pack xs )) + +-- prop_dropSpaceBB xs = dropWhile isSpace xs == C.unpack (C.dropSpace (C.pack xs)) +-- prop_dropSpaceEndBB xs = (C.reverse . (C.dropWhile isSpace) . C.reverse) (C.pack xs) == +-- (C.dropSpaceEnd (C.pack xs)) + +-- prop_breakSpaceBB xs = +-- (let (x,y) = C.breakSpace (C.pack xs) +-- in (C.unpack x, C.unpack y)) == (break isSpace xs) + +prop_spanEndBB xs = + (C.spanEnd (not . isSpace) (C.pack xs)) == + (let (x,y) = C.span (not.isSpace) (C.reverse (C.pack xs)) in (C.reverse y,C.reverse x)) + +prop_breakEndBB p xs = P.breakEnd (not.p) xs == P.spanEnd p xs + +-- prop_breakCharBB c xs = +-- (break (==c) xs) == +-- (let (x,y) = C.breakChar c (C.pack xs) in (C.unpack x, C.unpack y)) + +-- prop_spanCharBB c xs = +-- (break (/=c) xs) == +-- (let (x,y) = C.spanChar c (C.pack xs) in (C.unpack x, C.unpack y)) + +-- prop_spanChar_1BB c xs = +-- (C.span (==c) xs) == C.spanChar c xs + +-- prop_wordsBB' xs = +-- (C.unpack . C.unwords . C.words' . C.pack) xs == +-- (map (\c -> if isSpace c then ' ' else c) xs) + +-- prop_linesBB' xs = (C.unpack . C.unlines' . C.lines' . C.pack) xs == (xs) + +prop_unfoldrBB c n = + (fst $ C.unfoldrN n fn c) == (C.pack $ take n $ unfoldr fn c) + where + fn x = Just (x, chr (ord x + 1)) + +prop_prefixBB xs ys = isPrefixOf xs ys == (P.pack xs `P.isPrefixOf` P.pack ys) +prop_suffixBB xs ys = isSuffixOf xs ys == (P.pack xs `P.isSuffixOf` P.pack ys) + +prop_copyBB xs = let p = P.pack xs in P.copy p == p + +prop_initsBB xs = inits xs == map P.unpack (P.inits (P.pack xs)) + +prop_tailsBB xs = tails xs == map P.unpack (P.tails (P.pack xs)) + +prop_findSubstringsBB s x l + = C.findSubstrings (C.pack p) (C.pack s) == naive_findSubstrings p s + where + _ = l :: Int + _ = x :: Int + + -- we look for some random substring of the test string + p = take (model l) $ drop (model x) s + + -- naive reference implementation + naive_findSubstrings :: String -> String -> [Int] + naive_findSubstrings p s = [x | x <- [0..length s], p `isPrefixOf` drop x s] + +prop_replicate1BB n c = P.unpack (P.replicate n c) == replicate n c +prop_replicate2BB n c = P.replicate n c == fst (P.unfoldrN n (\u -> Just (u,u)) c) + +prop_replicate3BB c = P.unpack (P.replicate 0 c) == replicate 0 c + +prop_readintBB n = (fst . fromJust . C.readInt . C.pack . show) n == (n :: Int) +prop_readintLL n = (fst . fromJust . D.readInt . D.pack . show) n == (n :: Int) + +prop_readint2BB s = + let s' = filter (\c -> c `notElem` ['0'..'9']) s + in C.readInt (C.pack s') == Nothing + +-- prop_filterChar1BB c xs = (filter (==c) xs) == ((C.unpack . C.filterChar c . C.pack) xs) +-- prop_filterChar2BB c xs = (C.filter (==c) (C.pack xs)) == (C.filterChar c (C.pack xs)) +-- prop_filterChar3BB c xs = C.filterChar c xs == C.replicate (C.count c xs) c + +-- prop_filterNotChar1BB c xs = (filter (/=c) xs) == ((C.unpack . C.filterNotChar c . C.pack) xs) +-- prop_filterNotChar2BB c xs = (C.filter (/=c) (C.pack xs)) == (C.filterNotChar c (C.pack xs)) + +-- prop_joinjoinpathBB xs ys c = C.joinWithChar c xs ys == C.join (C.singleton c) [xs,ys] + +prop_zipBB xs ys = zip xs ys == P.zip (P.pack xs) (P.pack ys) +prop_zip1BB xs ys = P.zip xs ys == zip (P.unpack xs) (P.unpack ys) + +prop_zipWithBB xs ys = P.zipWith (,) xs ys == P.zip xs ys +-- prop_zipWith'BB xs ys = P.pack (P.zipWith (+) xs ys) == P.zipWith' (+) xs ys + +prop_unzipBB x = let (xs,ys) = unzip x in (P.pack xs, P.pack ys) == P.unzip x + +------------------------------------------------------------------------ +-- The entry point + +main = run tests + +run :: [(String, Int -> IO ())] -> IO () +run tests = do + x <- getArgs + let n = if null x then 100 else read . head $ x + mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests + +-- +-- And now a list of all the properties to test. +-- + +tests = bb_tests ++ ll_tests + +------------------------------------------------------------------------ +-- extra ByteString properties + +bb_tests = + [ ("bijection", mytest prop_bijectionBB) + , ("bijection'", mytest prop_bijectionBB') + , ("pack/unpack", mytest prop_packunpackBB) + , ("unpack/pack", mytest prop_packunpackBB') + , ("eq 1", mytest prop_eq1BB) + , ("eq 2", mytest prop_eq3BB) + , ("eq 3", mytest prop_eq3BB) + , ("compare 1", mytest prop_compare1BB) + , ("compare 2", mytest prop_compare2BB) + , ("compare 3", mytest prop_compare3BB) + , ("compare 4", mytest prop_compare4BB) + , ("compare 5", mytest prop_compare5BB) + , ("compare 6", mytest prop_compare6BB) + , ("compare 7", mytest prop_compare7BB) + , ("compare 8", mytest prop_compare8BB) + , ("empty 1", mytest prop_nil1BB) + , ("empty 2", mytest prop_nil2BB) + , ("null", mytest prop_nullBB) + , ("length 1", mytest prop_lengthBB) + , ("length 2", mytest prop_lengthSBB) + , ("cons 1", mytest prop_consBB) + , ("cons 2", mytest prop_cons1BB) + , ("cons 3", mytest prop_cons2BB) + , ("cons 4", mytest prop_cons3BB) + , ("cons 5", mytest prop_cons4BB) + , ("snoc", mytest prop_snoc1BB) + , ("head 1", mytest prop_head1BB) + , ("head 2", mytest prop_head2BB) + , ("head 3", mytest prop_head3BB) + , ("tail", mytest prop_tailBB) + , ("tail 1", mytest prop_tail1BB) + , ("last", mytest prop_lastBB) + , ("init", mytest prop_initBB) + , ("append 1", mytest prop_append1BB) + , ("append 2", mytest prop_append2BB) + , ("append 3", mytest prop_append3BB) + , ("map 1", mytest prop_map1BB) + , ("map 2", mytest prop_map2BB) + , ("map 3", mytest prop_map3BB) + , ("filter1", mytest prop_filter1BB) + , ("filter2", mytest prop_filter2BB) + , ("map fusion", mytest prop_mapfusionBB) + , ("filter fusion", mytest prop_filterfusionBB) + , ("reverse 1", mytest prop_reverse1BB) + , ("reverse 2", mytest prop_reverse2BB) + , ("reverse 3", mytest prop_reverse3BB) + , ("foldl 1", mytest prop_foldl1BB) + , ("foldl 2", mytest prop_foldl2BB) + , ("foldr 1", mytest prop_foldr1BB) + , ("foldr 2", mytest prop_foldr2BB) + , ("foldl1 1", mytest prop_foldl1_1BB) + , ("foldl1 2", mytest prop_foldl1_2BB) + , ("foldl1 3", mytest prop_foldl1_3BB) + , ("foldr1 1", mytest prop_foldr1_1BB) + , ("foldr1 2", mytest prop_foldr1_2BB) + , ("foldr1 3", mytest prop_foldr1_3BB) + , ("scanl/foldl", mytest prop_scanlfoldlBB) + , ("all", mytest prop_allBB) + , ("any", mytest prop_anyBB) + , ("take", mytest prop_takeBB) + , ("drop", mytest prop_dropBB) + , ("takeWhile", mytest prop_takeWhileBB) + , ("dropWhile", mytest prop_dropWhileBB) + , ("splitAt", mytest prop_splitAtBB) + , ("span", mytest prop_spanBB) + , ("break", mytest prop_breakBB) + , ("elem", mytest prop_elemBB) + , ("notElem", mytest prop_notElemBB) + , ("concat 1", mytest prop_concat1BB) + , ("concat 2", mytest prop_concat2BB) + , ("concat 3", mytest prop_concatBB) + , ("lines", mytest prop_linesBB) + , ("unlines", mytest prop_unlinesBB) + , ("words", mytest prop_wordsBB) + , ("unwords", mytest prop_unwordsBB) + , ("group", mytest prop_groupBB) + , ("groupBy", mytest prop_groupByBB) + , ("groupBy 1", mytest prop_groupBy1BB) + , ("join", mytest prop_joinBB) + , ("elemIndex 1", mytest prop_elemIndex1BB) + , ("elemIndex 2", mytest prop_elemIndex2BB) + , ("findIndex", mytest prop_findIndexBB) + , ("findIndicies", mytest prop_findIndiciesBB) + , ("elemIndices", mytest prop_elemIndicesBB) + , ("find", mytest prop_findBB) + , ("find/findIndex", mytest prop_find_findIndexBB) + , ("sort 1", mytest prop_sort1BB) + , ("sort 2", mytest prop_sort2BB) + , ("sort 3", mytest prop_sort3BB) + , ("sort 4", mytest prop_sort4BB) + , ("sort 5", mytest prop_sort5BB) + , ("intersperse", mytest prop_intersperseBB) + , ("maximum", mytest prop_maximumBB) + , ("minimum", mytest prop_minimumBB) +-- , ("breakChar", mytest prop_breakCharBB) +-- , ("spanChar 1", mytest prop_spanCharBB) +-- , ("spanChar 2", mytest prop_spanChar_1BB) +-- , ("breakSpace", mytest prop_breakSpaceBB) +-- , ("dropSpace", mytest prop_dropSpaceBB) + , ("spanEnd", mytest prop_spanEndBB) + , ("breakEnd", mytest prop_breakEndBB) + , ("elemIndexEnd 1",mytest prop_elemIndexEnd1BB) + , ("elemIndexEnd 2",mytest prop_elemIndexEnd2BB) +-- , ("words'", mytest prop_wordsBB') +-- , ("lines'", mytest prop_linesBB') +-- , ("dropSpaceEnd", mytest prop_dropSpaceEndBB) + , ("unfoldr", mytest prop_unfoldrBB) + , ("prefix", mytest prop_prefixBB) + , ("suffix", mytest prop_suffixBB) + , ("copy", mytest prop_copyBB) + , ("inits", mytest prop_initsBB) + , ("tails", mytest prop_tailsBB) + , ("findSubstrings ",mytest prop_findSubstringsBB) + , ("replicate1", mytest prop_replicate1BB) + , ("replicate2", mytest prop_replicate2BB) + , ("replicate3", mytest prop_replicate3BB) + , ("readInt", mytest prop_readintBB) + , ("readInt 2", mytest prop_readint2BB) + , ("Lazy.readInt", mytest prop_readintLL) +-- , ("filterChar1", mytest prop_filterChar1BB) +-- , ("filterChar2", mytest prop_filterChar2BB) +-- , ("filterChar3", mytest prop_filterChar3BB) +-- , ("filterNotChar1", mytest prop_filterNotChar1BB) +-- , ("filterNotChar2", mytest prop_filterNotChar2BB) + , ("tail", mytest prop_tailSBB) + , ("index", mytest prop_indexBB) + , ("unsafeIndex", mytest prop_unsafeIndexBB) +-- , ("map'", mytest prop_mapBB') + , ("filter", mytest prop_filterBB) + , ("elem", mytest prop_elemSBB) + , ("take", mytest prop_takeSBB) + , ("drop", mytest prop_dropSBB) + , ("splitAt", mytest prop_splitAtSBB) + , ("foldl", mytest prop_foldlBB) + , ("foldr", mytest prop_foldrBB) + , ("takeWhile ", mytest prop_takeWhileSBB) + , ("dropWhile ", mytest prop_dropWhileSBB) + , ("span ", mytest prop_spanSBB) + , ("break ", mytest prop_breakSBB) + , ("breakspan", mytest prop_breakspan_1BB) + , ("lines ", mytest prop_linesSBB) + , ("unlines ", mytest prop_unlinesSBB) + , ("words ", mytest prop_wordsSBB) + , ("unwords ", mytest prop_unwordsSBB) +-- , ("wordstokens", mytest prop_wordstokensBB) + , ("splitWith", mytest prop_splitWithBB) + , ("joinsplit", mytest prop_joinsplitBB) +-- , ("lineIndices", mytest prop_lineIndices1BB) + , ("count", mytest prop_countBB) +-- , ("linessplit", mytest prop_linessplitBB) + , ("splitsplitWith", mytest prop_splitsplitWithBB) +-- , ("joinjoinpath", mytest prop_joinjoinpathBB) + , ("zip", mytest prop_zipBB) + , ("zip1", mytest prop_zip1BB) + , ("zipWith", mytest prop_zipWithBB) +-- , ("zipWith'", mytest prop_zipWith'BB) + , ("unzip", mytest prop_unzipBB) + , ("concatMap", mytest prop_concatMapBB) + ] + + +------------------------------------------------------------------------ +-- Extra lazy properties + +ll_tests = + [("eq 1", mytest prop_eq1) + ,("eq 2", mytest prop_eq2) + ,("eq 3", mytest prop_eq3) + ,("eq refl", mytest prop_eq_refl) + ,("eq symm", mytest prop_eq_symm) + ,("compare 1", mytest prop_compare1) + ,("compare 2", mytest prop_compare2) + ,("compare 3", mytest prop_compare3) + ,("compare 4", mytest prop_compare4) + ,("compare 5", mytest prop_compare5) + ,("compare 6", mytest prop_compare6) + ,("compare 7", mytest prop_compare7) + ,("compare 8", mytest prop_compare8) + ,("empty 1", mytest prop_empty1) + ,("empty 2", mytest prop_empty2) + ,("pack/unpack", mytest prop_packunpack) + ,("unpack/pack", mytest prop_unpackpack) + ,("null", mytest prop_null) + ,("length 1", mytest prop_length1) + ,("length 2", mytest prop_length2) + ,("cons 1" , mytest prop_cons1) + ,("cons 2" , mytest prop_cons2) + ,("cons 3" , mytest prop_cons3) + ,("cons 4" , mytest prop_cons4) + ,("snoc" , mytest prop_snoc1) + ,("head/pack", mytest prop_head) + ,("head/unpack", mytest prop_head1) + ,("tail/pack", mytest prop_tail) + ,("tail/unpack", mytest prop_tail1) + ,("last", mytest prop_last) + ,("init", mytest prop_init) + ,("append 1", mytest prop_append1) + ,("append 2", mytest prop_append2) + ,("append 3", mytest prop_append3) + ,("map 1", mytest prop_map1) + ,("map 2", mytest prop_map2) + ,("map 3", mytest prop_map3) + ,("filter 1", mytest prop_filter1) + ,("filter 2", mytest prop_filter2) + ,("reverse", mytest prop_reverse) + ,("reverse1", mytest prop_reverse1) + ,("reverse2", mytest prop_reverse2) + ,("transpose", mytest prop_transpose) + ,("foldl", mytest prop_foldl) + ,("foldl/reverse", mytest prop_foldl_1) + ,("foldr", mytest prop_foldr) + ,("foldr/id", mytest prop_foldr_1) + ,("foldl1/foldl", mytest prop_foldl1_1) + ,("foldl1/head", mytest prop_foldl1_2) + ,("foldl1/tail", mytest prop_foldl1_3) + ,("foldr1/foldr", mytest prop_foldr1_1) + ,("foldr1/last", mytest prop_foldr1_2) + ,("foldr1/head", mytest prop_foldr1_3) + ,("concat 1", mytest prop_concat1) + ,("concat 2", mytest prop_concat2) + ,("concat/pack", mytest prop_concat3) + ,("any", mytest prop_any) + ,("all", mytest prop_all) + ,("maximum", mytest prop_maximum) + ,("minimum", mytest prop_minimum) + ,("replicate 1", mytest prop_replicate1) + ,("replicate 2", mytest prop_replicate2) + ,("take", mytest prop_take1) + ,("drop", mytest prop_drop1) + ,("splitAt", mytest prop_drop1) + ,("takeWhile", mytest prop_takeWhile) + ,("dropWhile", mytest prop_dropWhile) + ,("break", mytest prop_break) + ,("span", mytest prop_span) + ,("break/span", mytest prop_breakspan) +-- ,("break/breakByte", mytest prop_breakByte) +-- ,("span/spanByte", mytest prop_spanByte) + ,("split", mytest prop_split) + ,("splitWith", mytest prop_splitWith) + ,("join.split/id", mytest prop_joinsplit) +-- ,("join/joinByte", mytest prop_joinjoinByte) + ,("group", mytest prop_group) +-- ,("groupBy", mytest prop_groupBy) + ,("index", mytest prop_index) + ,("elemIndex", mytest prop_elemIndex) + ,("elemIndices", mytest prop_elemIndices) + ,("count/elemIndices", mytest prop_count) + ,("findIndex", mytest prop_findIndex) + ,("findIndices", mytest prop_findIndicies) + ,("find", mytest prop_find) + ,("find/findIndex", mytest prop_find_findIndex) + ,("elem", mytest prop_elem) + ,("notElem", mytest prop_notElem) + ,("elem/notElem", mytest prop_elem_notelem) +-- ,("filterByte 1", mytest prop_filterByte) +-- ,("filterByte 2", mytest prop_filterByte2) +-- ,("filterNotByte 1", mytest prop_filterNotByte) +-- ,("filterNotByte 2", mytest prop_filterNotByte2) + ,("isPrefixOf", mytest prop_isPrefixOf) + ,("concatMap", mytest prop_concatMap) + ] + diff --git a/testsuite/tests/lib/Data.ByteString/bytestring005.stdout b/testsuite/tests/lib/Data.ByteString/bytestring005.stdout new file mode 100644 index 0000000000..2efe5278dc --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring005.stdout @@ -0,0 +1,226 @@ +bijection : OK, 100 tests. +bijection' : OK, 100 tests. +pack/unpack : OK, 100 tests. +unpack/pack : OK, 100 tests. +eq 1 : OK, 100 tests. +eq 2 : OK, 100 tests. +eq 3 : OK, 100 tests. +compare 1 : OK, 100 tests. +compare 2 : OK, 100 tests. +compare 3 : OK, 100 tests. +compare 4 : OK, 100 tests. +compare 5 : OK, 100 tests. +compare 6 : OK, 100 tests. +compare 7 : OK, 100 tests. +compare 8 : OK, 100 tests. +empty 1 : OK, 100 tests. +empty 2 : OK, 100 tests. +null : OK, 100 tests. +length 1 : OK, 100 tests. +length 2 : OK, 100 tests. +cons 1 : OK, 100 tests. +cons 2 : OK, 100 tests. +cons 3 : OK, 100 tests. +cons 4 : OK, 100 tests. +cons 5 : OK, 100 tests. +snoc : OK, 100 tests. +head 1 : OK, 100 tests. +head 2 : OK, 100 tests. +head 3 : OK, 100 tests. +tail : OK, 100 tests. +tail 1 : OK, 100 tests. +last : OK, 100 tests. +init : OK, 100 tests. +append 1 : OK, 100 tests. +append 2 : OK, 100 tests. +append 3 : OK, 100 tests. +map 1 : OK, 100 tests. +map 2 : OK, 100 tests. +map 3 : OK, 100 tests. +filter1 : OK, 100 tests. +filter2 : OK, 100 tests. +map fusion : OK, 100 tests. +filter fusion : OK, 100 tests. +reverse 1 : OK, 100 tests. +reverse 2 : OK, 100 tests. +reverse 3 : OK, 100 tests. +foldl 1 : OK, 100 tests. +foldl 2 : OK, 100 tests. +foldr 1 : OK, 100 tests. +foldr 2 : OK, 100 tests. +foldl1 1 : OK, 100 tests. +foldl1 2 : OK, 100 tests. +foldl1 3 : OK, 100 tests. +foldr1 1 : OK, 100 tests. +foldr1 2 : OK, 100 tests. +foldr1 3 : OK, 100 tests. +scanl/foldl : OK, 100 tests. +all : OK, 100 tests. +any : OK, 100 tests. +take : OK, 100 tests. +drop : OK, 100 tests. +takeWhile : OK, 100 tests. +dropWhile : OK, 100 tests. +splitAt : OK, 100 tests. +span : OK, 100 tests. +break : OK, 100 tests. +elem : OK, 100 tests. +notElem : OK, 100 tests. +concat 1 : OK, 100 tests. +concat 2 : OK, 100 tests. +concat 3 : OK, 100 tests. +lines : OK, 100 tests. +unlines : OK, 100 tests. +words : OK, 100 tests. +unwords : OK, 100 tests. +group : OK, 100 tests. +groupBy : OK, 100 tests. +groupBy 1 : OK, 100 tests. +join : OK, 100 tests. +elemIndex 1 : OK, 100 tests. +elemIndex 2 : OK, 100 tests. +findIndex : OK, 100 tests. +findIndicies : OK, 100 tests. +elemIndices : OK, 100 tests. +find : OK, 100 tests. +find/findIndex : OK, 100 tests. +sort 1 : OK, 100 tests. +sort 2 : OK, 100 tests. +sort 3 : OK, 100 tests. +sort 4 : OK, 100 tests. +sort 5 : OK, 100 tests. +intersperse : OK, 100 tests. +maximum : OK, 100 tests. +minimum : OK, 100 tests. +spanEnd : OK, 100 tests. +breakEnd : OK, 100 tests. +elemIndexEnd 1 : OK, 100 tests. +elemIndexEnd 2 : OK, 100 tests. +unfoldr : OK, 100 tests. +prefix : OK, 100 tests. +suffix : OK, 100 tests. +copy : OK, 100 tests. +inits : OK, 100 tests. +tails : OK, 100 tests. +findSubstrings : OK, 100 tests. +replicate1 : OK, 100 tests. +replicate2 : OK, 100 tests. +replicate3 : OK, 100 tests. +readInt : OK, 100 tests. +readInt 2 : OK, 100 tests. +Lazy.readInt : OK, 100 tests. +tail : OK, 100 tests. +index : OK, 100 tests. +unsafeIndex : OK, 100 tests. +filter : OK, 100 tests. +elem : OK, 100 tests. +take : OK, 100 tests. +drop : OK, 100 tests. +splitAt : OK, 100 tests. +foldl : OK, 100 tests. +foldr : OK, 100 tests. +takeWhile : OK, 100 tests. +dropWhile : OK, 100 tests. +span : OK, 100 tests. +break : OK, 100 tests. +breakspan : OK, 100 tests. +lines : OK, 100 tests. +unlines : OK, 100 tests. +words : OK, 100 tests. +unwords : OK, 100 tests. +splitWith : OK, 100 tests. +joinsplit : OK, 100 tests. +count : OK, 100 tests. +splitsplitWith : OK, 100 tests. +zip : OK, 100 tests. +zip1 : OK, 100 tests. +zipWith : OK, 100 tests. +unzip : OK, 100 tests. +concatMap : OK, 100 tests. +eq 1 : OK, 100 tests. +eq 2 : OK, 100 tests. +eq 3 : OK, 100 tests. +eq refl : OK, 100 tests. +eq symm : OK, 100 tests. +compare 1 : OK, 100 tests. +compare 2 : OK, 100 tests. +compare 3 : OK, 100 tests. +compare 4 : OK, 100 tests. +compare 5 : OK, 100 tests. +compare 6 : OK, 100 tests. +compare 7 : OK, 100 tests. +compare 8 : OK, 100 tests. +empty 1 : OK, 100 tests. +empty 2 : OK, 100 tests. +pack/unpack : OK, 100 tests. +unpack/pack : OK, 100 tests. +null : OK, 100 tests. +length 1 : OK, 100 tests. +length 2 : OK, 100 tests. +cons 1 : OK, 100 tests. +cons 2 : OK, 100 tests. +cons 3 : OK, 100 tests. +cons 4 : OK, 100 tests. +snoc : OK, 100 tests. +head/pack : OK, 100 tests. +head/unpack : OK, 100 tests. +tail/pack : OK, 100 tests. +tail/unpack : OK, 100 tests. +last : OK, 100 tests. +init : OK, 100 tests. +append 1 : OK, 100 tests. +append 2 : OK, 100 tests. +append 3 : OK, 100 tests. +map 1 : OK, 100 tests. +map 2 : OK, 100 tests. +map 3 : OK, 100 tests. +filter 1 : OK, 100 tests. +filter 2 : OK, 100 tests. +reverse : OK, 100 tests. +reverse1 : OK, 100 tests. +reverse2 : OK, 100 tests. +transpose : OK, 100 tests. +foldl : OK, 100 tests. +foldl/reverse : OK, 100 tests. +foldr : OK, 100 tests. +foldr/id : OK, 100 tests. +foldl1/foldl : OK, 100 tests. +foldl1/head : OK, 100 tests. +foldl1/tail : OK, 100 tests. +foldr1/foldr : OK, 100 tests. +foldr1/last : OK, 100 tests. +foldr1/head : OK, 100 tests. +concat 1 : OK, 100 tests. +concat 2 : OK, 100 tests. +concat/pack : OK, 100 tests. +any : OK, 100 tests. +all : OK, 100 tests. +maximum : OK, 100 tests. +minimum : OK, 100 tests. +replicate 1 : OK, 100 tests. +replicate 2 : OK, 100 tests. +take : OK, 100 tests. +drop : OK, 100 tests. +splitAt : OK, 100 tests. +takeWhile : OK, 100 tests. +dropWhile : OK, 100 tests. +break : OK, 100 tests. +span : OK, 100 tests. +break/span : OK, 100 tests. +split : OK, 100 tests. +splitWith : OK, 100 tests. +join.split/id : OK, 100 tests. +group : OK, 100 tests. +index : OK, 100 tests. +elemIndex : OK, 100 tests. +elemIndices : OK, 100 tests. +count/elemIndices : OK, 100 tests. +findIndex : OK, 100 tests. +findIndices : OK, 100 tests. +find : OK, 100 tests. +find/findIndex : OK, 100 tests. +elem : OK, 100 tests. +notElem : OK, 100 tests. +elem/notElem : OK, 100 tests. +isPrefixOf : OK, 100 tests. +concatMap : OK, 100 tests. diff --git a/testsuite/tests/lib/Data.ByteString/bytestring006.hs b/testsuite/tests/lib/Data.ByteString/bytestring006.hs new file mode 100644 index 0000000000..d58147a485 --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring006.hs @@ -0,0 +1,10 @@ + +module Main (main) where + +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as L + +main :: IO () +main = do print $ map B.unpack $ B.lines $ B.pack "a\n\nb\n\nc" + print $ map L.unpack $ L.lines $ L.pack "a\n\nb\n\nc" + diff --git a/testsuite/tests/lib/Data.ByteString/bytestring006.stdout b/testsuite/tests/lib/Data.ByteString/bytestring006.stdout new file mode 100644 index 0000000000..240d746197 --- /dev/null +++ b/testsuite/tests/lib/Data.ByteString/bytestring006.stdout @@ -0,0 +1,2 @@ +["a","","b","","c"] +["a","","b","","c"] |