[project @ 1998-01-30 16:53:35 by sof]

- added regressions tests for Word, Int & Bits
  (pinched test file from Hugs dist.)
- added NumExts regressions tests

ghc/tests/numeric/should_run/arith011.hs

+--!!! Testing Int and Word
+module Main(main) where
+import Int
+import Word
+import Bits
+import Ix -- added SOF
+
+main :: IO ()
+main = test
+
+test :: IO ()
+test = do
+   testIntlike "Int8"   (0::Int8)     
+   testIntlike "Int16"  (0::Int16)    
+   testIntlike "Int32"  (0::Int32)    
+   testIntlike "Word8"  (0::Word8)    
+   testIntlike "Word16" (0::Word16)   
+   testIntlike "Word32" (0::Word32)   
+
+testIntlike :: (Bounded a, Integral a, Ix 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
+  testBits     zero
+  putStrLn $ "--------------------------------"
+
+-- 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
+
+samples :: (Num a, Enum a) => a -> ([a], [a])
+samples zero = ([-3 .. -1]++[0 .. 3], [-3 .. -1]++[1 .. 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 = putStrLn (show x ++ " " ++ nm ++ " " ++ show y 
+                      ++ " = " ++ show (op x y))
+
+testReadShow zero = do
+  putStrLn "testReadShow"
+  print xs
+  print (map read_show xs)
+ where
+  (xs,zs) = samples zero
+  read_show x = (read (show x) `asTypeOf` zero)
+
+testEq zero = do
+  putStrLn "testEq"
+  table2 "==" (==) xs xs
+  table2 "/=" (/=) xs xs
+ where
+  (xs,ys) = 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,ys) = samples zero
+
+testNum zero = do
+  putStrLn "testNum"
+  table2 "+"  	  (+)    xs xs
+  table2 "-"  	  (-)    xs xs
+  table2 "*"  	  (*)    xs xs
+  table1 "negate" negate xs
+ where
+  (xs,ys) = samples zero
+
+testReal zero = do
+  putStrLn "testReal"
+  table1 "toRational" toRational xs
+ where
+  (xs,ys) = samples zero
+
+testIntegral zero = do
+  putStrLn "testIntegral"
+  table2 "`divMod` " divMod  xs ys
+  table2 "`div`    " div     xs ys
+  table2 "`mod`    " mod     xs ys
+  table2 "`quotRem`" quotRem xs ys
+  table2 "`quot`   " quot    xs ys
+  table2 "`rem`    " rem     xs ys
+ where
+  (xs,ys) = samples zero
+
+testBits zero = do
+  putStrLn "testBits"
+  table2 ".&.  "            (.&.)         xs ys
+  table2 ".|.  "            (.|.)         xs ys
+  table2 "`xor`"            xor           xs ys
+  table1 "complement"       complement    xs
+  table2 "`shift`"          shift         xs [0..3] 
+  table2 "`rotate`"         rotate        xs ([-3..3])
+  table1 "bit"              (\ x -> (bit x) `asTypeOf` zero)   [(0::Int)..3]
+  table2 "`setBit`"         setBit        xs [0..3]
+  table2 "`clearBit`"       clearBit      xs [0..3]
+  table2 "`complementBit`"  complementBit xs [0..3]
+  table2 "`testBit`"        testBit       xs [0..3]
+  table1 "bitSize"          bitSize       xs
+  table1 "isSigned"         isSigned      xs
+ where
+  (xs,ys) = samples zero

ghc/tests/numeric/should_run/arith012.hs

+--!!! Testing NumExts
+module Main(main) where
+
+import NumExts
+
+main :: IO ()
+main = tst
+
+tst :: IO ()
+tst = do
+  test_doubleToFloat
+  test_floatToDouble
+  test_showHex
+  test_showOct
+
+----
+-- 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)
+
+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))
+
+showList' :: [ShowS] -> String
+showList' [] = "[]"
+showList' (x:xs) = showChar '[' . x $ showl xs ""
+      where 
+       showl []     = showChar ']'
+       showl (x:xs) = showString ", " . 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 $ "--------------------------------"

ghc/tests/numeric/should_run/arith012.stdout

+--------------------------------
+--Testing doubleToFloat
+--------------------------------
+[-1.2, 0.0, 0.1, 0.5, 1.0, 1234.45454, 16053.0, 1.64022e12, 6.894e-4, 6.345434556345822, 5.342413403405404e9]
+[-1.2, 0.0, 0.1, 0.5, 1.0, 1234.4546, 16053.0, 1.64022e12, 6.894e-4, 6.3454347, 5.3424133e9]
+--------------------------------
+--Testing doubleToFloat
+--------------------------------
+[-1.2, 0.0, 0.1, 0.5, 1.0, 1234.45454, 16053.0, 1.64022e12, 6.894e-4, 6.345434556345822, 5.342413403405404e9]
+[-1.2, 0.0, 0.1, 0.5, 1.0, 1234.4546, 16053.0, 1.64022e12, 6.894e-4, 6.3454347, 5.3424133e9]
+[-1.2000000476837158, 0.0, 0.10000000149011612, 0.5, 1.0, 1234.45458984375, 16053.0, 1.64021993472e12, 6.894000107422471e-4, 6.345434665679932, 5.342413312e9]
+--------------------------------
+--Testing showHex
+--------------------------------
+[0, 1, 255, 65513, 6029, 1024, 256, 201357245]
+[0x0, 0x1, 0xff, 0xffe9, 0x178d, 0x400, 0x100, 0xc0077bd]
+[0, 1, 255, 65513, 6029, 1024, 256, 2343243543500233, 656194962055457832]
+[0x0, 0x1, 0xff, 0xffe9, 0x178d, 0x400, 0x100, 0x8532ae70855c9, 0x91b45d760b76c28]
+--------------------------------
+--Testing showOct
+--------------------------------
+[0, 1, 255, 65513, 6029, 1024, 256, 201357245]
+[0o0, 0o1, 0o377, 0o177751, 0o13615, 0o2000, 0o400, 0o1400073675]
+[0, 1, 255, 65513, 6029, 1024, 256, 2343243543500233, 656194962055457832]
+[0o0, 0o1, 0o377, 0o177751, 0o13615, 0o2000, 0o400, 0o102462534702052711, 0o44332135354055666050]