diff options
Diffstat (limited to 'testsuite/tests/lib/Data.ByteString/bytestring004.hs')
| -rw-r--r-- | testsuite/tests/lib/Data.ByteString/bytestring004.hs | 564 |
1 files changed, 0 insertions, 564 deletions
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring004.hs b/testsuite/tests/lib/Data.ByteString/bytestring004.hs deleted file mode 100644 index 5c4df86a90..0000000000 --- a/testsuite/tests/lib/Data.ByteString/bytestring004.hs +++ /dev/null @@ -1,564 +0,0 @@ -#!/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) --} - |