[commit: base] master: If an assertion fails, through it rather than a deeper error; fixes #5561 (cc4774d)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/cc4774d8b1e2736c4b9171db05451ba6355c98b6

>---------------------------------------------------------------

commit cc4774d8b1e2736c4b9171db05451ba6355c98b6
Author: Ian Lynagh <igloo at earth.li>
Date:   Wed Oct 19 22:23:19 2011 +0100

    If an assertion fails, through it rather than a deeper error; fixes #5561
    
    An expression like
        assert False (throw e)
    should throw the assertion failure rather than e

>---------------------------------------------------------------

 GHC/IO/Exception.hs |    5 ++++-
 tests/all.T         |    1 +
 tests/assert.hs     |    9 +++++++++
 tests/assert.stderr |    2 ++
 4 files changed, 16 insertions(+), 1 deletions(-)

diff --git a/GHC/IO/Exception.hs b/GHC/IO/Exception.hs
index e3482cb..1c78e11 100644
--- a/GHC/IO/Exception.hs
+++ b/GHC/IO/Exception.hs
@@ -303,9 +303,12 @@ instance Show IOException where
          "" -> id
          _  -> showString " (" . showString s . showString ")")
 
+-- Note the use of "lazy". This means that
+--     assert False (throw e)
+-- will throw the assertion failure rather than e. See trac #5561.
 assertError :: Addr# -> Bool -> a -> a
 assertError str predicate v
-  | predicate = v
+  | predicate = lazy v
   | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
 
 unsupportedOperation :: IOError
diff --git a/tests/all.T b/tests/all.T
index 0168ae6..7c9fc6e 100644
--- a/tests/all.T
+++ b/tests/all.T
@@ -5,3 +5,4 @@ test('enumRatio', normal, compile_and_run, [''])
 test('tempfiles', normal, compile_and_run, [''])
 test('fixed', normal, compile_and_run, [''])
 test('quotOverflow', normal, compile_and_run, [''])
+test('assert', exit_code(1), compile_and_run, ['-fno-ignore-asserts'])
diff --git a/tests/assert.hs b/tests/assert.hs
new file mode 100644
index 0000000..f6e3c90
--- /dev/null
+++ b/tests/assert.hs
@@ -0,0 +1,9 @@
+
+import Control.Exception
+
+-- We want to get the assertion failure, not the overflow exception.
+-- trac #5561.
+
+main :: IO ()
+main = let e1 i = throw Overflow
+       in assert False (e1 5)
diff --git a/tests/assert.stderr b/tests/assert.stderr
new file mode 100644
index 0000000..8d99aa0
--- /dev/null
+++ b/tests/assert.stderr
@@ -0,0 +1,2 @@
+assert: assert.hs:9:11-16: Assertion failed
+