deepseq 1.3.0.2 → 1.4.0.0
raw patch · 5 files changed
+616/−85 lines, 5 filesdep +HUnitdep +ghc-primdep +test-frameworkdep ~arraydep ~basePVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit, ghc-prim, test-framework, test-framework-hunit
Dependency ranges changed: array, base
API changes (from Hackage documentation)
+ Control.DeepSeq: instance [safe] (GNFData a, GNFData b) => GNFData (a :*: b)
+ Control.DeepSeq: instance [safe] (GNFData a, GNFData b) => GNFData (a :+: b)
+ Control.DeepSeq: instance [safe] GNFData U1
+ Control.DeepSeq: instance [safe] GNFData V1
+ Control.DeepSeq: instance [safe] GNFData a => GNFData (M1 i c a)
+ Control.DeepSeq: instance [safe] NFData (Proxy a)
+ Control.DeepSeq: instance [safe] NFData (StableName a)
+ Control.DeepSeq: instance [safe] NFData All
+ Control.DeepSeq: instance [safe] NFData Any
+ Control.DeepSeq: instance [safe] NFData CChar
+ Control.DeepSeq: instance [safe] NFData CClock
+ Control.DeepSeq: instance [safe] NFData CDouble
+ Control.DeepSeq: instance [safe] NFData CFile
+ Control.DeepSeq: instance [safe] NFData CFloat
+ Control.DeepSeq: instance [safe] NFData CFpos
+ Control.DeepSeq: instance [safe] NFData CInt
+ Control.DeepSeq: instance [safe] NFData CIntMax
+ Control.DeepSeq: instance [safe] NFData CIntPtr
+ Control.DeepSeq: instance [safe] NFData CJmpBuf
+ Control.DeepSeq: instance [safe] NFData CLLong
+ Control.DeepSeq: instance [safe] NFData CLong
+ Control.DeepSeq: instance [safe] NFData CPtrdiff
+ Control.DeepSeq: instance [safe] NFData CSChar
+ Control.DeepSeq: instance [safe] NFData CSUSeconds
+ Control.DeepSeq: instance [safe] NFData CShort
+ Control.DeepSeq: instance [safe] NFData CSigAtomic
+ Control.DeepSeq: instance [safe] NFData CSize
+ Control.DeepSeq: instance [safe] NFData CTime
+ Control.DeepSeq: instance [safe] NFData CUChar
+ Control.DeepSeq: instance [safe] NFData CUInt
+ Control.DeepSeq: instance [safe] NFData CUIntMax
+ Control.DeepSeq: instance [safe] NFData CUIntPtr
+ Control.DeepSeq: instance [safe] NFData CULLong
+ Control.DeepSeq: instance [safe] NFData CULong
+ Control.DeepSeq: instance [safe] NFData CUSeconds
+ Control.DeepSeq: instance [safe] NFData CUShort
+ Control.DeepSeq: instance [safe] NFData CWchar
+ Control.DeepSeq: instance [safe] NFData Fingerprint
+ Control.DeepSeq: instance [safe] NFData ThreadId
+ Control.DeepSeq: instance [safe] NFData Unique
+ Control.DeepSeq: instance [safe] NFData a => GNFData (K1 i a)
+ Control.DeepSeq: instance [safe] NFData a => NFData (Const a b)
+ Control.DeepSeq: instance [safe] NFData a => NFData (Down a)
+ Control.DeepSeq: instance [safe] NFData a => NFData (Dual a)
+ Control.DeepSeq: instance [safe] NFData a => NFData (First a)
+ Control.DeepSeq: instance [safe] NFData a => NFData (Last a)
+ Control.DeepSeq: instance [safe] NFData a => NFData (Product a)
+ Control.DeepSeq: instance [safe] NFData a => NFData (Sum a)
+ Control.DeepSeq: instance [safe] NFData a => NFData (ZipList a)
- Control.DeepSeq: class NFData a where rnf a = a `seq` ()
+ Control.DeepSeq: class NFData a where rnf = grnf . from
Files
- Control/DeepSeq.hs +329/−25
- changelog +0/−35
- changelog.md +78/−0
- deepseq.cabal +57/−25
- tests/Main.hs +152/−0
Control/DeepSeq.hs view
@@ -1,6 +1,12 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 702 && MIN_VERSION_array(0,4,0)+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+# if MIN_VERSION_array(0,4,0) {-# LANGUAGE Safe #-}+# endif #endif ----------------------------------------------------------------------------- -- |@@ -51,6 +57,8 @@ NFData(..), ) where +import Control.Applicative+import Control.Concurrent ( ThreadId ) import Data.Int import Data.Word import Data.Ratio@@ -58,7 +66,59 @@ import Data.Array import Data.Fixed import Data.Version+import Data.Monoid+import Data.Unique ( Unique )+import Foreign.C.Types+import System.Mem.StableName ( StableName ) +#if MIN_VERSION_base(4,6,0)+import Data.Ord ( Down(Down) )+#endif++#if MIN_VERSION_base(4,7,0)+import Data.Proxy ( Proxy(Proxy) )+#endif++#if MIN_VERSION_base(4,8,0)+import Data.Functor.Identity ( Identity(..) )+-- NB: Data.Typeable.Internal is "Trustworthy" only starting w/ base-4.8+import Data.Typeable.Internal ( TypeRep(..), TyCon(..) )+import Data.Void ( Void, absurd )+import Numeric.Natural ( Natural )+#endif++#if __GLASGOW_HASKELL__ >= 702+import GHC.Fingerprint.Type ( Fingerprint(..) )+import GHC.Generics++-- | Hidden internal type-class+class GNFData f where+ grnf :: f a -> ()++instance GNFData V1 where+ grnf = error "Control.DeepSeq.rnf: uninhabited type"++instance GNFData U1 where+ grnf U1 = ()++instance NFData a => GNFData (K1 i a) where+ grnf = rnf . unK1+ {-# INLINEABLE grnf #-}++instance GNFData a => GNFData (M1 i c a) where+ grnf = grnf . unM1+ {-# INLINEABLE grnf #-}++instance (GNFData a, GNFData b) => GNFData (a :*: b) where+ grnf (x :*: y) = grnf x `seq` grnf y+ {-# INLINEABLE grnf #-}++instance (GNFData a, GNFData b) => GNFData (a :+: b) where+ grnf (L1 x) = grnf x+ grnf (R1 x) = grnf x+ {-# INLINEABLE grnf #-}+#endif+ infixr 0 $!! -- | 'deepseq': fully evaluates the first argument, before returning the@@ -108,46 +168,119 @@ -- -- /Since: 1.1.0.0/ class NFData a where- -- | rnf should reduce its argument to normal form (that is, fully+ -- | 'rnf' should reduce its argument to normal form (that is, fully -- evaluate all sub-components), and then return '()'. --- -- The default implementation of 'rnf' is+ -- === 'Generic' 'NFData' deriving --- -- > rnf a = a `seq` ()+ -- Starting with GHC 7.2, you can automatically derive instances+ -- for types possessing a 'Generic' instance. --- -- which may be convenient when defining instances for data types with- -- no unevaluated fields (e.g. enumerations).+ -- > {-# LANGUAGE DeriveGeneric #-}+ -- >+ -- > import GHC.Generics (Generic)+ -- > import Control.DeepSeq+ -- >+ -- > data Foo a = Foo a String+ -- > deriving (Eq, Generic)+ -- >+ -- > instance NFData a => NFData (Foo a)+ -- >+ -- > data Colour = Red | Green | Blue+ -- > deriving Generic+ -- >+ -- > instance NFData Colour+ --+ -- Starting with GHC 7.10, the example above can be written more+ -- concisely by enabling the new @DeriveAnyClass@ extension:+ --+ -- > {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}+ -- >+ -- > import GHC.Generics (Generic)+ -- > import Control.DeepSeq+ -- >+ -- > data Foo a = Foo a String+ -- > deriving (Eq, Generic, NFData)+ -- >+ -- > data Colour = Red | Green | Blue+ -- > deriving (Generic, NFData)+ -- >+ --+ -- === Compatibility with previous @deepseq@ versions+ --+ -- Prior to version 1.4.0.0, the default implementation of the 'rnf'+ -- method was defined as+ --+ -- @'rnf' a = 'seq' a ()@+ --+ -- However, starting with @deepseq-1.4.0.0@, the default+ -- implementation is based on @DefaultSignatures@ allowing for+ -- more accurate auto-derived 'NFData' instances. If you need the+ -- previously used exact default 'rnf' method implementation+ -- semantics, use+ --+ -- > instance NFData Colour where rnf x = seq x ()+ --+ -- or alternatively+ --+ -- > {-# LANGUAGE BangPatterns #-}+ -- > instance NFData Colour where rnf !_ = ()+ -- rnf :: a -> ()- rnf a = a `seq` () -instance NFData Int-instance NFData Word-instance NFData Integer-instance NFData Float-instance NFData Double+#if __GLASGOW_HASKELL__ >= 702+ default rnf :: (Generic a, GNFData (Rep a)) => a -> ()+ rnf = grnf . from+#endif -instance NFData Char-instance NFData Bool-instance NFData ()+instance NFData Int where rnf !_ = ()+instance NFData Word where rnf !_ = ()+instance NFData Integer where rnf !_ = ()+instance NFData Float where rnf !_ = ()+instance NFData Double where rnf !_ = () -instance NFData Int8-instance NFData Int16-instance NFData Int32-instance NFData Int64+instance NFData Char where rnf !_ = ()+instance NFData Bool where rnf !_ = ()+instance NFData () where rnf !_ = () -instance NFData Word8-instance NFData Word16-instance NFData Word32-instance NFData Word64+instance NFData Int8 where rnf !_ = ()+instance NFData Int16 where rnf !_ = ()+instance NFData Int32 where rnf !_ = ()+instance NFData Int64 where rnf !_ = () +instance NFData Word8 where rnf !_ = ()+instance NFData Word16 where rnf !_ = ()+instance NFData Word32 where rnf !_ = ()+instance NFData Word64 where rnf !_ = ()++#if MIN_VERSION_base(4,7,0)+-- |/Since: 1.4.0.0/+instance NFData (Proxy a) where rnf Proxy = ()+#endif++#if MIN_VERSION_base(4,8,0)+-- |/Since: 1.4.0.0/+instance NFData a => NFData (Identity a) where+ rnf = rnf . runIdentity++-- | Defined as @'rnf' = 'absurd'@.+--+-- /Since: 1.4.0.0/+instance NFData Void where+ rnf = absurd++-- |/Since: 1.4.0.0/+instance NFData Natural where rnf !_ = ()+#endif+ -- |/Since: 1.3.0.0/-instance NFData (Fixed a)+instance NFData (Fixed a) where rnf !_ = () -- |This instance is for convenience and consistency with 'seq'. -- This assumes that WHNF is equivalent to NF for functions. -- -- /Since: 1.3.0.0/-instance NFData (a -> b)+instance NFData (a -> b) where rnf !_ = () --Rational and complex numbers. @@ -175,8 +308,179 @@ rnf [] = () rnf (x:xs) = rnf x `seq` rnf xs +-- |/Since: 1.4.0.0/+instance NFData a => NFData (ZipList a) where+ rnf = rnf . getZipList++-- |/Since: 1.4.0.0/+instance NFData a => NFData (Const a b) where+ rnf = rnf . getConst+ instance (Ix a, NFData a, NFData b) => NFData (Array a b) where rnf x = rnf (bounds x, Data.Array.elems x)++#if MIN_VERSION_base(4,6,0)+-- |/Since: 1.4.0.0/+instance NFData a => NFData (Down a) where+ rnf (Down x) = rnf x+#endif++-- |/Since: 1.4.0.0/+instance NFData a => NFData (Dual a) where+ rnf = rnf . getDual++-- |/Since: 1.4.0.0/+instance NFData a => NFData (First a) where+ rnf = rnf . getFirst++-- |/Since: 1.4.0.0/+instance NFData a => NFData (Last a) where+ rnf = rnf . getLast++-- |/Since: 1.4.0.0/+instance NFData Any where rnf = rnf . getAny++-- |/Since: 1.4.0.0/+instance NFData All where rnf = rnf . getAll++-- |/Since: 1.4.0.0/+instance NFData a => NFData (Sum a) where+ rnf = rnf . getSum++-- |/Since: 1.4.0.0/+instance NFData a => NFData (Product a) where+ rnf = rnf . getProduct++-- |/Since: 1.4.0.0/+instance NFData (StableName a) where+ rnf !_ = () -- assumes `data StableName a = StableName (StableName# a)`++-- |/Since: 1.4.0.0/+instance NFData ThreadId where+ rnf !_ = () -- assumes `data ThreadId = ThreadId ThreadId#`++-- |/Since: 1.4.0.0/+instance NFData Unique where+ rnf !_ = () -- assumes `newtype Unique = Unique Integer`++#if MIN_VERSION_base(4,8,0)+-- | __NOTE__: Only defined for @base-4.8.0.0@ and later+--+-- /Since: 1.4.0.0/+instance NFData TypeRep where+ rnf (TypeRep _ tycon tyrep) = rnf tycon `seq` rnf tyrep++-- | __NOTE__: Only defined for @base-4.8.0.0@ and later+--+-- /Since: 1.4.0.0/+instance NFData TyCon where+ rnf (TyCon _ tcp tcm tcn) = rnf tcp `seq` rnf tcm `seq` rnf tcn+#endif++----------------------------------------------------------------------------+-- GHC Specifics++#if __GLASGOW_HASKELL__ >= 702+-- |/Since: 1.4.0.0/+instance NFData Fingerprint where+ rnf (Fingerprint _ _) = ()+#endif++----------------------------------------------------------------------------+-- Foreign.C.Types++-- |/Since: 1.4.0.0/+instance NFData CChar where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CSChar where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CUChar where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CShort where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CUShort where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CInt where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CUInt where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CLong where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CULong where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CPtrdiff where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CSize where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CWchar where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CSigAtomic where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CLLong where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CULLong where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CIntPtr where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CUIntPtr where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CIntMax where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CUIntMax where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CClock where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CTime where rnf !_ = ()++#if MIN_VERSION_base(4,4,0)+-- |/Since: 1.4.0.0/+instance NFData CUSeconds where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CSUSeconds where rnf !_ = ()+#endif++-- |/Since: 1.4.0.0/+instance NFData CFloat where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CDouble where rnf !_ = ()++-- NOTE: The types `CFile`, `CFPos`, and `CJmpBuf` below are not+-- newtype wrappers rather defined as field-less single-constructor+-- types.++-- |/Since: 1.4.0.0/+instance NFData CFile where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CFpos where rnf !_ = ()++-- |/Since: 1.4.0.0/+instance NFData CJmpBuf where rnf !_ = ()++----------------------------------------------------------------------------+-- Tuples instance (NFData a, NFData b) => NFData (a,b) where rnf (x,y) = rnf x `seq` rnf y
− changelog
@@ -1,35 +0,0 @@--*-change-log-*---1.3.0.2 Nov 2013- * Update package description to Cabal 1.10 format- * Add support for GHC 7.8- * Drop support for GHCs older than GHC 7.0.1- * Add `/since: .../` annotations to Haddock comments- * Add changelog--1.3.0.1 Sep 2012- * No changes--1.3.0.0 Feb 2012- * Add instances for `Fixed`, `a->b` and `Version`--1.3.0.1 Sep 2011- * Disable SafeHaskell for GHC 7.2--1.2.0.0 Sep 2011- * New function `force`- * New operator `$!!`- * Add SafeHaskell support- * Dropped dependency on containers--1.1.0.2 Nov 2010- * Improve Haddock documentation--1.1.0.1 Oct 2010- * Enable support for containers-0.4.x--1.1.0.0 Nov 2009- * Major rewrite--1.0.0.0 Nov 2009- * Initial release
+ changelog.md view
@@ -0,0 +1,78 @@+# Changelog for [`deepseq` package](http://hackage.haskell.org/package/deepseq)++## 1.4.0.0 *Dec 2014*++ * Bundled with GHC 7.10.1+ * Switch to Generics based `DefaultSignature` `rnf` method+ implementation (based on code from `deepseq-generics`)++ **Compatibility Note**: if you need the exact default-method+ semantics of `deepseq` prior to 1.4, replace occurences of++ instance NFData XYZ++ by++ instance NFData XYZ where rnf x = seq x ()++ * New `NFData` instances for `base` types:++ - `Control.Applicative.Const`+ - `Control.Applicative.ZipList`+ - `Control.Concurrent.ThreadId`+ - `Data.Functor.Identity.Identity`+ - `Data.Monoid.{Dual,First,Last,Any,All,Sum,Product}`+ - `Data.Ord.Down`+ - `Data.Proxy.Proxy`+ - `Data.Typeable.Internal.TyCon`+ - `Data.Typeable.Internal.TypeRep`+ - `Data.Unique.Unique`+ - `Data.Void.Void`+ - `GHC.Fingerprint.Type.Fingerprint`+ - `Numeric.Natural.Natural`+ - `System.Mem.StableName.StableName`+ - `Foreign.C.Types.C*`++## 1.3.0.2 *Nov 2013*++ * Bundled with GHC 7.8.1+ * Update package description to Cabal 1.10 format+ * Add support for GHC 7.8+ * Drop support for GHCs older than GHC 7.0.1+ * Add `/since: .../` annotations to Haddock comments+ * Add changelog++## 1.3.0.1 *Sep 2012*++ * No changes++## 1.3.0.0 *Feb 2012*++ * Add instances for `Fixed`, `a->b` and `Version`++## 1.2.0.1 *Sep 2011*++ * Disable SafeHaskell for GHC 7.2++## 1.2.0.0 *Sep 2011*++ * New function `force`+ * New operator `$!!`+ * Add SafeHaskell support+ * Dropped dependency on containers++## 1.1.0.2 *Nov 2010*++ * Improve Haddock documentation++## 1.1.0.1 *Oct 2010*++ * Enable support for containers-0.4.x++## 1.1.0.0 *Nov 2009*++ * Major rewrite++## 1.0.0.0 *Nov 2009*++ * Initial release
deepseq.cabal view
@@ -1,10 +1,11 @@-name: deepseq-version: 1.3.0.2--- GHC 7.6.1 released with 1.3.0.1-license: BSD3-license-file: LICENSE-maintainer: libraries@haskell.org-synopsis: Deep evaluation of data structures+name: deepseq+version: 1.4.0.0+-- NOTE: Don't forget to update ./changelog.md+license: BSD3+license-file: LICENSE+maintainer: libraries@haskell.org+bug-reports: https://github.com/haskell/deepseq/issues+synopsis: Deep evaluation of data structures category: Control description: This package provides methods for fully evaluating data structures@@ -19,32 +20,63 @@ typeclass (\"Normal Form Data\", data structures with no unevaluated components) which defines strategies for fully evaluating different data types.- .- If you want to automatically derive 'NFData' instances via the- "GHC.Generics" facility, there is a companion package- <http://hackage.haskell.org/package/deepseq-generics deepseq-generics>- which builds on top of this package. build-type: Simple cabal-version: >=1.10-tested-with: GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1, GHC==7.2.2, GHC==7.2.1, GHC==7.0.4, GHC==7.0.3, GHC==7.0.2, GHC==7.0.1+tested-with: GHC==7.8.3, GHC==7.8.2, GHC==7.8.1, GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1, GHC==7.2.2, GHC==7.2.1, GHC==7.0.4, GHC==7.0.3, GHC==7.0.2, GHC==7.0.1 -extra-source-files: changelog+extra-source-files: changelog.md source-repository head type: git- location: http://git.haskell.org/packages/deepseq.git--source-repository this- type: git- location: http://git.haskell.org/packages/deepseq.git- tag: deepseq-1.3.0.2-release+ location: https://github.com/haskell/deepseq.git library default-language: Haskell2010- other-extensions: CPP- if impl(ghc >= 7.2)- other-extensions: Safe- exposed-modules: Control.DeepSeq- build-depends: base >= 4.3 && < 4.8,+ other-extensions:+ BangPatterns+ CPP++ if impl(ghc>=7.2)+ -- Enable Generics-backed DefaultSignatures for `rnf`+ other-extensions:+ DefaultSignatures+ FlexibleContexts+ Safe+ TypeOperators++ build-depends: ghc-prim >= 0.2 && < 0.4++ build-depends: base >= 4.3 && < 4.9, array >= 0.3 && < 0.6 ghc-options: -Wall++ exposed-modules: Control.DeepSeq+++test-suite deepseq-generics-tests+ default-language: Haskell2010+ if !impl(ghc>=7.2)+ buildable: False+ type: exitcode-stdio-1.0+ hs-source-dirs: . tests+ main-is: Main.hs+ other-extensions:+ CPP+ BangPatterns+ DefaultSignatures+ DeriveDataTypeable+ DeriveGeneric+ FlexibleContexts+ Safe+ TupleSections+ TypeOperators++ ghc-options: -Wall++ build-depends:+ array,+ base,+ -- end of packages with inherited version constraints+ test-framework == 0.8.*,+ test-framework-hunit == 0.3.*,+ HUnit == 1.2.*
+ tests/Main.hs view
@@ -0,0 +1,152 @@+-- Code reused from http://hackage.haskell.org/package/deepseq-generics++{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TupleSections #-}++module Main (main) where++import Control.Concurrent.MVar+import Control.Exception+import Control.Monad+import Data.Bits+import Data.IORef+import Data.Typeable+import Data.Word+import GHC.Generics+import System.IO.Unsafe (unsafePerformIO)++-- import Test.Framework (defaultMain, testGroup, testCase)+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit++-- IUT+import Control.DeepSeq++-- needed for GHC-7.4 compatibility+#if !MIN_VERSION_base(4,6,0)+atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b+atomicModifyIORef' ref f = do+ b <- atomicModifyIORef ref+ (\x -> let (a, b) = f x+ in (a, a `seq` b))+ b `seq` return b+#endif++----------------------------------------------------------------------------+-- simple hacky abstraction for testing forced evaluation via `rnf`-like functions++seqStateLock :: MVar ()+seqStateLock = unsafePerformIO $ newMVar ()+{-# NOINLINE seqStateLock #-}++withSeqState :: Word64 -> IO () -> IO ()+withSeqState expectedState act = withMVar seqStateLock $ \() -> do+ 0 <- resetSeqState+ () <- act+ st <- resetSeqState+ unless (st == expectedState) $+ assertFailure ("withSeqState: actual seq-state ("++show st++") doesn't match expected value ("+++ show expectedState++")")++seqState :: IORef Word64+seqState = unsafePerformIO $ newIORef 0+{-# NOINLINE seqState #-}++resetSeqState :: IO Word64+resetSeqState = atomicModifyIORef' seqState (0,)++-- |Set flag and raise exception is flag already set+setSeqState :: Int -> IO ()+setSeqState i | 0 <= i && i < 64 = atomicModifyIORef' seqState go+ | otherwise = error "seqSeqState: flag index must be in [0..63]"+ where+ go x | testBit x i = error ("setSeqState: flag #"++show i++" already set")+ | otherwise = (setBit x i, ())++-- weird type whose NFData instacne calls 'setSeqState' when rnf-ed+data SeqSet = SeqSet !Int | SeqIgnore+ deriving Show++instance NFData SeqSet where+ rnf (SeqSet i) = unsafePerformIO $ setSeqState i+ rnf (SeqIgnore) = ()+ {-# NOINLINE rnf #-}++-- |Exception to be thrown for testing 'seq'/'rnf'+data RnfEx = RnfEx deriving (Eq, Show, Typeable)++instance Exception RnfEx++instance NFData RnfEx where rnf e = throw e++assertRnfEx :: () -> IO ()+assertRnfEx v = handleJust isWanted (const $ return ()) $ do+ () <- evaluate v+ assertFailure "failed to trigger expected RnfEx exception"+ where isWanted = guard . (== RnfEx)++----------------------------------------------------------------------------++case_1, case_2, case_3, case_4_1, case_4_2, case_4_3, case_4_4 :: Test.Framework.Test++newtype Case1 = Case1 Int+ deriving (Generic)++instance NFData Case1++case_1 = testCase "Case1" $ do+ assertRnfEx $ rnf $ (Case1 (throw RnfEx))++----++data Case2 = Case2 Int+ deriving (Generic)++instance NFData Case2++case_2 = testCase "Case2" $ do+ assertRnfEx $ rnf $ (Case2 (throw RnfEx))++----++data Case3 = Case3 RnfEx+ deriving (Generic)++instance NFData Case3++case_3 = testCase "Case3" $ do+ assertRnfEx $ rnf $ Case3 RnfEx++----++data Case4 a = Case4a+ | Case4b a a+ | Case4c a (Case4 a)+ deriving (Generic)++instance NFData a => NFData (Case4 a)++case_4_1 = testCase "Case4.1" $ withSeqState 0x0 $ do+ evaluate $ rnf $ (Case4a :: Case4 SeqSet)++case_4_2 = testCase "Case4.2" $ withSeqState 0x3 $ do+ evaluate $ rnf $ (Case4b (SeqSet 0) (SeqSet 1) :: Case4 SeqSet)++case_4_3 = testCase "Case4.3" $ withSeqState (bit 55) $ do+ evaluate $ rnf $ (Case4b SeqIgnore (SeqSet 55) :: Case4 SeqSet)++case_4_4 = testCase "Case4.4" $ withSeqState 0xffffffffffffffff $ do+ evaluate $ rnf $ (genCase 63)+ where+ genCase n | n > 1 = Case4c (SeqSet n) (genCase (n-1))+ | otherwise = Case4b (SeqSet 0) (SeqSet 1)++----------------------------------------------------------------------------++main :: IO ()+main = defaultMain [tests]+ where+ tests = testGroup "" [case_1, case_2, case_3, case_4_1, case_4_2, case_4_3, case_4_4]