[commit: base] master: Add a test for quot/rem/div/mod overflow (dfcffb8)

[Ian Lynagh]

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

On branch  : master

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

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

commit dfcffb868d3e0a450db20c4943027117e55f2260
Author: Ian Lynagh <igloo at earth.li>
Date:   Sun Jun 26 13:02:21 2011 +0100

    Add a test for quot/rem/div/mod overflow

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

 tests/all.T               |    1 +
 tests/quotOverflow.hs     |   33 +++++++++++++++++++++++++++++++++
 tests/quotOverflow.stdout |   45 +++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 79 insertions(+), 0 deletions(-)

diff --git a/tests/all.T b/tests/all.T
index bc10ec0..0168ae6 100644
--- a/tests/all.T
+++ b/tests/all.T
@@ -4,3 +4,4 @@ test('enumDouble', normal, compile_and_run, [''])
 test('enumRatio', normal, compile_and_run, [''])
 test('tempfiles', normal, compile_and_run, [''])
 test('fixed', normal, compile_and_run, [''])
+test('quotOverflow', normal, compile_and_run, [''])
diff --git a/tests/quotOverflow.hs b/tests/quotOverflow.hs
new file mode 100644
index 0000000..8d958f8
--- /dev/null
+++ b/tests/quotOverflow.hs
@@ -0,0 +1,33 @@
+
+import Control.Exception as E
+
+import Data.Int
+
+main :: IO ()
+main = do putStrLn "Int8"
+          mapM_ p =<< (f :: IO [Either Int8 String])
+          putStrLn "Int16"
+          mapM_ p =<< (f :: IO [Either Int16 String])
+          putStrLn "Int32"
+          mapM_ p =<< (f :: IO [Either Int32 String])
+          putStrLn "Int64"
+          mapM_ p =<< (f :: IO [Either Int64 String])
+          putStrLn "Int"
+          mapM_ p =<< (f :: IO [Either Int String])
+    where p (Left x) = print x
+          p (Right e) = putStrLn e
+
+f :: (Integral a, Bounded a) => IO [Either a String]
+f = sequence [ g (minBound `div` (-1)),
+               g (minBound `mod` (-1)),
+               g (case minBound `divMod` (-1) of (x, _) -> x),
+               g (case minBound `divMod` (-1) of (_, x) -> x),
+               g (minBound `quot` (-1)),
+               g (minBound `rem` (-1)),
+               g (case minBound `quotRem` (-1) of (x, _) -> x),
+               g (case minBound `quotRem` (-1) of (_, x) -> x) ]
+    where g x = do x' <- evaluate x
+                   return (Left x')
+                `E.catch`
+                   \e -> return (Right (show (e :: SomeException)))
+
diff --git a/tests/quotOverflow.stdout b/tests/quotOverflow.stdout
new file mode 100644
index 0000000..10e77ac
--- /dev/null
+++ b/tests/quotOverflow.stdout
@@ -0,0 +1,45 @@
+Int8
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+Int16
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+Int32
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+Int64
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+Int
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0
+arithmetic overflow
+0