Repository : ssh://darcs.haskell.org//srv/darcs/packages/bytestring On branch : master
http://hackage.haskell.org/trac/ghc/changeset/43777ce751ea8de4e5fb193409837a891d76bb1d >--------------------------------------------------------------- commit 43777ce751ea8de4e5fb193409837a891d76bb1d Author: Duncan Coutts <[email protected]> Date: Sun Nov 13 17:48:05 2011 +0000 Make the builder test suite into a cabal test-suite The advantage is it makes it easier to run automatically. The disadvantage is we cannot use the nice test-framework package since cabal then thinks we've got a circular dependency since test-framework indirectly depends on bytestring. This will be solvable in future with encapsulated package dependencies, but util then we use a minimal implementation of the bit of the test-framework that we're using. >--------------------------------------------------------------- bytestring.cabal | 31 +++++++++ tests/TestFramework.hs | 67 ++++++++++++++++++++ .../Lazy/Builder/BasicEncoding/TestUtils.hs | 12 +--- .../ByteString/Lazy/Builder/BasicEncoding/Tests.hs | 3 +- .../builder/Data/ByteString/Lazy/Builder/Tests.hs | 5 +- tests/builder/TestSuite.hs | 3 +- 6 files changed, 109 insertions(+), 12 deletions(-) diff --git a/bytestring.cabal b/bytestring.cabal index ce3b05e..98149f7 100644 --- a/bytestring.cabal +++ b/bytestring.cabal @@ -142,3 +142,34 @@ test-suite prop-compiled ScopedTypeVariables if impl(ghc >= 6.11) extensions: NamedFieldPuns + +test-suite test-builder + type: exitcode-stdio-1.0 + hs-source-dirs: . tests tests/builder + main-is: TestSuite.hs + + build-depends: base, ghc-prim, + deepseq, + QuickCheck >= 2.4 && < 3, + byteorder == 1.0.*, + dlist == 0.5.*, + directory == 1.1.*, + mtl == 2.0.* + + ghc-options: -Wall -fwarn-tabs + + extensions: CPP, ForeignFunctionInterface + UnliftedFFITypes, + MagicHash, + UnboxedTuples, + DeriveDataTypeable + ScopedTypeVariables + Rank2Types + BangPatterns + NamedFieldPuns + + c-sources: cbits/fpstring.c + cbits/itoa.c + include-dirs: include + includes: fpstring.h + install-includes: fpstring.h diff --git a/tests/TestFramework.hs b/tests/TestFramework.hs new file mode 100644 index 0000000..1ee5715 --- /dev/null +++ b/tests/TestFramework.hs @@ -0,0 +1,67 @@ +-- | +-- Copyright : (c) 2011 Duncan Coutts +-- +-- test-framework stub API +-- +-- Currently we cannot use the nice test-framework package for this testsuite +-- since test-framework indirectly depends on bytestring and this makes cabal +-- think we've got a circular dependency. +-- +-- On the other hand, it's very nice to have the testsuite run automatically +-- rather than being a totally separate package (which would fix). +-- +-- So until we can fix that we implement our own trivial layer. +-- +module TestFramework where + +import Test.QuickCheck (Testable(..)) +import Test.QuickCheck.Test + +import Text.Printf +import System.Environment +import Control.Monad +import Control.Exception + +-- Ideally we'd be using: + +--import Test.Framework +--import Test.Framework.Providers.QuickCheck2 + +type TestName = String +type Test = [(TestName, Int -> IO (Bool, Int))] + +testGroup :: String -> [Test] -> Test +testGroup _ = concat + +testProperty :: Testable a => String -> a -> Test +testProperty name p = [(name, runQcTest)] + where + runQcTest n = do + result <- quickCheckWithResult testArgs p + case result of + Success {} -> return (True, numTests result) + _ -> return (False, numTests result) + where + testArgs = stdArgs { + maxSuccess = n + --chatty = ... if we want to increase verbosity + } + +testCase :: String -> Bool -> Test +testCase name tst = [(name, runPlainTest)] + where + runPlainTest _ = do + r <- evaluate tst + putStrLn "+++ OK, passed test." + return (r, 1) + +defaultMain :: [Test] -> IO () +defaultMain = runTests . concat + +runTests :: [(String, Int -> IO (Bool,Int))] -> IO () +runTests tests = do + x <- getArgs + let n = if null x then 100 else read . head $ x + (results, passed) <- liftM unzip $ mapM (\(s,a) -> printf "%-40s: " s >> a n) tests + _ <- printf "Passed %d tests!\n" (sum passed) + when (not . and $ results) $ fail "Not all tests passed!" diff --git a/tests/builder/Data/ByteString/Lazy/Builder/BasicEncoding/TestUtils.hs b/tests/builder/Data/ByteString/Lazy/Builder/BasicEncoding/TestUtils.hs index d54a691..b28c1f5 100644 --- a/tests/builder/Data/ByteString/Lazy/Builder/BasicEncoding/TestUtils.hs +++ b/tests/builder/Data/ByteString/Lazy/Builder/BasicEncoding/TestUtils.hs @@ -55,7 +55,6 @@ module Data.ByteString.Lazy.Builder.BasicEncoding.TestUtils ( ) where import Control.Arrow (first) -import Control.Monad import Data.ByteString.Lazy.Builder.BasicEncoding import Data.Char (chr, ord) @@ -67,11 +66,9 @@ import Foreign import System.ByteOrder import Unsafe.Coerce (unsafeCoerce) -import Test.Framework -import Test.Framework.Providers.QuickCheck2 -import Test.Framework.Providers.HUnit -import Test.HUnit.Lang (assertFailure) import Test.QuickCheck (Arbitrary(..)) +import TestFramework + -- Helper functions ------------------- @@ -82,9 +79,8 @@ testBoundedProperty :: forall a. (Arbitrary a, Show a, Bounded a) => String -> (a -> Bool) -> Test testBoundedProperty name p = testGroup name [ testProperty "arbitrary" p - , testCase "bounds" $ do - unless (p (minBound :: a)) $ assertFailure "minBound" - unless (p (maxBound :: a)) $ assertFailure "maxBound" + , testCase "bounds" $ p (minBound :: a) + && p (maxBound :: a) ] -- | Quote a 'String' nicely. diff --git a/tests/builder/Data/ByteString/Lazy/Builder/BasicEncoding/Tests.hs b/tests/builder/Data/ByteString/Lazy/Builder/BasicEncoding/Tests.hs index 092fdad..f636838 100644 --- a/tests/builder/Data/ByteString/Lazy/Builder/BasicEncoding/Tests.hs +++ b/tests/builder/Data/ByteString/Lazy/Builder/BasicEncoding/Tests.hs @@ -24,7 +24,8 @@ import Numeric (showHex) import Foreign -import Test.Framework +import TestFramework +--import Test.Framework import Test.QuickCheck (Arbitrary) diff --git a/tests/builder/Data/ByteString/Lazy/Builder/Tests.hs b/tests/builder/Data/ByteString/Lazy/Builder/Tests.hs index d956ec1..f759ac9 100644 --- a/tests/builder/Data/ByteString/Lazy/Builder/Tests.hs +++ b/tests/builder/Data/ByteString/Lazy/Builder/Tests.hs @@ -41,8 +41,9 @@ import Control.Exception (evaluate) import System.IO import System.Directory -import Test.Framework -import Test.Framework.Providers.QuickCheck2 +import TestFramework +--import Test.Framework +--import Test.Framework.Providers.QuickCheck2 import Test.QuickCheck ( Arbitrary(..), oneof, choose, listOf, elements ) import Test.QuickCheck.Property (printTestCase) diff --git a/tests/builder/TestSuite.hs b/tests/builder/TestSuite.hs index 37aaeda..0631f4f 100644 --- a/tests/builder/TestSuite.hs +++ b/tests/builder/TestSuite.hs @@ -1,9 +1,10 @@ module Main where -import Test.Framework (defaultMain, Test, testGroup) +--import Test.Framework (defaultMain, Test, testGroup) import qualified Data.ByteString.Lazy.Builder.BasicEncoding.Tests import qualified Data.ByteString.Lazy.Builder.Tests +import TestFramework main :: IO () _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
