Refactor TestSuite

input-output-hk · Jan 11, 2023 · 2d4f389 · 2d4f389
1 parent 93858df
commit 2d4f389
Show file tree

Hide file tree

Showing 12 changed files with 1,509 additions and 589 deletions.
diff --git a/io-sim/bench/Main.hs b/io-sim/bench/Main.hs
@@ -4,7 +4,7 @@
 module Main (main) where
 
 import           Control.Concurrent.Class.MonadSTM
-import           Control.Monad (replicateM, forever)
+import           Control.Monad (forever, replicateM)
 import           Control.Monad.Class.MonadAsync
 import           Control.Monad.Class.MonadFork
 import           Control.Monad.Class.MonadSay

diff --git a/io-sim/io-sim.cabal b/io-sim/io-sim.cabal
@@ -78,9 +78,11 @@ test-suite test
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
   main-is:             Main.hs
-  other-modules:       Test.IOSim
-                       Test.STM
+  other-modules:       Test.Control.Monad.STM
+                       Test.Control.Monad.Utils
+                       Test.Control.Monad.IOSim
                        Test.Control.Monad.IOSimPOR
+                       Test.Control.Monad.IOSimPOR.Test
                        Test.Control.Monad.Class.MonadMVar
   default-language:    Haskell2010
   build-depends:       base,

diff --git a/io-sim/src/Control/Monad/IOSim/Internal.hs b/io-sim/src/Control/Monad/IOSim/Internal.hs
@@ -1,14 +1,14 @@
-{-# LANGUAGE BangPatterns               #-}
-{-# LANGUAGE CPP                        #-}
-{-# LANGUAGE DerivingVia                #-}
-{-# LANGUAGE ExistentialQuantification  #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GADTSyntax                 #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE NamedFieldPuns             #-}
-{-# LANGUAGE RankNTypes                 #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
-{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE BangPatterns              #-}
+{-# LANGUAGE CPP                       #-}
+{-# LANGUAGE DerivingVia               #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances         #-}
+{-# LANGUAGE GADTSyntax                #-}
+{-# LANGUAGE MultiParamTypeClasses     #-}
+{-# LANGUAGE NamedFieldPuns            #-}
+{-# LANGUAGE RankNTypes                #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+{-# LANGUAGE TypeFamilies              #-}
 
 {-# OPTIONS_GHC -Wno-orphans            #-}
 -- incomplete uni patterns in 'schedule' (when interpreting 'StmTxCommitted')
@@ -49,9 +49,7 @@ module Control.Monad.IOSim.Internal
 import           Prelude hiding (read)
 
 import           Data.Dynamic
-import           Data.Foldable (toList, traverse_, foldlM)
-import           Deque.Strict (Deque)
-import qualified Deque.Strict as Deque
+import           Data.Foldable (foldlM, toList, traverse_)
 import qualified Data.List as List
 import qualified Data.List.Trace as Trace
 import           Data.Map.Strict (Map)
@@ -62,12 +60,14 @@ import qualified Data.OrdPSQ as PSQ
 import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.Time (UTCTime (..), fromGregorian)
+import           Deque.Strict (Deque)
+import qualified Deque.Strict as Deque
 
 import           GHC.Exts (fromList)
 import           GHC.Conc (ThreadStatus(..), BlockReason(..))
 
-import           Control.Exception
-                   (NonTermination (..), assert, throw, AsyncException (..))
+import           Control.Exception (AsyncException (..), NonTermination (..),
+                     assert, throw)
 import           Control.Monad (join, when)
 import           Control.Monad.ST.Lazy
 import           Control.Monad.ST.Lazy.Unsafe (unsafeIOToST, unsafeInterleaveST)

diff --git a/io-sim/src/Control/Monad/IOSim/InternalTypes.hs b/io-sim/src/Control/Monad/IOSim/InternalTypes.hs
@@ -10,9 +10,9 @@ module Control.Monad.IOSim.InternalTypes
   , IsLocked (..)
   ) where
 
-import           Data.STRef.Lazy (STRef)
 import           Control.Exception (Exception)
 import           Control.Monad.Class.MonadThrow (MaskingState (..))
+import           Data.STRef.Lazy (STRef)
 
 import           Control.Monad.IOSim.Types (SimA, ThreadId, TimeoutId)
 

diff --git a/io-sim/src/Control/Monad/IOSim/Types.hs b/io-sim/src/Control/Monad/IOSim/Types.hs
@@ -1,15 +1,15 @@
-{-# LANGUAGE CPP                        #-}
-{-# LANGUAGE DeriveFunctor              #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE DerivingVia                #-}
-{-# LANGUAGE ExistentialQuantification  #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GADTSyntax                 #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE NamedFieldPuns             #-}
-{-# LANGUAGE PatternSynonyms            #-}
-{-# LANGUAGE RankNTypes                 #-}
-{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE CPP                       #-}
+{-# LANGUAGE DeriveFunctor             #-}
+{-# LANGUAGE DeriveGeneric             #-}
+{-# LANGUAGE DerivingVia               #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances         #-}
+{-# LANGUAGE GADTSyntax                #-}
+{-# LANGUAGE MultiParamTypeClasses     #-}
+{-# LANGUAGE NamedFieldPuns            #-}
+{-# LANGUAGE PatternSynonyms           #-}
+{-# LANGUAGE RankNTypes                #-}
+{-# LANGUAGE TypeFamilies              #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 {-# OPTIONS_GHC -Wno-partial-fields          #-}

diff --git a/io-sim/src/Control/Monad/IOSimPOR/Internal.hs b/io-sim/src/Control/Monad/IOSimPOR/Internal.hs
@@ -1,15 +1,15 @@
-{-# LANGUAGE BangPatterns               #-}
-{-# LANGUAGE CPP                        #-}
-{-# LANGUAGE DerivingVia                #-}
-{-# LANGUAGE ExistentialQuantification  #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GADTSyntax                 #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE NamedFieldPuns             #-}
-{-# LANGUAGE RankNTypes                 #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
-{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE BangPatterns              #-}
+{-# LANGUAGE CPP                       #-}
+{-# LANGUAGE DerivingVia               #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts          #-}
+{-# LANGUAGE FlexibleInstances         #-}
+{-# LANGUAGE GADTSyntax                #-}
+{-# LANGUAGE MultiParamTypeClasses     #-}
+{-# LANGUAGE NamedFieldPuns            #-}
+{-# LANGUAGE RankNTypes                #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+{-# LANGUAGE TypeFamilies              #-}
 
 {-# OPTIONS_GHC -Wno-orphans            #-}
 -- incomplete uni patterns in 'schedule' (when interpreting 'StmTxCommitted')
@@ -50,7 +50,7 @@ module Control.Monad.IOSimPOR.Internal
 import           Prelude hiding (read)
 
 import           Data.Dynamic
-import           Data.Foldable (traverse_, foldlM)
+import           Data.Foldable (foldlM, traverse_)
 import qualified Data.List as List
 import qualified Data.List.Trace as Trace
 import           Data.Map.Strict (Map)
@@ -63,9 +63,9 @@ import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.Time (UTCTime (..), fromGregorian)
 
-import           Control.Exception
-                   (NonTermination (..), assert, throw, AsyncException (..))
-import           Control.Monad ( join, when )
+import           Control.Exception (AsyncException (..), NonTermination (..),
+                     assert, throw)
+import           Control.Monad (join, when)
 import           Control.Monad.ST.Lazy
 import           Control.Monad.ST.Lazy.Unsafe (unsafeIOToST, unsafeInterleaveST)
 import           Data.STRef.Lazy

diff --git a/io-sim/test/Main.hs b/io-sim/test/Main.hs
@@ -3,14 +3,16 @@ module Main (main) where
 import           Test.Tasty
 
 import qualified Test.Control.Monad.Class.MonadMVar (tests)
-import qualified Test.IOSim (tests)
+import qualified Test.Control.Monad.IOSim (tests)
+import qualified Test.Control.Monad.IOSimPOR (tests)
 
 main :: IO ()
 main = defaultMain tests
 
 tests :: TestTree
 tests =
   testGroup "IO Sim"
-  [ Test.IOSim.tests
-  , Test.Control.Monad.Class.MonadMVar.tests
+  [ Test.Control.Monad.Class.MonadMVar.tests
+  , Test.Control.Monad.IOSim.tests
+  , Test.Control.Monad.IOSimPOR.tests
   ]