diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## Version 0.6 (2018-05-14) + +- Pass [Dieharder][Dieharder] statistical/randomness tests ([#185][185], [@moodmosaic][moodmosaic]) +- Catch `readFile` exceptions on the repl ([#184][184], [@thumphries][thumphries]) + ## Version 0.5.3 (2018-03-12) - Add `Semigroup` and `Monoid` instances for `GenT` that lift the inner `Monoid` ([#156][156], [@andrewthad][andrewthad]) @@ -32,7 +37,7 @@ ## Version 0.4 (2017-06-28) -- Abstract state machine testing, check out the Tim Humphries' great [blog post](http://teh.id.au/posts/2017/07/15/state-machine-testing) or the [process registry example](https://github.com/hedgehogqa/haskell-hedgehog/blob/master/hedgehog-example/test/Test/Example/Registry.hs) to see how it works ([#89][89], [@jystic][jystic]) +- Abstract state machine testing, check out Tim Humphries' great [blog post](http://teh.id.au/posts/2017/07/15/state-machine-testing) or the [process registry example](https://github.com/hedgehogqa/haskell-hedgehog/blob/master/hedgehog-example/test/Test/Example/Registry.hs) to see how it works ([#89][89], [@jystic][jystic]) - `liftCatch`, `liftCatchIO`, `withCatch` functions for isolating exceptions during tests ([#89][89], [@jystic][jystic]) ## Version 0.3 (2017-06-11) @@ -65,6 +70,9 @@ - `forAllWith` can be used to generate values without a `Show` instance ([@jystic][jystic]) - Removed uses of `Typeable` to allow for generating types which cannot implement it ([@jystic][jystic]) +[Dieharder]: + https://webhome.phy.duke.edu/~rgb/General/dieharder.php + [jystic]: https://github.com/jystic [chris-martin]: @@ -94,6 +102,10 @@ [fisx]: https://github.com/fisx +[185]: + https://github.com/hedgehogqa/haskell-hedgehog/pull/185 +[184]: + https://github.com/hedgehogqa/haskell-hedgehog/pull/184 [162]: https://github.com/hedgehogqa/haskell-hedgehog/pull/162 [157]: diff --git a/hedgehog.cabal b/hedgehog.cabal --- a/hedgehog.cabal +++ b/hedgehog.cabal @@ -1,4 +1,4 @@ -version: 0.5.3 +version: 0.6 name: hedgehog @@ -59,7 +59,7 @@ , mmorph >= 1.0 && < 1.2 , monad-control >= 1.0 && < 1.1 , mtl >= 2.1 && < 2.3 - , pretty-show >= 1.6 && < 1.7 + , pretty-show >= 1.6 && < 1.8 , primitive >= 0.6 && < 0.7 , random >= 1.1 && < 1.2 , resourcet >= 1.1 && < 1.3 @@ -130,7 +130,7 @@ hedgehog , base >= 3 && < 5 , containers >= 0.4 && < 0.6 - , pretty-show >= 1.6 && < 1.7 + , pretty-show >= 1.6 && < 1.8 , semigroups >= 0.16 && < 0.19 , text >= 1.1 && < 1.3 , transformers >= 0.3 && < 0.6 diff --git a/src/Hedgehog/Internal/Discovery.hs b/src/Hedgehog/Internal/Discovery.hs --- a/src/Hedgehog/Internal/Discovery.hs +++ b/src/Hedgehog/Internal/Discovery.hs @@ -1,6 +1,7 @@ {-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} module Hedgehog.Internal.Discovery ( PropertySource(..) , readProperties @@ -11,6 +12,7 @@ , Position(..) ) where +import Control.Exception (IOException, handle) import Control.Monad.IO.Class (MonadIO(..)) import qualified Data.Char as Char @@ -37,12 +39,18 @@ readDeclaration :: MonadIO m => FilePath -> LineNo -> m (Maybe (String, Pos String)) readDeclaration path line = do - decls <- findDeclarations path <$> liftIO (readFile path) - pure . + mfile <- liftIO $ readFileSafe path + pure $ do + file <- mfile takeHead . - List.sortBy (Ord.comparing $ Ord.Down . posLine . posPostion . snd) . - filter ((<= line) . posLine . posPostion . snd) $ - Map.toList decls + List.sortBy (Ord.comparing $ Ord.Down . posLine . posPostion . snd) . + filter ((<= line) . posLine . posPostion . snd) $ + Map.toList (findDeclarations path file) + +readFileSafe :: MonadIO m => FilePath -> m (Maybe String) +readFileSafe path = + liftIO $ + handle (\(_ :: IOException) -> pure Nothing) (Just <$> readFile path) takeHead :: [a] -> Maybe a takeHead = \case diff --git a/src/Hedgehog/Internal/Seed.hs b/src/Hedgehog/Internal/Seed.hs --- a/src/Hedgehog/Internal/Seed.hs +++ b/src/Hedgehog/Internal/Seed.hs @@ -16,8 +16,7 @@ -- overlay (kernel) v113.33.03, and Random.fs in FsCheck v3. -- -- Other than the choice of initial seed for 'from' this port should be --- faithful. Currently, we have not rerun the DieHarder, or BigCrush tests on --- this implementation. +-- faithful. -- -- 1. Guy L. Steele, Jr., Doug Lea, Christine H. Flood -- Fast splittable pseudorandom number generators @@ -37,8 +36,8 @@ -- * Internal -- $internal , goldenGamma - , nextInt64 - , nextInt32 + , nextWord64 + , nextWord32 , mix64 , mix64variant13 , mix32 @@ -53,6 +52,7 @@ import Data.Time.Clock.POSIX (getPOSIXTime) import Data.IORef (IORef) import qualified Data.IORef as IORef +import Data.Word (Word32, Word64) import System.IO.Unsafe (unsafePerformIO) import System.Random (RandomGen) @@ -62,8 +62,8 @@ -- data Seed = Seed { - seedValue :: !Int64 - , seedGamma :: !Int64 -- ^ must be an odd number + seedValue :: !Word64 + , seedGamma :: !Word64 -- ^ must be an odd number } deriving (Eq, Ord) instance Show Seed where @@ -96,9 +96,9 @@ random = liftIO $ IORef.atomicModifyIORef' global split --- | Create a 'Seed' using an 'Int64'. +-- | Create a 'Seed' using a 'Word64'. -- -from :: Int64 -> Seed +from :: Word64 -> Seed from x = Seed x goldenGamma @@ -109,13 +109,13 @@ -- We choose: the odd integer closest to @2^64/φ@, where @φ = (1 + √5)/2@ is -- the golden ratio. -- -goldenGamma :: Int64 +goldenGamma :: Word64 goldenGamma = - -7046029254386353131 + 0x9e3779b97f4a7c15 -- | Get the next value in the SplitMix sequence. -- -next :: Seed -> (Int64, Seed) +next :: Seed -> (Word64, Seed) next (Seed v0 g) = let v = v0 + g @@ -132,19 +132,19 @@ in (s2, Seed (mix64 v0) (mixGamma g0)) --- | Generate a random 'Int64'. +-- | Generate a random 'Word64'. -- -nextInt64 :: Seed -> (Int64, Seed) -nextInt64 s0 = +nextWord64 :: Seed -> (Word64, Seed) +nextWord64 s0 = let (v0, s1) = next s0 in (mix64 v0, s1) --- | Generate a random 'Int32'. +-- | Generate a random 'Word32'. -- -nextInt32 :: Seed -> (Int32, Seed) -nextInt32 s0 = +nextWord32 :: Seed -> (Word32, Seed) +nextWord32 s0 = let (v0, s1) = next s0 in @@ -162,38 +162,38 @@ nextDouble lo hi = Random.randomR (lo, hi) -mix64 :: Int64 -> Int64 +mix64 :: Word64 -> Word64 mix64 x = let - y = (x `xor` (x `shiftR` 33)) * (-49064778989728563) - z = (y `xor` (y `shiftR` 33)) * (-4265267296055464877) + y = (x `xor` (x `shiftR` 33)) * 0xff51afd7ed558ccd + z = (y `xor` (y `shiftR` 33)) * 0xc4ceb9fe1a85ec53 in z `xor` (z `shiftR` 33) -mix32 :: Int64 -> Int32 +mix32 :: Word64 -> Word32 mix32 x = let - y = (x `xor` (x `shiftR` 33)) * (-49064778989728563) - z = (y `xor` (y `shiftR` 33)) * (-4265267296055464877) + y = (x `xor` (x `shiftR` 33)) * 0xff51afd7ed558ccd + z = (y `xor` (y `shiftR` 33)) * 0xc4ceb9fe1a85ec53 in fromIntegral (z `shiftR` 32) -mix64variant13 :: Int64 -> Int64 +mix64variant13 :: Word64 -> Word64 mix64variant13 x = let - y = (x `xor` (x `shiftR` 30)) * (-4658895280553007687) - z = (y `xor` (y `shiftR` 27)) * (-7723592293110705685) + y = (x `xor` (x `shiftR` 30)) * 0xbf58476d1ce4e5b9 + z = (y `xor` (y `shiftR` 27)) * 0x94d049bb133111eb in z `xor` (z `shiftR` 31) -mixGamma :: Int64 -> Int64 +mixGamma :: Word64 -> Word64 mixGamma x = let y = mix64variant13 x .|. 1 n = popCount $ y `xor` (y `shiftR` 1) in if n >= 24 then - y `xor` (-6148914691236517206) + y `xor` 0xaaaaaaaaaaaaaaaa else y @@ -205,7 +205,7 @@ #if (SIZEOF_HSINT == 8) instance RandomGen Seed where next = - first fromIntegral . nextInt64 + first fromIntegral . nextWord64 genRange _ = (fromIntegral (minBound :: Int64), fromIntegral (maxBound :: Int64)) split = @@ -213,7 +213,7 @@ #else instance RandomGen Seed where next = - first fromIntegral . nextInt32 + first fromIntegral . nextWord32 genRange _ = (fromIntegral (minBound :: Int32), fromIntegral (maxBound :: Int32)) split = diff --git a/test/Test/Hedgehog/Text.hs b/test/Test/Hedgehog/Text.hs --- a/test/Test/Hedgehog/Text.hs +++ b/test/Test/Hedgehog/Text.hs @@ -29,7 +29,7 @@ genSeed :: Gen Seed genSeed = - Seed <$> Gen.enumBounded <*> genOdd + Seed <$> Gen.word64 Range.constantBounded <*> fmap fromIntegral genOdd genPrecedence :: Gen Int genPrecedence =