[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit 1e7c9cca3188828d50442827c3697628a166a053
Merge: 7625b8004c2f4d6ac2637c05706b9b3f7cf76687 7ef438a28345ff88ee25ad7fd7016dfa84ee7db8
Author: John Goerzen <jgoerzen at complete.org>
Date:   Mon Jan 26 13:52:43 2009 -0600

    Merge branch 'master' of jpgarch at complete.org:git/testpack

diff --combined src/Test/HUnit/Tools.hs
index 20745a5,87326f3..59d2de6
--- a/src/Test/HUnit/Tools.hs
+++ b/src/Test/HUnit/Tools.hs
@@@ -1,6 -1,11 +1,6 @@@
 -{- arch-tag: Test utilities
 -Copyright (C) 2004 - 2005 John Goerzen <jgoerzen at complete.org>
 -
 --}
 -
  {- |
     Module     : Test.HUnit.Tools
 -   Copyright  : Copyright (C) 2004-2005 John Goerzen
 +   Copyright  : Copyright (C) 2004-2009 John Goerzen
     License    : GNU LGPL, version 2 or above
  
     Maintainer : John Goerzen <jgoerzen at complete.org>
@@@ -41,6 -46,7 +41,6 @@@ mapassertEqual _ _ [] = [
  mapassertEqual descrip func ((inp,result):xs) =
      (TestCase $ assertEqual descrip result (func inp)) : mapassertEqual descrip func xs
  
 --- * Turn QuickCheck tests into HUnit tests
  -- | qccheck turns the quickcheck test into an hunit test
  qccheck :: (QC.Testable a) =>
             QC.Config -- ^ quickcheck config
@@@ -57,11 -63,14 +57,14 @@@ qccheck config lbl property 
  {- | Like 'runTestText', but with more verbose output. -}
  runVerbTestText :: HU.PutText st -> HU.Test -> IO (HU.Counts, st)
  runVerbTestText (HU.PutText put us) t = do
+   hSetBuffering stdout LineBuffering
+   hSetBuffering stderr LineBuffering
    (counts, us') <- HU.performTest reportStart reportError reportFailure us t
    us'' <- put (HU.showCounts counts) True us'
    return (counts, us'')
   where
-   reportStart ss us = do hPrintf stdout "\rTesting %-70s\n"
+   reportStart ss us = do hFlush stderr
+                          hPrintf stdout "\rTesting %-70s\n"
                                       (HU.showPath (HU.path ss))
                           hFlush stdout
                           put (HU.showCounts (HU.counts ss)) False us
@@@ -99,14 -108,7 +102,14 @@@ tests config gen rnd0 ntest nfail stamp
        (rnd1,rnd2) = split rnd0
  
  {- | Convert QuickCheck tests to HUnit, with a configurable maximum test count,
 -and running counter on the screen for long-running tests. -}
 +and running counter on the screen for long-running tests.  Often used like this:
 +
 +>q :: QC.Testable a => String -> a -> HU.Test
 +>q = qc2hu 250
 +>
 +>allt = [q "Int -> Integer" prop_int_to_integer,
 +>        q "Integer -> Int (safe bounds)" prop_integer_to_int_pass]
 +-}
  qc2hu :: QC.Testable a => Int -> String -> a -> HU.Test
  qc2hu maxTest = qccheck (defaultConfig {configMaxTest = maxTest, configMaxFail = 20000,
                              configEvery = testCount})
@@@ -121,22 -123,18 +124,29 @@@ qc2huVerbose maxTest 
      qccheck (defaultConfig {configMaxTest = 250, configMaxFail = 20000,
                              configEvery = \n args -> show n ++ ":\n" ++ unlines args})
  
 -{- | Run verbose tests. -}
 +{- | Run verbose tests.  Example:
 +
 +>test1 = TestCase ("x" @=? "x")
 +>
 +>alltests = [TestLabel "test1" test1,
 +>            tl "TestNum" TestNum.allt,
 +>            tl "TestMap" TestMap.allt,
 +>            tl "TestTime" TestTime.allt]
 +>
 +>main = do runVerboseTests (TestList alltests)
 +>          return ()
 +-}
  runVerboseTests :: HU.Test -> IO (HU.Counts, Int)
  runVerboseTests tests =
-     runVerbTestText (HU.putTextToHandle stderr True) $ tests
+     -- runVerbTestText (HU.putTextToHandle stderr True) $ tests
+     runVerbTestText (myPutText stderr True) $ tests
+     where myPutText h b = 
+               case HU.putTextToHandle h b of
+                 PutText putf st -> PutText (myputf h putf) st
+           myputf h putf x y z = do r <- putf x y z
+                                    hFlush h
+                                    return r
  
 -{- | Label the tests list. -}
 +{- | Label the tests list.  See example under 'runVerboseTests'.-}
  tl :: String -> [Test] -> Test
  tl msg t = HU.TestLabel msg $ HU.TestList t

-- 
haskell-testpack