优化和测试误差之间的相互作用要求

Question

我有一个模块中的功能，看起来是这样的：

module MyLibrary (throwIfNegative) where 

throwIfNegative :: Integral i => i -> String 
throwIfNegative n | n < 0 = error "negative" 
        | otherwise = "no worries" 

当然我可以返回Maybe String或其他一些变异，但我认为这是公平地说，这是一个程序员的错误，称这个函数为负数，所以在这里使用error是合理的。

现在，因为我喜欢让我的测试覆盖率达到100％，所以我希望有一个测试用例来检查这种行为。我已经试过这

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 

，它有点工作，但与优化编译时失败：

$ ghc --make -O Test.hs 
$ ./Test 
### Failure:        
must throw when given a negative number 
Cases: 1 Tried: 1 Errors: 0 Failures: 1 

我不知道这里发生了什么。这似乎尽管我使用evaluate，函数不会得到评估。此外，它再次工作，如果我做任何的下列步骤操作：

• 删除HUnit并调用代码直接
• 移动throwIfNegative相同的模块作为测试用例
• 删除的throwIfNegative
类型签名

我认为这是因为它导致优化应用不同。任何指针？

Answer 1

优化，严格性和imprecise exceptions可能有点棘手。

重现上述这个问题的最简单的方法是用一个NOINLINE上throwIfNegative（功能不被跨越模块边界任一内联）：

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 

读核心，以上时，内联GHC优化evaluate正确（？）：

catch# 
     @() 
     @ SomeException 
     (\ _ -> 
     case throwIfNegative (I# (-1)) of _ -> ... 

，然后浮出调用throwIfError，案件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 

奇怪的是，在这一点上，现在没有其他代码现在调用lvl_sJb，所以整个测试变成了死代码，并被剥离出来 - GHC已经确定它没有被使用！

使用seq代替evaluate是开心就好：

case_negative = 
    handleJust errorCalls (const $ return()) $ do 
     throwIfNegative (-1) `seq` assertFailure "must throw when given a negative number" 
    where errorCalls (ErrorCall _) = Just() 

或爆炸模式：

case_negative = 
    handleJust errorCalls (const $ return()) $ do 
     let !x = throwIfNegative (-1) 
     assertFailure "must throw when given a negative number" 
    where errorCalls (ErrorCall _) = Just() 

所以我认为我们应该看看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 

那#2273 bug是一个prett有趣的阅​​读。

我认为GHC在这里做可疑的事情，并建议不要使用evalaute（而是直接使用seq）。这需要更多地考虑GHC在严格性方面正在做什么。

我已经filed a bug report帮助从GHC总部得到一个决心。