packages feed

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 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]