From 14286c61abc007b3c48cbc62d289de5cb3e6ce91 Mon Sep 17 00:00:00 2001 From: Phil Freeman Date: Fri, 5 Jun 2015 18:44:32 -0700 Subject: [PATCH] Updates for 0.7 --- src/Test/QuickCheck.purs | 28 ++++++------ src/Test/QuickCheck/Arbitrary.purs | 45 +++++++++---------- src/Test/QuickCheck/Data/AlphaNumString.purs | 19 ++++---- src/Test/QuickCheck/Data/ApproxNumber.purs | 13 +++--- src/Test/QuickCheck/Gen.js | 12 +++++ src/Test/QuickCheck/Gen.purs | 46 +++++++++----------- src/Test/QuickCheck/LCG.purs | 10 +++-- 7 files changed, 93 insertions(+), 80 deletions(-) create mode 100644 src/Test/QuickCheck/Gen.js diff --git a/src/Test/QuickCheck.purs b/src/Test/QuickCheck.purs index 02bf251..c687ce7 100644 --- a/src/Test/QuickCheck.purs +++ b/src/Test/QuickCheck.purs @@ -17,12 +17,14 @@ -- | ``` module Test.QuickCheck where +import Prelude + import Console (CONSOLE(), log) -import Control.Monad (replicateM) import Control.Monad.Eff (Eff()) import Control.Monad.Eff.Exception (EXCEPTION(), throwException, error) import Control.Monad.Eff.Random (RANDOM(), random) -import Data.Int (Int(), fromNumber, toNumber) +import Data.Int (fromNumber, toNumber) +import Data.List (List(..), replicateM) import Test.QuickCheck.Arbitrary import Test.QuickCheck.Gen import Test.QuickCheck.LCG @@ -35,7 +37,7 @@ type QC a = forall eff. Eff (console :: CONSOLE, random :: RANDOM, err :: EXCEPT -- | This function generates a new random seed, runs 100 tests and -- | prints the test results to the console. quickCheck :: forall prop. (Testable prop) => prop -> QC Unit -quickCheck prop = quickCheck' (fromNumber 100) prop +quickCheck prop = quickCheck' 100 prop -- | A variant of the `quickCheck` function which accepts an extra parameter -- | representing the number of tests which should be run. @@ -49,22 +51,22 @@ quickCheck' n prop = do where - throwOnFirstFailure :: Int -> [Result] -> QC Unit - throwOnFirstFailure _ [] = return unit - throwOnFirstFailure n (Failed msg : _) = throwException $ error $ "Test " ++ show (toNumber n) ++ " failed: \n" ++ msg - throwOnFirstFailure n (_ : rest) = throwOnFirstFailure (n + one) rest + throwOnFirstFailure :: Int -> List Result -> QC Unit + throwOnFirstFailure _ Nil = return unit + throwOnFirstFailure n (Cons (Failed msg) _) = throwException $ error $ "Test " ++ show (toNumber n) ++ " failed: \n" ++ msg + throwOnFirstFailure n (Cons _ rest) = throwOnFirstFailure (n + one) rest - countSuccesses :: [Result] -> Int - countSuccesses [] = zero - countSuccesses (Success : rest) = one + countSuccesses rest - countSuccesses (_ : rest) = countSuccesses rest + countSuccesses :: List Result -> Int + countSuccesses Nil = zero + countSuccesses (Cons Success rest) = one + countSuccesses rest + countSuccesses (Cons _ rest) = countSuccesses rest -- | Test a property, returning all test results as an array. -- | -- | The first argument is the _random seed_ to be passed to the random generator. -- | The second argument is the number of tests to run. -quickCheckPure :: forall prop. (Testable prop) => Int -> Int -> prop -> [Result] -quickCheckPure s n prop = evalGen (replicateM n (test prop)) { newSeed: s, size: fromNumber 10 } +quickCheckPure :: forall prop. (Testable prop) => Int -> Int -> prop -> List Result +quickCheckPure s n prop = evalGen (replicateM n (test prop)) { newSeed: s, size: 10 } -- | The `Testable` class represents _testable properties_. -- | diff --git a/src/Test/QuickCheck/Arbitrary.purs b/src/Test/QuickCheck/Arbitrary.purs index 18e3d3d..95e9ac0 100644 --- a/src/Test/QuickCheck/Arbitrary.purs +++ b/src/Test/QuickCheck/Arbitrary.purs @@ -1,12 +1,15 @@ module Test.QuickCheck.Arbitrary where -import Data.Array (map) -import Data.Char (Char(), toCharCode, fromCharCode) +import Prelude + +import Data.Array ((:)) +import Data.Char (toCharCode, fromCharCode) import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.String (charCodeAt, fromCharArray, split) import Data.Tuple (Tuple(..)) -import Data.Int (Int(), fromNumber, toNumber) +import Data.Int (fromNumber, toNumber) +import Data.Foldable (foldl) import Test.QuickCheck.Gen -- | The `Arbitrary` class represents those types whose values can be @@ -32,11 +35,11 @@ class Coarbitrary t where instance arbBoolean :: Arbitrary Boolean where arbitrary = do n <- uniform - return $ (n * 2) < 1 + return $ (n * 2.0) < 1.0 instance coarbBoolean :: Coarbitrary Boolean where - coarbitrary true = perturbGen 1 - coarbitrary false = perturbGen 2 + coarbitrary true = perturbGen 1.0 + coarbitrary false = perturbGen 2.0 instance arbNumber :: Arbitrary Number where arbitrary = uniform @@ -45,7 +48,7 @@ instance coarbNumber :: Coarbitrary Number where coarbitrary = perturbGen instance arbInt :: Arbitrary Int where - arbitrary = chooseInt (fromNumber (-1000000)) (fromNumber 1000000) + arbitrary = chooseInt (-1000000) 1000000 instance coarbInt :: Coarbitrary Int where coarbitrary = perturbGen <<< toNumber @@ -57,7 +60,7 @@ instance coarbString :: Coarbitrary String where coarbitrary s = coarbitrary $ (charCodeAt zero <$> split "" s) instance arbChar :: Arbitrary Char where - arbitrary = fromCharCode <<< fromNumber <<< (* 65535) <$> uniform + arbitrary = fromCharCode <$> chooseInt 0 65536 instance coarbChar :: Coarbitrary Char where coarbitrary c = coarbitrary $ toCharCode c @@ -66,22 +69,17 @@ instance arbUnit :: Arbitrary Unit where arbitrary = return unit instance coarbUnit :: Coarbitrary Unit where - coarbitrary _ = perturbGen 1 + coarbitrary _ = perturbGen 1.0 instance arbOrdering :: Arbitrary Ordering where - arbitrary = do - n <- chooseInt (fromNumber 1) (fromNumber 3) - return $ case toNumber n of - 1 -> LT - 2 -> EQ - 3 -> GT + arbitrary = oneOf (pure LT) [pure EQ, pure GT] instance coarbOrdering :: Coarbitrary Ordering where - coarbitrary LT = perturbGen 1 - coarbitrary EQ = perturbGen 2 - coarbitrary GT = perturbGen 3 + coarbitrary LT = perturbGen 1.0 + coarbitrary EQ = perturbGen 2.0 + coarbitrary GT = perturbGen 3.0 -instance arbArray :: (Arbitrary a) => Arbitrary [a] where +instance arbArray :: (Arbitrary a) => Arbitrary (Array a) where arbitrary = do b <- arbitrary if b then return [] else do @@ -89,9 +87,8 @@ instance arbArray :: (Arbitrary a) => Arbitrary [a] where as <- arbitrary return (a : as) -instance coarbArray :: (Coarbitrary a) => Coarbitrary [a] where - coarbitrary [] = id - coarbitrary (x : xs) = coarbitrary xs <<< coarbitrary x +instance coarbArray :: (Coarbitrary a) => Coarbitrary (Array a) where + coarbitrary = foldl (\f x -> f <<< coarbitrary x) id instance arbFunction :: (Coarbitrary a, Arbitrary b) => Arbitrary (a -> b) where arbitrary = repeatable (\a -> coarbitrary a arbitrary) @@ -99,7 +96,7 @@ instance arbFunction :: (Coarbitrary a, Arbitrary b) => Arbitrary (a -> b) where instance coarbFunction :: (Arbitrary a, Coarbitrary b) => Coarbitrary (a -> b) where coarbitrary f gen = do xs <- arbitrary - coarbitrary (map f xs) gen + coarbitrary (map f (xs :: Array a)) gen instance arbTuple :: (Arbitrary a, Arbitrary b) => Arbitrary (Tuple a b) where arbitrary = Tuple <$> arbitrary <*> arbitrary @@ -113,7 +110,7 @@ instance arbMaybe :: (Arbitrary a) => Arbitrary (Maybe a) where if b then pure Nothing else Just <$> arbitrary instance coarbMaybe :: (Coarbitrary a) => Coarbitrary (Maybe a) where - coarbitrary Nothing = perturbGen 1 + coarbitrary Nothing = perturbGen 1.0 coarbitrary (Just a) = coarbitrary a instance arbEither :: (Arbitrary a, Arbitrary b) => Arbitrary (Either a b) where diff --git a/src/Test/QuickCheck/Data/AlphaNumString.purs b/src/Test/QuickCheck/Data/AlphaNumString.purs index c2df2e9..7bde5ce 100644 --- a/src/Test/QuickCheck/Data/AlphaNumString.purs +++ b/src/Test/QuickCheck/Data/AlphaNumString.purs @@ -1,26 +1,29 @@ module Test.QuickCheck.Data.AlphaNumString where +import Prelude + import Data.Int (fromNumber, toNumber) -import Data.String (fromCharArray, length) +import Data.String (fromCharArray, toCharArray, length) import Data.String.Unsafe (charAt) import Math (round) +import Test.QuickCheck.Gen import Test.QuickCheck.Arbitrary -- | A newtype for `String` whose `Arbitrary` instance generated random -- | alphanumeric strings. newtype AlphaNumString = AlphaNumString String +runAlphaNumString :: AlphaNumString -> String runAlphaNumString (AlphaNumString s) = s instance arbAlphaNumString :: Arbitrary AlphaNumString where - arbitrary = do - arrNum <- arbitrary - return $ AlphaNumString <<< fromCharArray $ lookup <$> arrNum + arbitrary = AlphaNumString <<< fromCharArray <$> arrayOf anyChar where - chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" - lookup x = let index = fromNumber $ x * (toNumber (length chars) - 1) - in charAt index chars - + rest :: Array Char + rest = toCharArray "bcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" + + anyChar :: Gen Char + anyChar = oneOf (pure 'a') (map pure rest) instance coarbAlphaNumString :: Coarbitrary AlphaNumString where coarbitrary (AlphaNumString s) = coarbitrary s diff --git a/src/Test/QuickCheck/Data/ApproxNumber.purs b/src/Test/QuickCheck/Data/ApproxNumber.purs index 3d90d9b..14c2f38 100644 --- a/src/Test/QuickCheck/Data/ApproxNumber.purs +++ b/src/Test/QuickCheck/Data/ApproxNumber.purs @@ -1,5 +1,7 @@ module Test.QuickCheck.Data.ApproxNumber where +import Prelude + import Test.QuickCheck.Arbitrary -- | A newtype for `Number` whose `Eq` instance uses an epsilon value to allow @@ -19,24 +21,23 @@ instance coarbitraryApproxNumber :: Coarbitrary ApproxNumber where coarbitrary (ApproxNumber n) = coarbitrary n instance eqApproxNumber :: Eq ApproxNumber where - (==) (ApproxNumber x) (ApproxNumber y) = x =~= y - (/=) (ApproxNumber x) (ApproxNumber y) = not (x =~= y) + eq (ApproxNumber x) (ApproxNumber y) = x =~= y instance ordApproxNumber :: Ord ApproxNumber where compare (ApproxNumber x) (ApproxNumber y) = compare x y instance semiringApproxNumber :: Semiring ApproxNumber where - (+) (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x + y) + add (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x + y) zero = ApproxNumber zero - (*) (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x * y) + mul (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x * y) one = ApproxNumber one instance moduloSemiringApproxNumber :: ModuloSemiring ApproxNumber where - (/) (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x / y) + div (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x / y) mod (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x `mod` y) instance ringApproxNumber :: Ring ApproxNumber where - (-) (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x - y) + sub (ApproxNumber x) (ApproxNumber y) = ApproxNumber (x - y) instance divisionRingApproxNumber :: DivisionRing ApproxNumber instance numApproxNumber :: Num ApproxNumber diff --git a/src/Test/QuickCheck/Gen.js b/src/Test/QuickCheck/Gen.js new file mode 100644 index 0000000..82ac959 --- /dev/null +++ b/src/Test/QuickCheck/Gen.js @@ -0,0 +1,12 @@ +/* global exports */ +"use strict"; + +// module Test.QuickCheck.Gen + +exports.float32ToInt32 = function(n) { + var arr = new ArrayBuffer(4); + var fv = new Float32Array(arr); + var iv = new Int32Array(arr); + fv[0] = n; + return iv[0]; +}; \ No newline at end of file diff --git a/src/Test/QuickCheck/Gen.purs b/src/Test/QuickCheck/Gen.purs index 13c2f66..36733c5 100644 --- a/src/Test/QuickCheck/Gen.purs +++ b/src/Test/QuickCheck/Gen.purs @@ -26,15 +26,18 @@ module Test.QuickCheck.Gen , showSample' ) where +import Prelude + import Console (CONSOLE(), print) import Control.Monad.Eff (Eff()) import Data.Array ((!!), length, range) import Data.Foldable (fold) -import Data.Int (Int(), fromNumber, toNumber) +import Data.Int (fromNumber, toNumber) import Data.Maybe (fromMaybe) import Data.Monoid.Additive (Additive(..), runAdditive) import Data.Traversable (sequence) import Data.Tuple (Tuple(..), fst, snd) +import Data.List (List(..)) import Test.QuickCheck.LCG import qualified Math as M @@ -86,31 +89,31 @@ chooseInt a b = fromNumber <$> choose (toNumber a) (toNumber b + 0.999999999) -- | Create a random generator which selects and executes a random generator from -- | a non-empty collection of random generators with uniform probability. -oneOf :: forall a. Gen a -> [Gen a] -> Gen a +oneOf :: forall a. Gen a -> Array (Gen a) -> Gen a oneOf x xs = do n <- chooseInt zero (length xs) if n < one then x else fromMaybe x (xs !! (n - one)) -- | Create a random generator which selects and executes a random generator from -- | a non-empty, weighted collection of random generators. -frequency :: forall a. Tuple Number (Gen a) -> [Tuple Number (Gen a)] -> Gen a +frequency :: forall a. Tuple Number (Gen a) -> List (Tuple Number (Gen a)) -> Gen a frequency x xs = let - xxs = x : xs - total = runAdditive $ fold (((Additive <<< fst) <$> xxs) :: [Additive Number]) - pick n d [] = d - pick n d ((Tuple k x) : xs) = if n <= k then x else pick (n - k) d xs + xxs = Cons x xs + total = runAdditive $ fold (map (Additive <<< fst) xxs :: List (Additive Number)) + pick n d Nil = d + pick n d (Cons (Tuple k x) xs) = if n <= k then x else pick (n - k) d xs in do - n <- choose 0 total + n <- choose zero total pick n (snd x) xxs -- | Create a random generator which generates an array of random values. -arrayOf :: forall a. Gen a -> Gen [a] +arrayOf :: forall a. Gen a -> Gen (Array a) arrayOf g = sized $ \n -> do k <- chooseInt zero n vectorOf k g -- | Create a random generator which generates a non-empty array of random values. -arrayOf1 :: forall a. Gen a -> Gen (Tuple a [a]) +arrayOf1 :: forall a. Gen a -> Gen (Tuple a (Array a)) arrayOf1 g = sized $ \n -> do k <- chooseInt zero n x <- g @@ -118,12 +121,12 @@ arrayOf1 g = sized $ \n -> return $ Tuple x xs -- | Create a random generator which generates a vector of random values of a specified size. -vectorOf :: forall a. Int -> Gen a -> Gen [a] +vectorOf :: forall a. Int -> Gen a -> Gen (Array a) vectorOf k g = sequence $ const g <$> range one k -- | Create a random generator which selects a value from a non-empty collection with -- | uniform probability. -elements :: forall a. a -> [a] -> Gen a +elements :: forall a. a -> Array a -> Gen a elements x xs = do n <- chooseInt zero (length xs) pure if n == zero then x else fromMaybe x (xs !! (n - one)) @@ -137,7 +140,7 @@ evalGen :: forall a. Gen a -> GenState -> a evalGen gen st = (runGen gen st).value -- | Sample a random generator -sample :: forall r a. Size -> Gen a -> [a] +sample :: forall r a. Size -> Gen a -> Array a sample sz g = evalGen (vectorOf sz g) { newSeed: zero, size: sz } -- | Print a random sample to the console @@ -146,7 +149,7 @@ showSample' n g = print $ sample n g -- | Print a random sample of 10 values to the console showSample :: forall r a. (Show a) => Gen a -> Eff (console :: CONSOLE | r) Unit -showSample = showSample' (fromNumber 10) +showSample = showSample' 10 -- | A random generator which simply outputs the current seed lcgStep :: Gen Int @@ -157,25 +160,18 @@ lcgStep = Gen f where uniform :: Gen Number uniform = (\n -> toNumber n / toNumber lcgN) <$> lcgStep -foreign import float32ToInt32 - "function float32ToInt32(n) {\ - \ var arr = new ArrayBuffer(4);\ - \ var fv = new Float32Array(arr);\ - \ var iv = new Int32Array(arr);\ - \ fv[0] = n;\ - \ return iv[0];\ - \}" :: Number -> Int +foreign import float32ToInt32 :: Number -> Int -- | Perturb a random generator by modifying the current seed perturbGen :: forall a. Number -> Gen a -> Gen a perturbGen n (Gen f) = Gen $ \s -> f (s { newSeed = lcgNext (float32ToInt32 n) + s.newSeed }) instance functorGen :: Functor Gen where - (<$>) f (Gen g) = Gen $ \s -> case g s of + map f (Gen g) = Gen $ \s -> case g s of { value = value, state = state } -> { value: f value, state: state } instance applyGen :: Apply Gen where - (<*>) (Gen f) (Gen x) = Gen $ \s -> + apply (Gen f) (Gen x) = Gen $ \s -> case f s of { value = f', state = s' } -> case x s' of { value = x', state = s'' } -> { value: f' x', state: s'' } @@ -184,7 +180,7 @@ instance applicativeGen :: Applicative Gen where pure a = Gen (\s -> { value: a, state: s }) instance bindGen :: Bind Gen where - (>>=) (Gen f) g = Gen $ \s -> case f s of + bind (Gen f) g = Gen $ \s -> case f s of { value = value, state = state } -> runGen (g value) state instance monadGen :: Monad Gen diff --git a/src/Test/QuickCheck/LCG.purs b/src/Test/QuickCheck/LCG.purs index 997023a..8a041d6 100644 --- a/src/Test/QuickCheck/LCG.purs +++ b/src/Test/QuickCheck/LCG.purs @@ -7,9 +7,11 @@ module Test.QuickCheck.LCG , randomSeed ) where +import Prelude + import Control.Monad.Eff (Eff()) import Control.Monad.Eff.Random (RANDOM(), random) -import Data.Int (Int(), fromNumber, toNumber) +import Data.Int (fromNumber, toNumber) import Data.Int.Bits (shl) type Seed = Int @@ -19,15 +21,15 @@ lcgM :: Int lcgM = fromNumber lcgM' lcgM' :: Number -lcgM' = 1103515245 +lcgM' = 1103515245.0 -- | A magic constant for the linear congruential generator lcgC :: Int -lcgC = fromNumber 12345 +lcgC = 12345 -- | A magic constant for the linear congruential generator lcgN :: Int -lcgN = one `shl` fromNumber 30 +lcgN = one `shl` 30 -- | Step the linear congruential generator lcgNext :: Int -> Int