summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-06-23 10:01:44 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-06-27 11:55:59 -0400
commit1b3d13b68c95ef9bbeca4437028531d184abcbea (patch)
treeeed6111120e26030f0ad8ca55144536dcdbe4b1e /testsuite
parenta403eb917bd26caf96c29d67bfe91163b593b2c9 (diff)
downloadhaskell-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.hs18
-rw-r--r--testsuite/tests/numeric/should_run/T18359.stdout2
-rw-r--r--testsuite/tests/numeric/should_run/all.T1
-rw-r--r--testsuite/tests/primops/should_run/T14664.hs7
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