Interaction between optimizations and testing for error calls - exception

Question

I have a function in a module that looks something like this:
module MyLibrary (throwIfNegative) where
throwIfNegative :: Integral i => i -> String
throwIfNegative n | n < 0 = error "negative"
| otherwise = "no worries"
I could of course return Maybe String or some other variant, but I think it's fair to say that it's a programmer error to call this function with a negative number so using error is justified here.
Now, since I like having my test coverage at 100% I want to have a test case that checks this behavior. I have tried this
import Control.Exception
import Test.HUnit
import MyLibrary
case_negative =
handleJust errorCalls (const $ return ()) $ do
evaluate $ throwIfNegative (-1)
assertFailure "must throw when given a negative number"
where errorCalls (ErrorCall _) = Just ()
main = runTestTT $ TestCase case_negative
and it sort of works, but it fails when compiling with optimizations:
$ ghc --make -O Test.hs
$ ./Test
### Failure:
must throw when given a negative number
Cases: 1 Tried: 1 Errors: 0 Failures: 1
I'm not sure what's happening here. It seems like despite my use of evaluate, the function does not get evaluated. Also, it works again if I do any of these steps:
Remove HUnit and call the code directly
Move throwIfNegative to the same module as the test case
Remove the type signature of throwIfNegative
I assume this is because it causes the optimizations to be applied differently. Any pointers?

Answer 1

Optimizations, strictness, and imprecise exceptions can be a bit tricky.
The easiest way to reproduce this problem above is with a NOINLINE on throwIfNegative (the function isn't being inlined across module boundaries either):
import Control.Exception
import Test.HUnit
throwIfNegative :: Int -> String
throwIfNegative n | n < 0 = error "negative"
| otherwise = "no worries"
{-# NOINLINE throwIfNegative #-}
case_negative =
handleJust errorCalls (const $ return ()) $ do
evaluate $ throwIfNegative (-1)
assertFailure "must throw when given a negative number"
where errorCalls (ErrorCall _) = Just ()
main = runTestTT $ TestCase case_negative
Reading the core, with optimizations on, the GHC inlines evaluate properly (?):
catch#
# ()
# SomeException
(\ _ ->
case throwIfNegative (I# (-1)) of _ -> ...
and then floats out the call to throwIfError, outside of the case scrutinizer:
lvl_sJb :: String
lvl_sJb = throwIfNegative lvl_sJc
lvl_sJc = I# (-1)
throwIfNegative =
\ (n_adO :: Int) ->
case n_adO of _ { I# x_aBb ->
case <# x_aBb 0 of _ {
False -> lvl_sCw; True -> error lvl_sCy
and strangely, at this point, no other code now calls lvl_sJb, so the entire test becomes dead code, and is stripped out -- GHC has determined that it is unused!
Using seq instead of evaluate is happy enough:
case_negative =
handleJust errorCalls (const $ return ()) $ do
throwIfNegative (-1) `seq` assertFailure "must throw when given a negative number"
where errorCalls (ErrorCall _) = Just ()
or a bang pattern:
case_negative =
handleJust errorCalls (const $ return ()) $ do
let !x = throwIfNegative (-1)
assertFailure "must throw when given a negative number"
where errorCalls (ErrorCall _) = Just ()
so I think we should look at the semantics of evaluate:
-- | Forces its argument to be evaluated to weak head normal form when
-- the resultant 'IO' action is executed. It can be used to order
-- evaluation with respect to other 'IO' operations; its semantics are
-- given by
--
-- > evaluate x `seq` y ==> y
-- > evaluate x `catch` f ==> (return $! x) `catch` f
-- > evaluate x >>= f ==> (return $! x) >>= f
--
-- /Note:/ the first equation implies that #(evaluate x)# is /not/ the
-- same as #(return $! x)#. A correct definition is
--
-- > evaluate x = (return $! x) >>= return
--
evaluate :: a -> IO a
evaluate a = IO $ \s -> let !va = a in (# s, va #) -- NB. see #2273
That #2273 bug is a pretty interesting read.
I think GHC is doing something suspicious here, and recommend not using evalaute (instead, use seq directly). This needs more thinking about what GHC is doing with the strictness.
I've filed a bug report to help get a determination from GHC HQ.