mirror of
https://github.com/barrucadu/dejafu.git
synced 2024-12-18 19:11:37 +03:00
parent
91fa969fc2
commit
2d4e28e308
@ -7,6 +7,18 @@ This project is versioned according to the [Package Versioning Policy](https://p
|
|||||||
*de facto* standard Haskell versioning scheme.
|
*de facto* standard Haskell versioning scheme.
|
||||||
|
|
||||||
|
|
||||||
|
unreleased
|
||||||
|
----------
|
||||||
|
|
||||||
|
### Miscellaneous
|
||||||
|
|
||||||
|
- Errors thrown with `Control.Monad.fail` no longer terminate testing, and are now correctly treated
|
||||||
|
as asynchronous exceptions.
|
||||||
|
|
||||||
|
|
||||||
|
---------------------------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
|
||||||
0.7.1.1
|
0.7.1.1
|
||||||
-------
|
-------
|
||||||
|
|
||||||
|
@ -58,11 +58,12 @@ module Test.DejaFu.Common
|
|||||||
, MemType(..)
|
, MemType(..)
|
||||||
|
|
||||||
-- * Miscellaneous
|
-- * Miscellaneous
|
||||||
|
, MonadFailException(..)
|
||||||
, runRefCont
|
, runRefCont
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.DeepSeq (NFData(..))
|
import Control.DeepSeq (NFData(..))
|
||||||
import Control.Exception (MaskingState(..))
|
import Control.Exception (Exception(..), MaskingState(..))
|
||||||
import Control.Monad.Ref (MonadRef(..))
|
import Control.Monad.Ref (MonadRef(..))
|
||||||
import Data.List (intercalate, nub, sort)
|
import Data.List (intercalate, nub, sort)
|
||||||
import Data.List.NonEmpty (NonEmpty)
|
import Data.List.NonEmpty (NonEmpty)
|
||||||
@ -866,6 +867,12 @@ instance NFData MemType where
|
|||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- Miscellaneous
|
-- Miscellaneous
|
||||||
|
|
||||||
|
-- | An exception for errors in testing caused by use of 'fail'.
|
||||||
|
newtype MonadFailException = MonadFailException String
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
instance Exception MonadFailException
|
||||||
|
|
||||||
-- | Run with a continuation that writes its value into a reference,
|
-- | Run with a continuation that writes its value into a reference,
|
||||||
-- returning the computation and the reference. Using the reference
|
-- returning the computation and the reference. Using the reference
|
||||||
-- is non-blocking, it is up to you to ensure you wait sufficiently.
|
-- is non-blocking, it is up to you to ensure you wait sufficiently.
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE ExistentialQuantification #-}
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
|
|
||||||
@ -7,7 +8,7 @@
|
|||||||
-- License : MIT
|
-- License : MIT
|
||||||
-- Maintainer : Michael Walker <mike@barrucadu.co.uk>
|
-- Maintainer : Michael Walker <mike@barrucadu.co.uk>
|
||||||
-- Stability : experimental
|
-- Stability : experimental
|
||||||
-- Portability : ExistentialQuantification, RankNTypes
|
-- Portability : CPP, ExistentialQuantification, RankNTypes
|
||||||
--
|
--
|
||||||
-- Common types and utility functions for deterministic execution of
|
-- Common types and utility functions for deterministic execution of
|
||||||
-- 'MonadConc' implementations. This module is NOT considered to form
|
-- 'MonadConc' implementations. This module is NOT considered to form
|
||||||
@ -19,6 +20,10 @@ import Data.Map.Strict (Map)
|
|||||||
import Test.DejaFu.Common
|
import Test.DejaFu.Common
|
||||||
import Test.DejaFu.STM (STMLike)
|
import Test.DejaFu.STM (STMLike)
|
||||||
|
|
||||||
|
#if MIN_VERSION_base(4,9,0)
|
||||||
|
import qualified Control.Monad.Fail as Fail
|
||||||
|
#endif
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- * The @Conc@ Monad
|
-- * The @Conc@ Monad
|
||||||
|
|
||||||
@ -43,6 +48,14 @@ instance Monad (M n r) where
|
|||||||
return = pure
|
return = pure
|
||||||
m >>= k = M $ \c -> runM m (\x -> runM (k x) c)
|
m >>= k = M $ \c -> runM m (\x -> runM (k x) c)
|
||||||
|
|
||||||
|
#if MIN_VERSION_base(4,9,0)
|
||||||
|
fail = Fail.fail
|
||||||
|
|
||||||
|
-- | @since unreleased
|
||||||
|
instance Fail.MonadFail (M n r) where
|
||||||
|
#endif
|
||||||
|
fail e = cont (\_ -> AThrow (MonadFailException e))
|
||||||
|
|
||||||
-- | The concurrent variable type used with the 'Conc' monad. One
|
-- | The concurrent variable type used with the 'Conc' monad. One
|
||||||
-- notable difference between these and 'MVar's is that 'MVar's are
|
-- notable difference between these and 'MVar's is that 'MVar's are
|
||||||
-- single-wakeup, and wake up in a FIFO order. Writing to a @MVar@
|
-- single-wakeup, and wake up in a FIFO order. Writing to a @MVar@
|
||||||
|
@ -28,7 +28,6 @@ module Test.DejaFu.STM
|
|||||||
|
|
||||||
import Control.Monad (unless)
|
import Control.Monad (unless)
|
||||||
import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
|
import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
|
||||||
import Control.Monad.Cont (cont)
|
|
||||||
import Control.Monad.Ref (MonadRef)
|
import Control.Monad.Ref (MonadRef)
|
||||||
import Control.Monad.ST (ST)
|
import Control.Monad.ST (ST)
|
||||||
import Data.IORef (IORef)
|
import Data.IORef (IORef)
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE ExistentialQuantification #-}
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
@ -8,7 +9,7 @@
|
|||||||
-- License : MIT
|
-- License : MIT
|
||||||
-- Maintainer : Michael Walker <mike@barrucadu.co.uk>
|
-- Maintainer : Michael Walker <mike@barrucadu.co.uk>
|
||||||
-- Stability : experimental
|
-- Stability : experimental
|
||||||
-- Portability : ExistentialQuantification, RankNTypes
|
-- Portability : CPP, ExistentialQuantification, MultiParamTypeClasses, RankNTypes
|
||||||
--
|
--
|
||||||
-- 'MonadSTM' testing implementation, internal types and
|
-- 'MonadSTM' testing implementation, internal types and
|
||||||
-- definitions. This module is NOT considered to form part of the
|
-- definitions. This module is NOT considered to form part of the
|
||||||
@ -18,18 +19,51 @@ module Test.DejaFu.STM.Internal where
|
|||||||
import Control.DeepSeq (NFData(..))
|
import Control.DeepSeq (NFData(..))
|
||||||
import Control.Exception (Exception, SomeException, fromException,
|
import Control.Exception (Exception, SomeException, fromException,
|
||||||
toException)
|
toException)
|
||||||
import Control.Monad.Cont (Cont, runCont)
|
|
||||||
import Control.Monad.Ref (MonadRef, newRef, readRef, writeRef)
|
import Control.Monad.Ref (MonadRef, newRef, readRef, writeRef)
|
||||||
import Data.List (nub)
|
import Data.List (nub)
|
||||||
|
|
||||||
import Test.DejaFu.Common
|
import Test.DejaFu.Common
|
||||||
|
|
||||||
|
#if MIN_VERSION_base(4,9,0)
|
||||||
|
import qualified Control.Monad.Fail as Fail
|
||||||
|
#endif
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- The @STMLike@ monad
|
-- The @STMLike@ monad
|
||||||
|
|
||||||
-- | The underlying monad is based on continuations over primitive
|
-- | The underlying monad is based on continuations over primitive
|
||||||
-- actions.
|
-- actions.
|
||||||
type M n r a = Cont (STMAction n r) a
|
--
|
||||||
|
-- This is not @Cont@ because we want to give it a custom @MonadFail@
|
||||||
|
-- instance.
|
||||||
|
newtype M n r a = M { runM :: (a -> STMAction n r) -> STMAction n r }
|
||||||
|
|
||||||
|
instance Functor (M n r) where
|
||||||
|
fmap f m = M $ \ c -> runM m (c . f)
|
||||||
|
|
||||||
|
instance Applicative (M n r) where
|
||||||
|
pure x = M $ \c -> c x
|
||||||
|
f <*> v = M $ \c -> runM f (\g -> runM v (c . g))
|
||||||
|
|
||||||
|
instance Monad (M n r) where
|
||||||
|
return = pure
|
||||||
|
m >>= k = M $ \c -> runM m (\x -> runM (k x) c)
|
||||||
|
|
||||||
|
#if MIN_VERSION_base(4,9,0)
|
||||||
|
fail = Fail.fail
|
||||||
|
|
||||||
|
-- | @since unreleased
|
||||||
|
instance Fail.MonadFail (M n r) where
|
||||||
|
#endif
|
||||||
|
fail e = cont (\_ -> SThrow (MonadFailException e))
|
||||||
|
|
||||||
|
-- | Construct a continuation-passing operation from a function.
|
||||||
|
cont :: ((a -> STMAction n r) -> STMAction n r) -> M n r a
|
||||||
|
cont = M
|
||||||
|
|
||||||
|
-- | Run a CPS computation with the given final computation.
|
||||||
|
runCont :: M n r a -> (a -> STMAction n r) -> STMAction n r
|
||||||
|
runCont = runM
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- * Primitive actions
|
-- * Primitive actions
|
||||||
|
Loading…
Reference in New Issue
Block a user