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

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

优化、严格性和不精确的异常可能有点棘手。

重现上述问题的最简单方法是在throwIfNegative上使用NOINLINE(该函数也没有跨模块边界内联):

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

或bang模式:

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读起来很有趣。

我认为GHC在这里做了一些可疑的事情，并建议不要使用evalaute(相反，直接使用seq)。这需要更多地思考GHC在严格程度上做了什么。

我已经提交了一个bug报告，以帮助从GHC总部得到一个决定。