
Didn't get to this last night but I've just now confirmed this. With a normal build (defaulting to -O) the test code below generates only 3 failures (MacOS Leopard w/GHC 6.12.3 and HUnit 1.2.2.3). When using -O0 or by changing assertFailure in Test.HUnit.Lang (line 81) to use E.throwIO instead of E.throw I get the expected 6 failures. This is very reproducible for me. I can use -O0 for my tests, but it would be great if HUnit were updated to use the throwIO call (cc'ing Richard Giraud accordingly). Thanks! -KQ
module Main where
import Control.Monad (unless) import Test.HUnit
main = runTestTT $ TestList [ True ~=? True , False ~=? True , TestCase $ assertEqual "both true" True True , TestCase $ assertEqual "false true" False True , TestCase $ assertEqual "fa" False True , TestCase $ assertEqual "f" False True , TestCase $ (False @?= True) , TestCase $ unless (False == True) (assertFailure "f") ]
On Mon, 06 Jun 2011 09:00:07 -0700,
That sounds very applicable to my issue (and unfortunately my googling missed this, ergo my consult of haskell-cafe uberwissenmensch). When I again have access to the aforementioned Mac this evening I'll try both disabling optimizations and a tweaked HUnit to see if that resolves the problem and report back then.
-KQ
Quoting Max Bolingbroke
: On 6 June 2011 16:18, Jimbo Massive
wrote: Or is this bad behaviour due to HUnit doing something unsafe?
I think it may be related to this bug: http://hackage.haskell.org/trac/ghc/ticket/5129
The suggested fix is to change HUnit to define assertFailure with throwIO, but the latest source code still uses throw:
http://hackage.haskell.org/trac/ghc/ticket/5129
So this could very well be a HUnit bug.
Max
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
------------------------------------------------- This mail sent through IMP: http://horde.org/imp/
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- -KQ