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, <qu...@sparq.org> wrote:

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 <batterseapo...@hotmail.com>:

On 6 June 2011 16:18, Jimbo Massive <jimbo.massive-hask...@xyxyx.org> 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

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to