[commit: bytestring] master: Make the builder test suite into a cabal test-suite (43777ce)
Ian Lynagh
igloo at earth.li
Wed Feb 22 21:58:16 CET 2012
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 <duncan at community.haskell.org>
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 ()
More information about the Cvs-libraries
mailing list