1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE TemplateHaskell #-}
import Test.QuickCheck
import Test.QuickCheck.Arbitrary
import Control.Monad (unless)
import System.Exit (exitFailure)
import Foreign
import Numeric.GMP.Types
import Numeric.GMP.Utils
import Numeric.GMP.Raw.Safe (mpz_mul, mpq_mul)
-- instance Arbitrary Integer has small range
newtype Big = Big{ getBig :: Integer } deriving (Show)
instance Arbitrary Big where
arbitrary = fmap Big $ choose (-bit 100, bit 100)
shrink = fmap Big . shrinkIntegral . getBig
prop_IntegerWithPeek' n = ioProperty $ do
m <- withInInteger' n peekInteger'
return (n == m)
prop_IntegerWithPeek n = ioProperty $ do
m <- withInInteger n peekInteger
return (n == m)
prop_IntegerMultiply a b = ioProperty $ do
(c, _) <-
withOutInteger $ \cz ->
withInInteger a $ \az ->
withInInteger b $ \bz ->
mpz_mul cz az bz
return (a * b == c)
prop_BigIntegerWithPeek' (Big n) = ioProperty $ do
m <- withInInteger' n peekInteger'
return (n == m)
prop_BigIntegerWithPeek (Big n) = ioProperty $ do
m <- withInInteger n peekInteger
return (n == m)
prop_BigIntegerMultiply (Big a) (Big b) = ioProperty $ do
(c, _) <-
withOutInteger $ \cz ->
withInInteger a $ \az ->
withInInteger b $ \bz ->
mpz_mul cz az bz
return (a * b == c)
prop_RationalWithPeek' n = ioProperty $ do
m <- withInRational' n peekRational'
return (n == m)
prop_RationalWithPeek n = ioProperty $ do
m <- withInRational n peekRational
return (n == m)
prop_RationalMultiply a b = ioProperty $ do
(c, _) <-
withOutRational $ \cq ->
withInRational a $ \aq ->
withInRational b $ \bq ->
mpq_mul cq aq bq
return (a * b == c)
return []
main = do
r <- $quickCheckAll
unless r exitFailure
|
