Commit 5f64b2c6 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

Add test-case for #8726

This tests various properties expected to hold for
quotRem, divMod, div, mod, quot, and rem.
Signed-off-by: Herbert Valerio Riedel's avatarHerbert Valerio Riedel <hvr@gnu.org>
parent b5c45d84
import Control.Monad
import Data.Bits
import Data.List
import Data.Ord
-- | test-values to use as numerator/denominator
posvals :: [Integer]
posvals = [1,2,3,4,5,9,10,14,15,16,17] ++
[ n | e <- ([5..70]++[96,128,160,192,224])
, ofs <- [-1..1], let n = bit e + ofs ]
posvalsSum :: Integer
posvalsSum = 0x300000003000000030000000300000003000001800000000000000000
vals :: [Integer]
vals = sortBy (comparing abs) $ map negate posvals ++ [0] ++ posvals
main :: IO ()
main = do
unless (sum posvals == posvalsSum) $
fail $ "sum posvals == " ++ show (sum posvals)
forM_ [ (n,d) | n <- vals, d <- vals, d /= 0 ] $ \(n,d) -> do
let check sp p = unless (p n d) $ fail (sp ++ " " ++ show n ++ " " ++ show d)
check "rem0" prop_rem0
check "mod0" prop_mod0
check "divMod0" prop_divMod0
check "divMod1" prop_divMod1
check "divMod2" prop_divMod2
check "quotRem0" prop_quotRem0
check "quotRem1" prop_quotRem1
check "quotRem2" prop_quotRem2
-- putStrLn "passed"
-- QuickCheck style properties
prop_rem0 :: Integer -> Integer -> Bool
prop_rem0 n d
| n >= 0 = (n `rem` d) `inside` (-1,abs d)
| otherwise = (n `rem` d) `inside` (-(abs d),1)
where
inside v (l,u) = l < v && v < u
prop_mod0 :: Integer -> Integer -> Bool
prop_mod0 n d
| d >= 0 = (n `mod` d) `inside` (-1,d)
| otherwise = (n `mod` d) `inside` (d,1)
where
inside v (l,u) = l < v && v < u
-- | Invariant from Haskell Report
prop_divMod0 :: Integer -> Integer -> Bool
prop_divMod0 n d = (n `div` d) * d + (n `mod` d) == n
prop_divMod1 :: Integer -> Integer -> Bool
prop_divMod1 n d = divMod n d == (n `div` d, n `mod` d)
-- | Compare IUT to implementation of 'divMod' in terms of 'quotRem'
prop_divMod2 :: Integer -> Integer -> Bool
prop_divMod2 n d = divMod n d == divMod' n d
where
divMod' x y = if signum r == negate (signum y) then (q-1, r+y) else qr
where qr@(q,r) = quotRem x y
-- | Invariant from Haskell Report
prop_quotRem0 :: Integer -> Integer -> Bool
prop_quotRem0 n d = (n `quot` d) * d + (n `rem` d) == n
prop_quotRem1 :: Integer -> Integer -> Bool
prop_quotRem1 n d = quotRem n d == (n `quot` d, n `rem` d)
-- | Test symmetry properties of 'quotRem'
prop_quotRem2 :: Integer -> Integer -> Bool
prop_quotRem2 n d = (qr == negQ (quotRem n (-d)) &&
qr == negR (quotRem (-n) (-d)) &&
qr == (negQ . negR) (quotRem (-n) d))
where
qr = quotRem n d
negQ (q,r) = (-q,r)
negR (q,r) = (q,-r)
......@@ -61,3 +61,4 @@ test('T7014',
test('T7233', normal, compile_and_run, [''])
test('NumDecimals', normal, compile_and_run, [''])
test('T8726', normal, compile_and_run, [''])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment