----------------------------------------------------------------------------- -- | -- Module : Distribution.Compat.ReadP -- Copyright : (c) The University of Glasgow 2002 -- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Portability : portable -- -- This code was originally in Distribution.Compat.ReadP. Please see that file -- for provenace. The tests have been integrated into the test framework. -- Some properties cannot be tested, as they hold over arbitrary ReadP values, -- and we don't have a good Arbitrary instance (nor Show instance) for ReadP. -- module UnitTests.Distribution.Compat.ReadP ( tests -- * Properties -- $properties ) where import Data.List import Distribution.Compat.ReadP import Test.Framework import Test.Framework.Providers.QuickCheck2 tests :: [Test] tests = [ testProperty "Get Nil" prop_Get_Nil , testProperty "Get Cons" prop_Get_Cons , testProperty "Look" prop_Look , testProperty "Fail" prop_Fail , testProperty "Return" prop_Return --, testProperty "Bind" prop_Bind --, testProperty "Plus" prop_Plus --, testProperty "LeftPlus" prop_LeftPlus --, testProperty "Gather" prop_Gather , testProperty "String Yes" prop_String_Yes , testProperty "String Maybe" prop_String_Maybe , testProperty "Munch" (prop_Munch evenChar) , testProperty "Munch1" (prop_Munch1 evenChar) --, testProperty "Choice" prop_Choice --, testProperty "ReadS" prop_ReadS ] -- --------------------------------------------------------------------------- -- QuickCheck properties that hold for the combinators {- $properties The following are QuickCheck specifications of what the combinators do. These can be seen as formal specifications of the behavior of the combinators. We use bags to give semantics to the combinators. -} type Bag a = [a] -- Equality on bags does not care about the order of elements. (=~) :: Ord a => Bag a -> Bag a -> Bool xs =~ ys = sort xs == sort ys -- A special equality operator to avoid unresolved overloading -- when testing the properties. (=~.) :: Bag (Int,String) -> Bag (Int,String) -> Bool (=~.) = (=~) -- Here follow the properties: prop_Get_Nil :: Bool prop_Get_Nil = readP_to_S get [] =~ [] prop_Get_Cons :: Char -> [Char] -> Bool prop_Get_Cons c s = readP_to_S get (c:s) =~ [(c,s)] prop_Look :: String -> Bool prop_Look s = readP_to_S look s =~ [(s,s)] prop_Fail :: String -> Bool prop_Fail s = readP_to_S pfail s =~. [] prop_Return :: Int -> String -> Bool prop_Return x s = readP_to_S (return x) s =~. [(x,s)] {- prop_Bind p k s = readP_to_S (p >>= k) s =~. [ ys'' | (x,s') <- readP_to_S p s , ys'' <- readP_to_S (k (x::Int)) s' ] prop_Plus :: ReadP Int Int -> ReadP Int Int -> String -> Bool prop_Plus p q s = readP_to_S (p +++ q) s =~. (readP_to_S p s ++ readP_to_S q s) prop_LeftPlus :: ReadP Int Int -> ReadP Int Int -> String -> Bool prop_LeftPlus p q s = readP_to_S (p <++ q) s =~. (readP_to_S p s +<+ readP_to_S q s) where [] +<+ ys = ys xs +<+ _ = xs prop_Gather s = forAll readPWithoutReadS $ \p -> readP_to_S (gather p) s =~ [ ((pre,x::Int),s') | (x,s') <- readP_to_S p s , let pre = take (length s - length s') s ] -} prop_String_Yes :: String -> [Char] -> Bool prop_String_Yes this s = readP_to_S (string this) (this ++ s) =~ [(this,s)] prop_String_Maybe :: String -> String -> Bool prop_String_Maybe this s = readP_to_S (string this) s =~ [(this, drop (length this) s) | this `isPrefixOf` s] prop_Munch :: (Char -> Bool) -> String -> Bool prop_Munch p s = readP_to_S (munch p) s =~ [(takeWhile p s, dropWhile p s)] prop_Munch1 :: (Char -> Bool) -> String -> Bool prop_Munch1 p s = readP_to_S (munch1 p) s =~ [(res,s') | let (res,s') = (takeWhile p s, dropWhile p s), not (null res)] {- prop_Choice :: [ReadP Int Int] -> String -> Bool prop_Choice ps s = readP_to_S (choice ps) s =~. readP_to_S (foldr (+++) pfail ps) s prop_ReadS :: ReadS Int -> String -> Bool prop_ReadS r s = readP_to_S (readS_to_P r) s =~. r s -} evenChar :: Char -> Bool evenChar = even . fromEnum