[GHC] #5129: "evaluate" optimized away

[GHC]

#5129: "evaluate" optimized away
---------------------------------+------------------------------------------
    Reporter:  dons              |       Owner:                             
        Type:  bug               |      Status:  new                        
    Priority:  normal            |   Component:  Compiler                   
     Version:  7.0.3             |    Keywords:  seq, evaluate              
    Testcase:                    |   Blockedby:                             
          Os:  Unknown/Multiple  |    Blocking:                             
Architecture:  Unknown/Multiple  |     Failure:  Incorrect result at runtime
---------------------------------+------------------------------------------
 Reported on Stackoverflow: http://stackoverflow.com/questions/5697159
 /testing-for-error-calls-in-hunit

 With optimizations on, the following program, which normally succeeds
 (correctly generating an exception), instead fails, and the exception is
 optimized away.

 {{{
 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
 }}}

 Looking at the core, after a few iterations, the call to `throwIfNegative`
 is dropped as dead code.

 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 ()
 }}}

 Possibly related to #2273

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/5129>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler