From 9e3384b94fc3df11b9c6df9307d5b887d106d7ff Mon Sep 17 00:00:00 2001 From: Mark Lentczner Date: Tue, 7 Aug 2012 23:23:14 -0400 Subject: [PATCH] Move ReadP tests from comments in the implementation into an actual UnitTest file. --- Cabal/Cabal.cabal | 2 + Cabal/Distribution/Compat/ReadP.hs | 95 +----------- Cabal/tests/UnitTests.hs | 7 +- .../UnitTests/Distribution/Compat/ReadP.hs | 140 ++++++++++++++++++ 4 files changed, 151 insertions(+), 93 deletions(-) create mode 100644 Cabal/tests/UnitTests/Distribution/Compat/ReadP.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index ff30befc49c..c65c652a474 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -141,7 +141,9 @@ test-suite unit-tests base, test-framework, test-framework-hunit, + test-framework-quickcheck2, HUnit, + QuickCheck, Cabal Default-Language: Haskell98 diff --git a/Cabal/Distribution/Compat/ReadP.hs b/Cabal/Distribution/Compat/ReadP.hs index 0c3d989afa3..e087ed2238a 100644 --- a/Cabal/Distribution/Compat/ReadP.hs +++ b/Cabal/Distribution/Compat/ReadP.hs @@ -19,6 +19,8 @@ -- This version of ReadP has been locally hacked to make it H98, by -- Martin Sjögren -- +-- The unit tests have been moved to UnitTest.Distribution.Compat.ReadP, by +-- Mark Lentczner ----------------------------------------------------------------------------- module Distribution.Compat.ReadP @@ -64,9 +66,6 @@ module Distribution.Compat.ReadP ReadS, -- :: *; = String -> [(a,String)] readP_to_S, -- :: ReadP a -> ReadS a readS_to_P -- :: ReadS a -> ReadP a - - -- * Properties - -- $properties ) where @@ -378,93 +377,5 @@ readS_to_P :: ReadS a -> ReadP r a readS_to_P r = R (\k -> Look (\s -> final [bs'' | (a,s') <- r s, bs'' <- run (k a) s'])) --- --------------------------------------------------------------------------- --- 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 = -> readP_to_S get [] =~ [] -> -> prop_Get_Cons c s = -> readP_to_S get (c:s) =~ [(c,s)] -> -> prop_Look s = -> readP_to_S look s =~ [(s,s)] -> -> prop_Fail s = -> readP_to_S pfail s =~. [] -> -> 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 p q s = -> readP_to_S (p +++ q) s =~. -> (readP_to_S p s ++ readP_to_S q s) -> -> 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 this s = -> readP_to_S (string this) (this ++ s) =~ -> [(this,s)] -> -> prop_String_Maybe this s = -> readP_to_S (string this) s =~ -> [(this, drop (length this) s) | this `isPrefixOf` s] -> -> prop_Munch p s = -> readP_to_S (munch p) s =~ -> [(takeWhile p s, dropWhile p s)] -> -> 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 ps s = -> readP_to_S (choice ps) s =~. -> readP_to_S (foldr (+++) pfail ps) s -> -> prop_ReadS r s = -> readP_to_S (readS_to_P r) s =~. r s --} + diff --git a/Cabal/tests/UnitTests.hs b/Cabal/tests/UnitTests.hs index 83651a439ab..87f0e28548c 100644 --- a/Cabal/tests/UnitTests.hs +++ b/Cabal/tests/UnitTests.hs @@ -5,8 +5,13 @@ module Main import Test.Framework import Test.Framework.Providers.HUnit +import qualified UnitTests.Distribution.Compat.ReadP + tests :: [Test] -tests = [] +tests = [ + testGroup "Distribution.Compat.ReadP" + UnitTests.Distribution.Compat.ReadP.tests + ] main :: IO () main = defaultMain tests diff --git a/Cabal/tests/UnitTests/Distribution/Compat/ReadP.hs b/Cabal/tests/UnitTests/Distribution/Compat/ReadP.hs new file mode 100644 index 00000000000..c9c00aa9d8d --- /dev/null +++ b/Cabal/tests/UnitTests/Distribution/Compat/ReadP.hs @@ -0,0 +1,140 @@ +----------------------------------------------------------------------------- +-- | +-- 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.HUnit +import Test.Framework.Providers.QuickCheck2 + +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 = + readP_to_S get [] =~ [] + +prop_Get_Cons c s = + readP_to_S get (c:s) =~ [(c,s)] + +prop_Look s = + readP_to_S look s =~ [(s,s)] + +prop_Fail s = + readP_to_S pfail s =~. [] + +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 p q s = + readP_to_S (p +++ q) s =~. + (readP_to_S p s ++ readP_to_S q s) + +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 this s = + readP_to_S (string this) (this ++ s) =~ + [(this,s)] + +prop_String_Maybe this s = + readP_to_S (string this) s =~ + [(this, drop (length this) s) | this `isPrefixOf` s] + +prop_Munch p s = + readP_to_S (munch p) s =~ + [(takeWhile p s, dropWhile p s)] + +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 ps s = + readP_to_S (choice ps) s =~. + readP_to_S (foldr (+++) pfail ps) s + +prop_ReadS r s = + readP_to_S (readS_to_P r) s =~. r s + +evenChar :: Char -> Bool +evenChar = even . fromEnum +