dejafu-1.7.0.0: A library for unit-testing concurrent programs.

Copyright(c) 2017--2018 Michael Walker
LicenseMIT
MaintainerMichael Walker <mike@barrucadu.co.uk>
Stabilityexperimental
PortabilityDeriveAnyClass, DeriveGeneric, FlexibleContexts, GADTs
Safe HaskellNone
LanguageHaskell2010

Test.DejaFu.Internal

Contents

Description

Internal types and functions used throughout DejaFu. This module is NOT considered to form part of the public interface of this library.

Synopsis

SCT settings

data Settings n a Source #

SCT configuration record.

Since: 1.2.0.0

Constructors

Settings 

data Way where Source #

How to explore the possible executions of a concurrent program.

Since: 0.7.0.0

Constructors

Systematic :: Bounds -> Way 
Randomly :: RandomGen g => (g -> (Int, g)) -> g -> Int -> Way 

Instances

Show Way Source # 

Methods

showsPrec :: Int -> Way -> ShowS #

show :: Way -> String #

showList :: [Way] -> ShowS #

Identifiers

data IdSource Source #

The number of ID parameters was getting a bit unwieldy, so this hides them all away.

Constructors

IdSource 

Fields

nextCRId :: String -> IdSource -> (IdSource, CRefId) Source #

Get the next free CRefId.

nextMVId :: String -> IdSource -> (IdSource, MVarId) Source #

Get the next free MVarId.

nextTVId :: String -> IdSource -> (IdSource, TVarId) Source #

Get the next free TVarId.

nextTId :: String -> IdSource -> (IdSource, ThreadId) Source #

Get the next free ThreadId.

nextId :: String -> (Int, [String]) -> (Id, (Int, [String])) Source #

Helper for next*

initialIdSource :: IdSource Source #

The initial ID source.

Actions

isBlock :: ThreadAction -> Bool Source #

Check if a ThreadAction immediately blocks.

tvarsOf :: ThreadAction -> Set TVarId Source #

Get the TVars affected by a ThreadAction.

tvarsWritten :: ThreadAction -> Set TVarId Source #

Get the TVars a transaction wrote to (or would have, if it didn't retry).

tvarsRead :: ThreadAction -> Set TVarId Source #

Get the TVars a transaction read from.

rewind :: ThreadAction -> Lookahead Source #

Convert a ThreadAction into a Lookahead: "rewind" what has happened.

willRelease :: Lookahead -> Bool Source #

Check if an operation could enable another thread.

Simplified actions

data ActionType Source #

A simplified view of the possible actions a thread can perform.

Constructors

UnsynchronisedRead CRefId

A readCRef or a readForCAS.

UnsynchronisedWrite CRefId

A writeCRef.

UnsynchronisedOther

Some other action which doesn't require cross-thread communication.

PartiallySynchronisedCommit CRefId

A commit.

PartiallySynchronisedWrite CRefId

A casCRef

PartiallySynchronisedModify CRefId

A modifyCRefCAS

SynchronisedModify CRefId

An atomicModifyCRef.

SynchronisedRead MVarId

A readMVar or takeMVar (or try/blocked variants).

SynchronisedWrite MVarId

A putMVar (or try/blocked variant).

SynchronisedOther

Some other action which does require cross-thread communication.

Instances

Eq ActionType Source # 
Show ActionType Source # 
Generic ActionType Source # 

Associated Types

type Rep ActionType :: * -> * #

NFData ActionType Source # 

Methods

rnf :: ActionType -> () #

type Rep ActionType Source # 
type Rep ActionType = D1 * (MetaData "ActionType" "Test.DejaFu.Internal" "dejafu-1.7.0.0-Gr0d31u6DUKCv0VVTeekkE" False) ((:+:) * ((:+:) * ((:+:) * (C1 * (MetaCons "UnsynchronisedRead" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * CRefId))) (C1 * (MetaCons "UnsynchronisedWrite" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * CRefId)))) ((:+:) * (C1 * (MetaCons "UnsynchronisedOther" PrefixI False) (U1 *)) ((:+:) * (C1 * (MetaCons "PartiallySynchronisedCommit" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * CRefId))) (C1 * (MetaCons "PartiallySynchronisedWrite" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * CRefId)))))) ((:+:) * ((:+:) * (C1 * (MetaCons "PartiallySynchronisedModify" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * CRefId))) (C1 * (MetaCons "SynchronisedModify" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * CRefId)))) ((:+:) * (C1 * (MetaCons "SynchronisedRead" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * MVarId))) ((:+:) * (C1 * (MetaCons "SynchronisedWrite" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * MVarId))) (C1 * (MetaCons "SynchronisedOther" PrefixI False) (U1 *))))))

isBarrier :: ActionType -> Bool Source #

Check if an action imposes a write barrier.

isCommit :: ActionType -> CRefId -> Bool Source #

Check if an action commits a given CRef.

synchronises :: ActionType -> CRefId -> Bool Source #

Check if an action synchronises a given CRef.

crefOf :: ActionType -> Maybe CRefId Source #

Get the CRef affected.

mvarOf :: ActionType -> Maybe MVarId Source #

Get the MVar affected.

tidsOf :: ThreadAction -> Set ThreadId Source #

Get the ThreadIds involved in a ThreadAction.

simplifyAction :: ThreadAction -> ActionType Source #

Throw away information from a ThreadAction and give a simplified view of what is happening.

This is used in the SCT code to help determine interesting alternative scheduling decisions.

Error reporting

etail :: HasCallStack => [a] -> [a] Source #

tail but with a better error message if it fails. Use this only where it shouldn't fail!

eidx :: HasCallStack => [a] -> Int -> a Source #

'(!!)' but with a better error message if it fails. Use this only where it shouldn't fail!

efromJust :: HasCallStack => Maybe a -> a Source #

fromJust but with a better error message if it fails. Use this only where it shouldn't fail!

efromList :: HasCallStack => [a] -> NonEmpty a Source #

fromList but with a better error message if it fails. Use this only where it shouldn't fail!

eadjust :: (Ord k, Show k, HasCallStack) => (v -> v) -> k -> Map k v -> Map k v Source #

adjust but which errors if the key is not present. Use this only where it shouldn't fail!

einsert :: (Ord k, Show k, HasCallStack) => k -> v -> Map k v -> Map k v Source #

insert but which errors if the key is already present. Use this only where it shouldn't fail!

elookup :: (Ord k, Show k, HasCallStack) => k -> Map k v -> v Source #

lookup but which errors if the key is not present. Use this only where it shouldn't fail!

fatal :: HasCallStack => String -> a Source #

error but saying where it came from

Miscellaneous

runRefCont :: MonadConc n => (n () -> x) -> (a -> Maybe b) -> ((a -> x) -> x) -> n (x, CRef n (Maybe b)) Source #

Run with a continuation that writes its value into a reference, returning the computation and the reference. Using the reference is non-blocking, it is up to you to ensure you wait sufficiently.