Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

tests: import ghc-7.6 numeric testsuite

  • Loading branch information...
commit afbbd6c2b2bcc107d95c1bc7129a019dba69e617 1 parent 43fdb0c
@kfish authored
Showing with 1,092 additions and 0 deletions.
  1. +7 −0 tests/ghc-7.6/1603.hs
  2. +32 −0 tests/ghc-7.6/3676.hs
  3. +5 −0 tests/ghc-7.6/4381.hs
  4. +1 −0  tests/ghc-7.6/4383.hs
  5. +9 −0 tests/ghc-7.6/Makefile
  6. +28 −0 tests/ghc-7.6/arith001.hs
  7. +52 −0 tests/ghc-7.6/arith002.hs
  8. +84 −0 tests/ghc-7.6/arith003.hs
  9. +86 −0 tests/ghc-7.6/arith004.hs
  10. +60 −0 tests/ghc-7.6/arith005.hs
  11. +4 −0 tests/ghc-7.6/arith006.hs
  12. +23 −0 tests/ghc-7.6/arith007.hs
  13. +24 −0 tests/ghc-7.6/arith008.hs
  14. +6 −0 tests/ghc-7.6/arith009.hs
  15. +11 −0 tests/ghc-7.6/arith010.hs
  16. +174 −0 tests/ghc-7.6/arith011.hs
  17. +90 −0 tests/ghc-7.6/arith012.hs
  18. +13 −0 tests/ghc-7.6/arith013.hs
  19. +11 −0 tests/ghc-7.6/arith014.hs
  20. +5 −0 tests/ghc-7.6/arith015.hs
  21. +33 −0 tests/ghc-7.6/arith016.hs
  22. +10 −0 tests/ghc-7.6/arith017.hs
  23. +12 −0 tests/ghc-7.6/arith018.hs
  24. +10 −0 tests/ghc-7.6/arith019.hs
  25. +7 −0 tests/ghc-7.6/expfloat.hs
  26. +17 −0 tests/ghc-7.6/numrun009.hs
  27. +13 −0 tests/ghc-7.6/numrun010.hs
  28. +2 −0  tests/ghc-7.6/numrun011.hs
  29. +35 −0 tests/ghc-7.6/numrun012.hs
  30. +17 −0 tests/ghc-7.6/numrun013.hs
  31. +211 −0 tests/ghc-7.6/numrun014.hs
View
7 tests/ghc-7.6/1603.hs
@@ -0,0 +1,7 @@
+module Main where
+
+main = print (syn [-1])
+
+syn :: [Int] -> [Int]
+syn (d:ds) = rem d 0x40000000 : syn ds
+syn [] = []
View
32 tests/ghc-7.6/3676.hs
@@ -0,0 +1,32 @@
+-- test conversion of funny numbers through Rational (#3676)
+
+main = mapM_ putStrLn $ concat $
+ [map (show.d2d) doubles1,
+ map (show.d2f) doubles1,
+ map (show.d2r) doubles1,
+ map (show.f2d) floats1,
+ map (show.f2f) floats1,
+ map (show.f2r) floats1,
+ map (show.d2d) doubles2,
+ map (show.d2f) doubles2,
+ map (show.d2r) doubles2,
+ map (show.f2d) floats2,
+ map (show.f2f) floats2,
+ map (show.f2r) floats2
+ ]
+
+d2d = realToFrac :: Double -> Double
+d2f = realToFrac :: Double -> Float
+d2r = realToFrac :: Double -> Rational
+f2d = realToFrac :: Float -> Double
+f2f = realToFrac :: Float -> Float
+f2r = realToFrac :: Float -> Rational
+
+doubles1 = [0/0, 1/0, -1/0, 0/(-1)] :: [Double]
+floats1 = [0/0, 1/0, -1/0, 0/(-1)] :: [Float]
+
+doubles2 = names :: [Double]
+floats2 = names :: [Float]
+
+names :: Read a => [a]
+names = map read ["NaN", "Infinity", "-Infinity", "-0"]
View
5 tests/ghc-7.6/4381.hs
@@ -0,0 +1,5 @@
+module Main where
+
+main = do
+ print (scaleFloat 30000 1)
+ print (scaleFloat (maxBound :: Int) 1)
View
1  tests/ghc-7.6/4383.hs
@@ -0,0 +1 @@
+main = print (0.5 ^ 1030)
View
9 tests/ghc-7.6/Makefile
@@ -0,0 +1,9 @@
+
+ERROR_TESTS= $(wildcard *.hs)
+
+include ../cmpoutput.mak
+
+all :: $(patsubst %, check.%, $(ERROR_TESTS))
+
+clean:
+ rm -f *.o *.hi *.exe *.stdout *.stderr
View
28 tests/ghc-7.6/arith001.hs
@@ -0,0 +1,28 @@
+-- !!! conversions: Double <=> Rational/Integer things
+--
+import Data.Ratio
+
+main = putStr (show r42 ++ "\n" ++
+ show nu42 ++ ", " ++
+ show de42 ++ "\n" ++
+ show nu42d ++ ", " ++
+ show de42d ++ "\n" ++
+ show s2 ++ ", " ++
+ show e2 ++ "\n" ++
+ show s ++ ", " ++
+ show e ++ "\n" )
+ where
+ d42 :: Double
+ r42 :: Rational
+ nu42, de42 :: Integer
+ nu42d, de42d :: Double
+
+ d42 = 42
+ r42 = toRational d42
+ nu42 = numerator r42
+ de42 = denominator r42
+ nu42d= fromInteger nu42
+ de42d= fromInteger de42
+
+ (s,e)= decodeFloat (nu42d / de42d )
+ (s2,e2) = decodeFloat d42
View
52 tests/ghc-7.6/arith002.hs
@@ -0,0 +1,52 @@
+-- !!! basic Rational operations
+--
+import Data.Ratio
+
+main
+ = putStr
+ (-- Ratio Ints
+ show [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc]
+ ++ "\n"
+ -- the Ints
+ ++ show ((map numerator [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc])
+ ++(map denominator [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc]))
+ ++ "\n"
+ -- Booleans
+-- ++ show []
+-- ++ "\n"
+
+ -- Rationals (Ratio Integers)
+ ++ show [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc]
+ ++ "\n"
+ -- the Integers
+ ++ show ((map numerator [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc])
+ ++(map denominator [r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc]))
+ ++ "\n"
+ -- Booleans
+-- ++ show []
+-- ++ "\n"
+ )
+ where
+ i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc :: Ratio Int
+
+ i0a = 0 % 1
+ i0b = (-0) % 1
+ i0c = 0 % (-1)
+ i2a = 4 % 2
+ i2b = (-4) % (-2)
+ im2a = (-4) % 2
+ im2b = 4 % (-2)
+ i_pi = 22 % 7
+ i_misc = 2 % 10000
+
+ r0a, r0b, r0c, r2a, r2b, rm2a, rm2b, r_pi, r_misc :: Rational
+
+ r0a = 0 % 1
+ r0b = (-0) % 1
+ r0c = 0 % (-1)
+ r2a = 4 % 2
+ r2b = (-4) % (-2)
+ rm2a = (-4) % 2
+ rm2b = 4 % (-2)
+ r_pi = 22 % 7
+ r_misc = 2 % 10000
View
84 tests/ghc-7.6/arith003.hs
@@ -0,0 +1,84 @@
+-- $Id: arith003.hs,v 1.2 2002/01/25 13:40:39 simonmar Exp $
+--
+-- !!! test Int/Integer arithmetic operations from the Prelude.
+--
+
+main
+ = putStr
+ (
+ showit (do_ops int_ops) ++
+ showit (do_ops integer_ops)
+ )
+
+showit :: (Show a, Integral a) => [(String, a, a, a)] -> String
+showit stuff = concat
+ [ str ++ " " ++ show l ++ " " ++ show r ++ " = " ++ show result ++ "\n"
+ | (str, l, r, result) <- stuff
+ ]
+
+do_ops :: Integral a => [((a -> a -> a), String, [(a,a)])]
+ -> [(String, a, a, a)]
+do_ops ops = [ (str, l, r, l `op` r) | (op,str,args) <- ops, (l,r) <- args ]
+
+small_operands, non_min_operands, operands, non_max_operands
+ :: Integral a => [a]
+small_operands = [ 0, 1, -1, 2, -2 ]
+operands = small_operands ++ [ fromIntegral minInt, fromIntegral maxInt ]
+non_min_operands = small_operands ++ [ fromIntegral maxInt ]
+non_max_operands = small_operands ++ [ fromIntegral minInt ]
+
+large_operands :: [ Integer ]
+large_operands = operands ++
+ [ fromIntegral minInt - 1,
+ fromIntegral maxInt + 1,
+ fromIntegral minInt * 2,
+ fromIntegral maxInt * 2,
+ fromIntegral minInt ^ 2,
+ fromIntegral maxInt ^ 2
+ ]
+
+integer_ops :: [((Integer -> Integer -> Integer), String, [(Integer,Integer)])]
+integer_ops = [
+ ((+), "(+)", both_large),
+ ((-), "(-)", both_large),
+ (div, "div", large_non_zero_r),
+ (mod, "mod", large_non_zero_r),
+ (quot, "quot", large_non_zero_r),
+ (rem, "rem", large_non_zero_r),
+ (gcd, "gcd", large_either_non_zero),
+ (lcm, "lcm", large_either_non_zero)
+ ]
+
+int_ops :: [((Int -> Int -> Int), String, [(Int,Int)])]
+int_ops = [
+ ((+), "(+)", both_small),
+ ((-), "(-)", both_small),
+ ((^), "(^)", small_non_neg_r),
+ (div, "div", non_min_l_or_zero_r),
+ (mod, "mod", non_min_l_or_zero_r),
+ (quot, "quot", non_min_l_or_zero_r),
+ (rem, "rem", non_min_l_or_zero_r),
+ (gcd, "gcd", non_min_either_non_zero),
+ (lcm, "lcm", non_max_r_either_non_zero)
+ ]
+
+-- NOTE: when abs(minInt) is undefined (it is in GHC, because
+-- abs(minInt) would be greater than maxInt), then gcd on Ints is also
+-- undefined when either operand is minInt.
+
+both_small, non_zero_r, non_min_either_non_zero, non_min_l_or_zero_r,
+ non_max_r_either_non_zero, small_non_neg_r
+ :: Integral a => [(a,a)]
+
+both_small = [ (l,r) | l <- operands, r <- operands ]
+both_large = [ (l,r) | l <- large_operands, r <- large_operands ]
+large_non_zero_r = [ (l,r) | l <- operands, r <- large_operands, r /= 0 ]
+non_zero_r = [ (l,r) | l <- operands, r <- operands, r /= 0 ]
+non_min_either_non_zero = [ (l,r) | l <- non_min_operands, r <- non_min_operands, l /= 0 || r /= 0 ]
+large_either_non_zero = [ (l,r) | l <- operands, r <- operands, l /= 0 || r /= 0 ]
+small_non_neg_r = [ (l,r) | l <- operands, r <- small_operands, r >= 0 ]
+non_min_l_or_zero_r = [ (l,r) | l <- non_min_operands, r <- operands, r /= 0 ]
+non_max_r_either_non_zero = [ (l,r) | l <- operands, r <- non_max_operands, l /= 0 || r /= 0 ]
+
+minInt = minBound :: Int
+maxInt = maxBound :: Int
View
86 tests/ghc-7.6/arith004.hs
@@ -0,0 +1,86 @@
+-- !!! test quot/rem/div/mod functions on Ints and Integers
+--
+main
+ = putStr
+ (-- w/ Ints and Integers
+ show (unzipWith div ints_list)
+ ++ "\n"
+ ++ show (unzipWith div integers_list)
+ ++ "\n"
+ ++ show (unzipWith rem ints_list)
+ ++ "\n"
+ ++ show (unzipWith rem integers_list)
+ ++ "\n"
+ ++ show (unzipWith quot ints_list)
+ ++ "\n"
+ ++ show (unzipWith quot integers_list)
+ ++ "\n"
+ ++ show (unzipWith mod ints_list)
+ ++ "\n"
+ ++ show (unzipWith mod integers_list)
+ ++ "\n"
+ ++ show (unzipWith law1 ints_list)
+ ++ "\n"
+ ++ show (unzipWith law1 integers_list)
+ ++ "\n"
+ ++ show (unzipWith law2 ints_list)
+ ++ "\n"
+ ++ show (unzipWith law2 integers_list)
+ ++ "\n"
+ )
+ where
+ ints_list :: [(Int, Int)]
+ integers_list :: [(Integer, Integer)]
+
+ ints_list = [
+ (0, 4),
+ (0, -8),
+ (7, 3),
+ (13, 4),
+ (13, -4),
+ (-13, 4),
+ (-13, -4),
+ (12345678, 10000),
+ (12345678, -10000),
+ (-12345678, 10000),
+ (-12345678, -10000),
+ (123456,10000),
+ (1234567,20000),
+ (12345678,-10000),
+ (123456789,10000),
+ (1234567890,-10000),
+ (-12345,10000),
+ (-123456789,-10000)
+ ]
+
+ integers_list = [
+ (0, 4),
+ (0, -8),
+ (7, 3),
+ (13, 4),
+ (13, -4),
+ (-13, 4),
+ (-13, -4),
+ (12345678, 10000),
+ (12345678, -10000),
+ (-12345678, 10000),
+ (-12345678, -10000),
+ (123456,10000),
+ (1234567,20000),
+ (12345678,-10000),
+ (123456789,10000),
+ (1234567890,-10000),
+ (-12345,10000),
+ (-123456789,-10000),
+ (12345678900,500000000),
+ (1234000000000000000000005678900,5001111111111111000000)
+ ]
+
+unzipWith :: (a -> b -> c) -> [(a,b)] -> [c]
+unzipWith f [] = []
+unzipWith f ((x,y):zs) = f x y : unzipWith f zs
+
+law1, law2 :: Integral a => a -> a -> Bool
+
+law1 x y = (x `quot` y)*y + (x `rem` y) == x
+law2 x y = (x `div` y)*y + (x `mod` y) == x
View
60 tests/ghc-7.6/arith005.hs
@@ -0,0 +1,60 @@
+-- !!! test RealFrac ops (ceiling/floor/etc.) on Floats/Doubles
+--
+main =
+ putStr $
+ unlines
+ [ -- just for fun, we show the floats to
+ -- exercise the code responsible.
+ 'A' : show (float_list :: [Float])
+ , 'B' : show (double_list :: [Double])
+ -- {Float,Double} inputs, {Int,Integer} outputs
+ , 'C' : show ((map ceiling small_float_list) :: [Int])
+ , 'D' : show ((map ceiling float_list) :: [Integer])
+ , 'E' : show ((map ceiling small_double_list) :: [Int])
+ , 'F' : show ((map ceiling double_list) :: [Integer])
+ , 'G' : show ((map floor small_float_list) :: [Int])
+ , 'H' : show ((map floor float_list) :: [Integer])
+ , 'I' : show ((map floor small_double_list) :: [Int])
+ , 'J' : show ((map floor double_list) :: [Integer])
+ , 'K' : show ((map truncate small_float_list) :: [Int])
+ , 'L' : show ((map truncate float_list) :: [Integer])
+ , 'M' : show ((map truncate small_double_list) :: [Int])
+ , 'N' : show ((map truncate double_list) :: [Integer])
+ , 'n' : show ((map round small_float_list) :: [Int])
+ , 'O' : show ((map round float_list) :: [Integer])
+ , 'P' : show ((map round small_double_list) :: [Int])
+ , 'Q' : show ((map round double_list) :: [Integer])
+ , 'R' : show ((map properFraction small_float_list) :: [(Int,Float)])
+ , 'S' : show ((map properFraction float_list) :: [(Integer,Float)])
+ , 'T' : show ((map properFraction small_double_list) :: [(Int,Double)])
+ , 'U' : show ((map properFraction double_list) :: [(Integer,Double)])
+ ]
+ where
+ -- these fit into an Int when truncated. Truncation when the
+ -- result does not fit into the target is undefined - not explicitly
+ -- so in Haskell 98, but that's the interpretation we've taken in GHC.
+ -- See bug #1254
+ small_float_list :: [Float]
+ small_float_list = [
+ 0.0, -0.0, 1.1, 2.8, 3.5, 4.5, -1.0000000001, -2.9999995,
+ -3.50000000001, -4.49999999999, 1000012.0, 123.456, 100.25,
+ 102.5, 0.0012, -0.00000012, 1.7e4, -1.7e-4, 0.15e-6, pi
+ ]
+
+ float_list :: [Float]
+ float_list = small_float_list ++ [
+ 1.18088e+11, 1.2111e+14
+ ]
+
+ -- these fit into an Int
+ small_double_list :: [Double]
+ small_double_list = [
+ 0.0, -0.0, 1.1, 2.8, 3.5, 4.5, -1.0000000001, -2.9999995,
+ -3.50000000001, -4.49999999999, 1000012.0, 123.456, 100.25,
+ 102.5, 0.0012, -0.00000012, 1.7e4, -1.7e-4, 0.15e-6, pi
+ ]
+
+ double_list :: [Double]
+ double_list = small_double_list ++ [
+ 1.18088e+11, 1.2111e+14
+ ]
View
4 tests/ghc-7.6/arith006.hs
@@ -0,0 +1,4 @@
+-- !!! printing Floats; was a bug in hbc (reported by andy)
+--
+
+main = print ((fromIntegral (42 :: Int)) :: Float)
View
23 tests/ghc-7.6/arith007.hs
@@ -0,0 +1,23 @@
+-- !!! test simple Integer things
+--
+
+f x y z = x y z
+
+main = do
+ putStr (shows integer_list "\n")
+ where
+ int_list :: [Int]
+ integer_list :: [Integer]
+
+ int_list = (map fromInteger integer_list)
+
+ integer_list = (map (* 2)
+ [1,3,5,7,9,
+ 11111111111111111111111111111,
+ 2222222222222222222222222222222222222,
+ 3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333,
+ -11111111111111111111111111111,
+ -2222222222222222222222222222222222222,
+ -3333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333333
+ ])
+
View
24 tests/ghc-7.6/arith008.hs
@@ -0,0 +1,24 @@
+-- !!! a random test from Nick North
+-- (got this in mid-1993; don't remember why. WDP 95/02)
+--
+
+random_numbers :: (Int, Int, Int) -> [Float]
+random_numbers (s1,s2,s3)
+ = map (snd . properFraction . combine) (iterate f (s1,s2,s3))
+ where
+ combine :: (Int,Int,Int) -> Float
+ combine (a,b,c) =
+ fromIntegral(a)/30269 + fromIntegral(b)/30307
+ + fromIntegral(c)/30323
+ f (a,b,c) =
+ ((171*a) `mod` 30269, (172*b) `mod` 30307, (170*c) `mod` 30323)
+
+-- partain: changed to cvt spaces into newlines (easier to see bugs)
+-- sof: define approp. version of showList to do this.
+main = putStr (showL (showsPrec 0) (take 1000 (random_numbers (9807, 65, 32975))) "\n")
+
+showL showx [] = showString "[]"
+showL showx (x:xs) = showChar '[' . showx x . showl xs
+ where
+ showl [] = showChar ']'
+ showl (x:xs) = showString ",\n" . showx x . showl xs
View
6 tests/ghc-7.6/arith009.hs
@@ -0,0 +1,6 @@
+-- a prefix minus precedence test
+
+f :: Int -> Int -> Int -> Int
+f x y z = - x * y ^ z
+
+main = putStr (shows (f 5 2 3) "\n")
View
11 tests/ghc-7.6/arith010.hs
@@ -0,0 +1,11 @@
+-- Tests enumerations
+
+main = do
+ print [1..10]
+ print [10..1] -- []
+ print [1,3..10]
+ print [10,8..1]
+ print ['a'..'f']
+ print ['f'..'a'] -- []
+ print ['a','c'..'m']
+ print ['m','l'..'a']
View
174 tests/ghc-7.6/arith011.hs
@@ -0,0 +1,174 @@
+-- !!! Testing Int and Word
+module Main(main) where
+import Data.Int
+import Data.Word
+import Data.Bits
+import Data.Ix -- added SOF
+import Control.Exception
+
+main :: IO ()
+main = test
+
+test :: IO ()
+test = do
+ testIntlike "Int" (0::Int)
+ testIntlike "Int8" (0::Int8)
+ testIntlike "Int16" (0::Int16)
+ testIntlike "Int32" (0::Int32)
+ testIntlike "Int64" (0::Int64)
+ testIntlike "Word8" (0::Word8)
+ testIntlike "Word16" (0::Word16)
+ testIntlike "Word32" (0::Word32)
+ testIntlike "Word64" (0::Word64)
+ testInteger
+
+testIntlike :: (Bounded a, Integral a, Ix a, Show a, Read a, Bits a) => String -> a -> IO ()
+testIntlike name zero = do
+ putStrLn $ "--------------------------------"
+ putStrLn $ "--Testing " ++ name
+ putStrLn $ "--------------------------------"
+ testBounded zero
+ testEnum zero
+ testReadShow zero
+ testEq zero
+ testOrd zero
+ testNum zero
+ testReal zero
+ testIntegral zero
+ testConversions zero
+ testBits zero True
+
+testInteger = do
+ let zero = 0 :: Integer
+ putStrLn $ "--------------------------------"
+ putStrLn $ "--Testing Integer"
+ putStrLn $ "--------------------------------"
+ testEnum zero
+ testReadShow zero
+ testEq zero
+ testOrd zero
+ testNum zero
+ testReal zero
+ testIntegral zero
+ testBits zero False
+
+-- In all these tests, zero is a dummy element used to get
+-- the overloading to work
+
+testBounded zero = do
+ putStrLn "testBounded"
+ print $ (minBound-1, minBound, minBound+1) `asTypeOf` (zero,zero,zero)
+ print $ (maxBound-1, maxBound, maxBound+1) `asTypeOf` (zero,zero,zero)
+
+testEnum zero = do
+ putStrLn "testEnum"
+ print $ take 10 [zero .. ] -- enumFrom
+ print $ take 10 [zero, toEnum 2 .. ] -- enumFromThen
+ print [zero .. toEnum 20] -- enumFromTo
+ print [zero, toEnum 2 .. toEnum 20] -- enumFromThenTo
+
+testConversions zero = do
+ putStrLn "testConversions"
+ putStr "Integer : " >> print (map fromIntegral numbers :: [Integer])
+ putStr "Int : " >> print (map fromIntegral numbers :: [Int])
+ putStr "Int8 : " >> print (map fromIntegral numbers :: [Int8])
+ putStr "Int16 : " >> print (map fromIntegral numbers :: [Int16])
+ putStr "Int32 : " >> print (map fromIntegral numbers :: [Int32])
+ putStr "Int64 : " >> print (map fromIntegral numbers :: [Int64])
+ putStr "Word8 : " >> print (map fromIntegral numbers :: [Word8])
+ putStr "Word16 : " >> print (map fromIntegral numbers :: [Word16])
+ putStr "Word32 : " >> print (map fromIntegral numbers :: [Word32])
+ putStr "Word64 : " >> print (map fromIntegral numbers :: [Word64])
+ where numbers = [minBound, 0, maxBound] `asTypeOf` [zero]
+
+samples :: (Num a) => a -> [a]
+samples zero = map fromInteger ([-3 .. -1]++[0 .. 3])
+
+table1 :: (Show a, Show b) => String -> (a -> b) -> [a] -> IO ()
+table1 nm f xs = do
+ sequence [ f' x | x <- xs ]
+ putStrLn "#"
+ where
+ f' x = putStrLn (nm ++ " " ++ show x ++ " = " ++ show (f x))
+
+table2 :: (Show a, Show b, Show c) => String -> (a -> b -> c) -> [a] -> [b] -> IO ()
+table2 nm op xs ys = do
+ sequence [ sequence [ op' x y | y <- ys ] >> putStrLn " "
+ | x <- xs
+ ]
+ putStrLn "#"
+ where
+ op' x y = do s <- Control.Exception.catch
+ (evaluate (show (op x y)))
+ (\e -> return (show (e :: SomeException)))
+ putStrLn (show x ++ " " ++ nm ++ " " ++ show y ++ " = " ++ s)
+
+testReadShow zero = do
+ putStrLn "testReadShow"
+ print xs
+ print (map read_show xs)
+ where
+ xs = samples zero
+ read_show x = (read (show x) `asTypeOf` zero)
+
+testEq zero = do
+ putStrLn "testEq"
+ table2 "==" (==) xs xs
+ table2 "/=" (/=) xs xs
+ where
+ xs = samples zero
+
+testOrd zero = do
+ putStrLn "testOrd"
+ table2 "<=" (<=) xs xs
+ table2 "< " (<) xs xs
+ table2 "> " (>) xs xs
+ table2 ">=" (>=) xs xs
+ table2 "`compare`" compare xs xs
+ where
+ xs = samples zero
+
+testNum zero = do
+ putStrLn "testNum"
+ table2 "+" (+) xs xs
+ table2 "-" (-) xs xs
+ table2 "*" (*) xs xs
+ table1 "negate" negate xs
+ where
+ xs = samples zero
+
+testReal zero = do
+ putStrLn "testReal"
+ table1 "toRational" toRational xs
+ where
+ xs = samples zero
+
+testIntegral zero = do
+ putStrLn "testIntegral"
+ table2 "`divMod` " divMod xs xs
+ table2 "`div` " div xs xs
+ table2 "`mod` " mod xs xs
+ table2 "`quotRem`" quotRem xs xs
+ table2 "`quot` " quot xs xs
+ table2 "`rem` " rem xs xs
+ where
+ xs = samples zero
+
+testBits zero do_bitsize = do
+ putStrLn "testBits"
+ table2 ".&. " (.&.) xs xs
+ table2 ".|. " (.|.) xs xs
+ table2 "`xor`" xor xs xs
+ table1 "complement" complement xs
+ table2 "`shiftL`" shiftL xs ([0..3] ++ [32,64])
+ table2 "`shiftR`" shiftR xs ([0..3] ++ [32,64])
+ table2 "`rotate`" rotate xs ([-3..3] ++ [-64,-32,32,64])
+ table1 "bit" (\ x -> (bit x) `asTypeOf` zero) [(0::Int)..3]
+ table2 "`setBit`" setBit xs ([0..3] ++ [32,64])
+ table2 "`clearBit`" clearBit xs ([0..3] ++ [32,64])
+ table2 "`complementBit`" complementBit xs ([0..3] ++ [32,64])
+ table2 "`testBit`" testBit xs ([0..3] ++ [32,64])
+ if do_bitsize then table1 "bitSize" bitSize xs else return ()
+ table1 "isSigned" isSigned xs
+ where
+ xs = samples zero
View
90 tests/ghc-7.6/arith012.hs
@@ -0,0 +1,90 @@
+-- !!! Testing NumExts
+module Main(main) where
+
+import Numeric
+import Data.Char
+
+main :: IO ()
+main = tst
+
+tst :: IO ()
+tst = do
+ test_doubleToFloat
+ test_floatToDouble
+ test_showHex
+ test_showOct
+ test_showBin
+
+----
+-- Test data:
+doubles :: [Double]
+doubles = [ -1.2 , 0, 0.1, 0.5, 1.0, 1234.45454,
+ 1.6053e4, 1.64022e12, 6.894e-4, 6.34543455634582173,
+ 5342413403.40540423255]
+ints :: [Int]
+ints = [ 0, 1, 255, 65513, 6029, 1024, 256, 201357245]
+
+integers :: [Integer]
+integers = [ 0, 1, 255, 65513, 6029, 1024, 256,
+ 2343243543500233, 656194962055457832]
+---
+
+test_doubleToFloat :: IO ()
+test_doubleToFloat = do
+ test_banner "doubleToFloat"
+ putStrLn (show doubles)
+ putStrLn (show $ map doubleToFloat doubles)
+
+doubleToFloat :: Double -> Float
+doubleToFloat = realToFrac
+
+floatToDouble :: Float -> Double
+floatToDouble = realToFrac
+
+test_floatToDouble :: IO ()
+test_floatToDouble = do
+ test_banner "doubleToFloat"
+ putStrLn (show doubles)
+ putStrLn (show $ map doubleToFloat doubles)
+ putStrLn (show $ map (floatToDouble.doubleToFloat) doubles)
+
+test_showHex :: IO ()
+test_showHex = do
+ test_banner "showHex"
+ putStrLn (show ints)
+ putStrLn (showList' (map showHex ints))
+ putStrLn (show integers)
+ putStrLn (showList' (map showHex integers))
+
+test_showBin :: IO ()
+test_showBin = do
+ test_banner "showBin"
+ putStrLn (show ints)
+ putStrLn (showList' (map showBin ints))
+ putStrLn (show integers)
+ putStrLn (showList' (map showBin integers))
+
+showBin i = showIntAtBase 2 intToDigit i
+
+showList' :: [ShowS] -> String
+showList' [] = "[]"
+showList' (x:xs) = showChar '[' . x $ showl xs ""
+ where
+ showl [] = showChar ']'
+ showl (x:xs) = showChar ',' . x . showl xs
+
+
+test_showOct :: IO ()
+test_showOct = do
+ test_banner "showOct"
+ putStrLn (show ints)
+ putStrLn (showList' (map showOct ints))
+ putStrLn (show integers)
+ putStrLn (showList' (map showOct integers))
+
+----
+test_banner :: String -> IO ()
+test_banner tst = do
+ putStrLn $ "--------------------------------"
+ putStrLn $ "--Testing " ++ tst
+ putStrLn $ "--------------------------------"
View
13 tests/ghc-7.6/arith013.hs
@@ -0,0 +1,13 @@
+-- Test gcdInt/gcdInteger
+
+import GHC.Real ( gcdInt )
+import GHC.Integer.GMP.Internals ( gcdInteger )
+
+main :: IO ()
+main = do
+ test gcdInt [ -42, 0, 105 ]
+ test gcdInteger [-12193263111263526900, -42, 0, 105, 1234567890 ]
+
+
+test :: (Show a, Integral a) => (a -> a -> a) -> [a] -> IO ()
+test f xs = mapM_ print [ (a, b, f a b) | a <- xs, b <- reverse xs, a /= 0 || b /= 0 ]
View
11 tests/ghc-7.6/arith014.hs
@@ -0,0 +1,11 @@
+-- Test behaviour of fromInteger when the target type is out of range.
+
+main :: IO ()
+main =
+ print [
+ fromInteger maxInt2 :: Int,
+ fromInteger minInt2 :: Int
+ ]
+
+maxInt2 = fromIntegral (maxBound :: Int) * 2 :: Integer
+minInt2 = fromIntegral (minBound + 1 :: Int) * 2 :: Integer
View
5 tests/ghc-7.6/arith015.hs
@@ -0,0 +1,5 @@
+main = do
+ print (map read strange_nums :: [Float])
+ print (map read strange_nums :: [Double])
+ where
+ strange_nums = ["Infinity","NaN", "-Infinity"]
View
33 tests/ghc-7.6/arith016.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE MagicHash #-}
+
+module Main where
+
+import GHC.Exts ( Float(F#),
+ eqFloat#, neFloat#, ltFloat#,
+ leFloat#, gtFloat#, geFloat#
+ )
+
+fcmp_eq, fcmp_ne, fcmp_lt, fcmp_le, fcmp_gt, fcmp_ge :: (String, Float -> Float -> Bool)
+fcmp_eq = ("==", \ (F# a) (F# b) -> a `eqFloat#` b)
+fcmp_ne = ("/=", \ (F# a) (F# b) -> a `neFloat#` b)
+fcmp_lt = ("< ", \ (F# a) (F# b) -> a `ltFloat#` b)
+fcmp_le = ("<=", \ (F# a) (F# b) -> a `leFloat#` b)
+fcmp_gt = ("> ", \ (F# a) (F# b) -> a `gtFloat#` b)
+fcmp_ge = (">=", \ (F# a) (F# b) -> a `geFloat#` b)
+
+float_fns = [fcmp_eq, fcmp_ne, fcmp_lt, fcmp_le, fcmp_gt, fcmp_ge]
+
+float_vals :: [Float]
+float_vals = [0.0, 1.0, read "NaN"]
+
+float_text
+ = [show4 arg1 ++ " " ++ fn_name ++ " " ++ show4 arg2 ++ " = " ++ show (fn arg1 arg2)
+ | (fn_name, fn) <- float_fns,
+ arg1 <- float_vals,
+ arg2 <- float_vals
+ ]
+ where
+ show4 x = take 4 (show x ++ repeat ' ')
+
+main
+ = putStrLn (unlines float_text)
View
10 tests/ghc-7.6/arith017.hs
@@ -0,0 +1,10 @@
+-- !!! test for a bug in integer->{Int,Word}64 conversion in GHC 5.04.x
+
+import Data.Int
+import Data.Word
+
+main = do
+ print (fromIntegral ((2^30 -1 + 2^30) - (2^30 + 2^30 :: Integer))
+ :: Data.Int.Int64)
+ print (fromIntegral ((2^30 -1 + 2^30) - (2^30 + 2^30 :: Integer))
+ :: Data.Word.Word64)
View
12 tests/ghc-7.6/arith018.hs
@@ -0,0 +1,12 @@
+-- exposes a bug in the native code generator in GHC 6.4.1. Division by
+-- a power of 2 was being mis-optimsed to a direct shift.
+
+main = do
+ print (map f4 [(-20) .. (-1)])
+ print (map f8 [(-20) .. (-1)])
+
+f4 :: Int -> Int
+f4 x = x `quot` 4
+
+f8 :: Int -> Int
+f8 x = x `quot` 8
View
10 tests/ghc-7.6/arith019.hs
@@ -0,0 +1,10 @@
+-- demonstrates a bug in mulIntMayOflo in GHC 6.5 on 64-bit arches
+-- (trac #867).
+-- It thought it could represent 3049800625 * 3049800625 in an I#.
+
+i :: Integer
+i = 3049800625
+
+main :: IO ()
+main = print (i * i)
+
View
7 tests/ghc-7.6/expfloat.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE MagicHash #-}
+-- tests that expFloat# works (had linking problems on Windows)
+
+import GHC.Exts
+
+main = do
+ print (F# (expFloat# 3.45#))
View
17 tests/ghc-7.6/numrun009.hs
@@ -0,0 +1,17 @@
+-- !!! tests that minBound::Int is correctly handled (for Int & Integer
+
+-- (not necessarily Haskell 98: relies on Int being a 32-bit type.)
+
+main = do
+ print (-2147483648 :: Int) -- -2147483648
+ print ((-2147483647)-1 :: Int) -- -2147483648
+ print (-2147483648 :: Integer) -- -2147483648
+ print ((-2147483648 :: Int) >= 0) -- False
+ print ((-2147483648 :: Integer) >= 0) -- False
+ print (-(-2147483648) :: Int) -- <undefined>
+ print (abs (-2147483648) :: Int) -- <undefined>
+ print (abs ((-2147483647)-1) :: Int) -- <undefined>
+ print (abs (-2147483648) :: Integer) -- 2147483648
+ print (abs ((-2147483647)-1) :: Integer) -- 2147483648 (wrong in 4.04)
+ print (fromInteger (-2147483648 :: Integer) :: Int) -- -2147483648
+ print (fromInteger ((-2147483647)-1 :: Integer) :: Int) -- -2147483648
View
13 tests/ghc-7.6/numrun010.hs
@@ -0,0 +1,13 @@
+-- !!! tests that local fixity declarations work
+
+-- If local fixity decls don't work you get "14"
+-- The right answer is "11"
+
+val = 3 +! 4 *! 2
+ where (+!) = (+)
+ (*!) = (*)
+ infixl 6 +!
+ infixl 7 *!
+
+main = print val
+
View
2  tests/ghc-7.6/numrun011.hs
@@ -0,0 +1,2 @@
+import Data.Ratio
+main = print (fromRational (1 % 85070591730234615865843651857942052864) :: Float)
View
35 tests/ghc-7.6/numrun012.hs
@@ -0,0 +1,35 @@
+
+-- Test for trac #921
+
+import GHC.Float
+import Foreign
+import Control.Monad
+
+main :: IO ()
+main = do -- The reported case
+ putStrLn (show (map log2 vals))
+ -- Smaller failing cases
+ print (fromIntegral ((2^31) :: Int) :: Double)
+ if_not_32 $ print (round ((2^33) :: Double) :: Int)
+ print (fromIntegral ((2^31) :: Int) :: Float)
+ if_not_32 $ print (round ((2^33) :: Float) :: Int)
+ -- The underlying failing internal operations
+ print (int2Double (2^31))
+ if_not_32 $ print (double2Int (2^33))
+ print (int2Float (2^31))
+ if_not_32 $ print (float2Int (2^33))
+ where
+ -- the value of float2Int x where the result would be outside the
+ -- range of the target is undefined. We also take the view in GHC
+ -- that round and truncate are similarly undefined when the result
+ -- would be outside the range of the target type (see #1254)
+ if_not_32 = when (sizeOf (undefined::Int) > 4)
+
+log2 x = ceiling log_x
+ where log_x :: Double
+ log_x = logBase 2 (fromIntegral (max 1 x))
+
+vals = [1, 2, 17, 259, 1000, 10000,
+ 2^30 + 9000, 2^31 - 1, 2^31 + 1,
+ 2^32 - 1, 2^32 + 1]
+
View
17 tests/ghc-7.6/numrun013.hs
@@ -0,0 +1,17 @@
+
+-- Test for trac #1042
+
+import Control.Exception
+import Data.Int
+import Prelude hiding (catch)
+
+main :: IO ()
+main = do print ((minBound :: Int) `div` (-1)) `myCatch` print
+ print ((minBound :: Int8) `div` (-1)) `myCatch` print
+ print ((minBound :: Int16) `div` (-1)) `myCatch` print
+ print ((minBound :: Int32) `div` (-1)) `myCatch` print
+ print ((minBound :: Int64) `div` (-1)) `myCatch` print
+
+myCatch :: IO a -> (ArithException -> IO a) -> IO a
+myCatch = catch
+
View
211 tests/ghc-7.6/numrun014.hs
@@ -0,0 +1,211 @@
+
+-- Test that we don't have rules (or othre optimisations) doing the
+-- wrong thing for constant folding with Doubles.
+
+module Main (main) where
+
+zero :: Double
+zero = 0
+
+one :: Double
+one = 1
+
+nan :: Double
+nan = 0 / 0
+
+inf :: Double
+inf = 1 / 0
+
+neginf :: Double
+neginf = -1 / 0
+
+fzero :: Float
+fzero = 0
+
+fone :: Float
+fone = 1
+
+fnan :: Float
+fnan = 0 / 0
+
+finf :: Float
+finf = 1 / 0
+
+fneginf :: Float
+fneginf = -1 / 0
+
+main :: IO ()
+main = do putStrLn "=== Subtraction ==="
+ print (zero - zero)
+ print (zero - nan)
+ print (zero - inf)
+ print (zero - neginf)
+ print (nan - zero)
+ print (nan - nan)
+ print (nan - inf)
+ print (nan - neginf)
+ print (inf - zero)
+ print (inf - nan)
+ print (inf - inf)
+ print (inf - neginf)
+ print (neginf - zero)
+ print (neginf - nan)
+ print (neginf - inf)
+ print (neginf - neginf)
+ putStrLn "=== Addition ==="
+ print (zero + zero)
+ print (zero + nan)
+ print (zero + inf)
+ print (zero + neginf)
+ print (nan + zero)
+ print (nan + nan)
+ print (nan + inf)
+ print (nan + neginf)
+ print (inf + zero)
+ print (inf + nan)
+ print (inf + inf)
+ print (inf + neginf)
+ print (neginf + zero)
+ print (neginf + nan)
+ print (neginf + inf)
+ print (neginf + neginf)
+ putStrLn "=== Mutiplication ==="
+ print (zero * zero)
+ print (zero * one)
+ print (zero * nan)
+ print (zero * inf)
+ print (zero * neginf)
+ print (one * zero)
+ print (one * one)
+ print (one * nan)
+ print (one * inf)
+ print (one * neginf)
+ print (nan * zero)
+ print (nan * one)
+ print (nan * nan)
+ print (nan * inf)
+ print (nan * neginf)
+ print (inf * zero)
+ print (inf * one)
+ print (inf * nan)
+ print (inf * inf)
+ print (inf * neginf)
+ print (neginf * zero)
+ print (neginf * one)
+ print (neginf * nan)
+ print (neginf * inf)
+ print (neginf * neginf)
+ putStrLn "=== Division ==="
+ print (zero / zero)
+ print (zero / one)
+ print (zero / nan)
+ print (zero / inf)
+ print (zero / neginf)
+ print (one / zero)
+ print (one / one)
+ print (one / nan)
+ print (one / inf)
+ print (one / neginf)
+ print (nan / zero)
+ print (nan / one)
+ print (nan / nan)
+ print (nan / inf)
+ print (nan / neginf)
+ print (inf / zero)
+ print (inf / one)
+ print (inf / nan)
+ print (inf / inf)
+ print (inf / neginf)
+ print (neginf / zero)
+ print (neginf / one)
+ print (neginf / nan)
+ print (neginf / inf)
+ print (neginf / neginf)
+
+ putStrLn "=== Subtraction ==="
+ print (fzero - fzero)
+ print (fzero - fnan)
+ print (fzero - finf)
+ print (fzero - fneginf)
+ print (fnan - fzero)
+ print (fnan - fnan)
+ print (fnan - finf)
+ print (fnan - fneginf)
+ print (finf - fzero)
+ print (finf - fnan)
+ print (finf - finf)
+ print (finf - fneginf)
+ print (fneginf - fzero)
+ print (fneginf - fnan)
+ print (fneginf - finf)
+ print (fneginf - fneginf)
+ putStrLn "=== Addition ==="
+ print (fzero + fzero)
+ print (fzero + fnan)
+ print (fzero + finf)
+ print (fzero + fneginf)
+ print (fnan + fzero)
+ print (fnan + fnan)
+ print (fnan + finf)
+ print (fnan + fneginf)
+ print (finf + fzero)
+ print (finf + fnan)
+ print (finf + finf)
+ print (finf + fneginf)
+ print (fneginf + fzero)
+ print (fneginf + fnan)
+ print (fneginf + finf)
+ print (fneginf + fneginf)
+ putStrLn "=== Mutiplication ==="
+ print (fzero * fzero)
+ print (fzero * fone)
+ print (fzero * fnan)
+ print (fzero * finf)
+ print (fzero * fneginf)
+ print (fone * fzero)
+ print (fone * fone)
+ print (fone * fnan)
+ print (fone * finf)
+ print (fone * fneginf)
+ print (fnan * fzero)
+ print (fnan * fone)
+ print (fnan * fnan)
+ print (fnan * finf)
+ print (fnan * fneginf)
+ print (finf * fzero)
+ print (finf * fone)
+ print (finf * fnan)
+ print (finf * finf)
+ print (finf * fneginf)
+ print (fneginf * fzero)
+ print (fneginf * fone)
+ print (fneginf * fnan)
+ print (fneginf * finf)
+ print (fneginf * fneginf)
+ putStrLn "=== Division ==="
+ print (fzero / fzero)
+ print (fzero / fone)
+ print (fzero / fnan)
+ print (fzero / finf)
+ print (fzero / fneginf)
+ print (fone / fzero)
+ print (fone / fone)
+ print (fone / fnan)
+ print (fone / finf)
+ print (fone / fneginf)
+ print (fnan / fzero)
+ print (fnan / fone)
+ print (fnan / fnan)
+ print (fnan / finf)
+ print (fnan / fneginf)
+ print (finf / fzero)
+ print (finf / fone)
+ print (finf / fnan)
+ print (finf / finf)
+ print (finf / fneginf)
+ print (fneginf / fzero)
+ print (fneginf / fone)
+ print (fneginf / fnan)
+ print (fneginf / finf)
+ print (fneginf / fneginf)
+
Please sign in to comment.
Something went wrong with that request. Please try again.