Interaction between optimizations and testing for error calls

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?

Tjader

I can reproduce this. Interesting! Also, if you include throwIfNegative in the module, marked with a NOINLINE it fails. – Valenba

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.

Valenba

Very interesting. I'll keep an eye on the trac. – Tjader