Взаимодействие между оптимизацией и тестированием на вызовы ошибок - PullRequest
Новая
       23

Взаимодействие между оптимизацией и тестированием на вызовы ошибок

5 голосов
/ 18 апреля 2011

У меня есть функция в модуле, которая выглядит примерно так: 

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

Я предполагаю, что это потому, что это приводит к тому, что оптимизации применяются по-разному. Есть указатели?

1 Ответ

8 голосов
/ 18 апреля 2011

Оптимизация, строгость и неточные исключения может быть немного сложнее.

Самый простой способ воспроизвести эту проблему выше - с NOINLINE на throwIfNegative (функция isnне ограничивается границами модуля): 

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, поэтому весь тест становится мертвым кодом и удаляетсяout - 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.

...