diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-06-23 10:01:44 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-06-27 11:55:59 -0400 |
commit | 1b3d13b68c95ef9bbeca4437028531d184abcbea (patch) | |
tree | eed6111120e26030f0ad8ca55144536dcdbe4b1e /testsuite | |
parent | a403eb917bd26caf96c29d67bfe91163b593b2c9 (diff) | |
download | haskell-1b3d13b68c95ef9bbeca4437028531d184abcbea.tar.gz |
Fix ghc-bignum exceptions
We must ensure that exceptions are not simplified. Previously we used:
case raiseDivZero of
_ -> 0## -- dummyValue
But it was wrong because the evaluation of `raiseDivZero` was removed and
the dummy value was directly returned. See new Note [ghc-bignum exceptions].
I've also removed the exception triggering primops which were fragile.
We don't need them to be primops, we can have them exported by ghc-prim.
I've also added a test for #18359 which triggered this patch.
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/tests/numeric/should_run/T18359.hs | 18 | ||||
-rw-r--r-- | testsuite/tests/numeric/should_run/T18359.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/numeric/should_run/all.T | 1 | ||||
-rw-r--r-- | testsuite/tests/primops/should_run/T14664.hs | 7 |
4 files changed, 25 insertions, 3 deletions
diff --git a/testsuite/tests/numeric/should_run/T18359.hs b/testsuite/tests/numeric/should_run/T18359.hs new file mode 100644 index 0000000000..16deba75dd --- /dev/null +++ b/testsuite/tests/numeric/should_run/T18359.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE MagicHash #-} + +import GHC.Num.BigNat +import GHC.Num.Primitives +import GHC.Prim.Exception +import GHC.Exts +import Control.Exception + +main :: IO () +main = do + foo `catch` \DivideByZero -> putStrLn "Caught DivideByZero exception in foo" + foo2 `catch` \DivideByZero -> putStrLn "Caught DivideByZero exception in foo2" + +foo2 = case raiseDivZero of + I# _ -> print "NOPE" + +foo :: IO () +foo = print (W# (bigNatRemWord# (bigNatOne void#) 0##)) diff --git a/testsuite/tests/numeric/should_run/T18359.stdout b/testsuite/tests/numeric/should_run/T18359.stdout new file mode 100644 index 0000000000..65d3805d2e --- /dev/null +++ b/testsuite/tests/numeric/should_run/T18359.stdout @@ -0,0 +1,2 @@ +Caught DivideByZero exception in foo +Caught DivideByZero exception in foo2 diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 71e81daaab..ce44e15729 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -69,3 +69,4 @@ test('T12136', normal, compile_and_run, ['']) test('T15301', normal, compile_and_run, ['-O2']) test('T497', normal, compile_and_run, ['-O']) test('T17303', normal, compile_and_run, ['']) +test('T18359', normal, compile_and_run, ['']) diff --git a/testsuite/tests/primops/should_run/T14664.hs b/testsuite/tests/primops/should_run/T14664.hs index 4c29d327d0..a7b8308024 100644 --- a/testsuite/tests/primops/should_run/T14664.hs +++ b/testsuite/tests/primops/should_run/T14664.hs @@ -3,6 +3,7 @@ module Main where import GHC.Exts +import GHC.Prim.Exception import Control.Exception main :: IO () @@ -12,6 +13,6 @@ main = do printE :: ArithException -> IO () printE = print - catch (raiseUnderflow# void#) printE - catch (raiseOverflow# void#) printE - catch (raiseDivZero# void#) printE + catch raiseUnderflow printE + catch raiseOverflow printE + catch raiseDivZero printE |