优化之间的交互和错误调用的测试

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

优化,严格和不精确的异常可能有点棘手.

上面重现此问题的最简单方法是使用NOINLINEon 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在案件审查员外面浮出调用:

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错误是一个非常有趣的阅读.

我认为GHC在这里做了一些可疑的事情,并建议不要使用evalaute(而是seq直接使用).这需要更多地考虑GHC在严格性方面做了什么.

我已经提交了一份错误报告,以帮助GHC总部做出决定.