diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 8fc201a1..08ff08bb 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -32,9 +32,9 @@ jobs: - name: Install LLVM (macOS) if: runner.os == 'macOS' && matrix.ghc == '8.10' run: | - brew install llvm@13 - echo "LLVM_CONFIG=$(brew --prefix llvm@13)/bin/llvm-config" >> $GITHUB_ENV - echo "$(brew --prefix llvm@13)/bin" >> $GITHUB_PATH + brew install llvm@14 + echo "LLVM_CONFIG=$(brew --prefix llvm@14)/bin/llvm-config" >> $GITHUB_ENV + echo "$(brew --prefix llvm@14)/bin" >> $GITHUB_PATH - name: Verify LLVM installation if: runner.os == 'macOS' && matrix.ghc == '8.10' diff --git a/io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs b/io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs index e31dc928..d3cbe06b 100644 --- a/io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs +++ b/io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs @@ -54,9 +54,7 @@ instance ( MonadSTM m, MArray e a (STM m) ) => MArray e a (ContTSTM r m) where getNumElements = ContTSTM . getNumElements unsafeRead arr = ContTSTM . unsafeRead arr unsafeWrite arr i = ContTSTM . unsafeWrite arr i -#if __GLASGOW_HASKELL__ >= 910 newArray idxs = ContTSTM . newArray idxs -#endif -- note: this (and the following) instance requires 'UndecidableInstances' diff --git a/io-sim/CHANGELOG.md b/io-sim/CHANGELOG.md index 897deecc..36fe2775 100644 --- a/io-sim/CHANGELOG.md +++ b/io-sim/CHANGELOG.md @@ -22,6 +22,7 @@ - `selectTraceEventsSayWithTime'` is more general. These functions now accepts trace with any result, rather than one that finishes with `SimResult`. +- More polymorphic `ppTrace_` type signature. ## 1.6.0.0 diff --git a/io-sim/src/Control/Monad/IOSim/Types.hs b/io-sim/src/Control/Monad/IOSim/Types.hs index dcbe36e6..9b8530ad 100644 --- a/io-sim/src/Control/Monad/IOSim/Types.hs +++ b/io-sim/src/Control/Monad/IOSim/Types.hs @@ -938,7 +938,7 @@ ppTrace tr = Trace.ppTrace -- | Like 'ppTrace' but does not show the result value. -- -ppTrace_ :: SimTrace a -> String +ppTrace_ :: Trace.Trace a SimEvent -> String ppTrace_ tr = Trace.ppTrace (const "") (ppSimEvent timeWidth tidWidth labelWidth) diff --git a/io-sim/test/Test/Control/Monad/IOSimPOR.hs b/io-sim/test/Test/Control/Monad/IOSimPOR.hs index 74c44d0e..b4d85f01 100644 --- a/io-sim/test/Test/Control/Monad/IOSimPOR.hs +++ b/io-sim/test/Test/Control/Monad/IOSimPOR.hs @@ -434,15 +434,31 @@ doit n = do threadDelay 1 readTVarIO r - -traceNoDuplicates :: (Testable prop1, Show a1) => ((a1 -> a2 -> a2) -> prop1) -> Property -traceNoDuplicates k = r `pseq` (k addTrace .&&. maximum (traceCounts ()) == 1) +traceNoDuplicates :: forall a b. + (Show a) + => ((a -> b -> b) -> Property) + -> Property +-- this NOINLINE pragma is useful for debugging if `r` didn't flow outside of +-- `traceNoDuplicate`. +{-# NOINLINE traceNoDuplicates #-} +traceNoDuplicates k = unsafePerformIO $ do + r <- newIORef (Map.empty :: Map String Int) + return $ r `pseq` + (k (addTrace r) .&&. counterexample "trace counts" (maximum (Map.elems (traceCounts r)) === 1)) where - r = unsafePerformIO $ newIORef (Map.empty :: Map String Int) - addTrace t x = unsafePerformIO $ do - atomicModifyIORef r (\m->(Map.insertWith (+) (show t) 1 m,())) + addTrace :: IORef (Map String Int) -> a -> b -> b + addTrace r t x = unsafePerformIO $ do + let s = show t + atomicModifyIORef r + (\m-> + let m' = Map.insertWith (+) s 1 m + in (m', ()) + ) return x - traceCounts () = unsafePerformIO $ Map.elems <$> readIORef r + + traceCounts :: IORef (Map String Int) -> Map String Int + traceCounts r = unsafePerformIO $ readIORef r + -- | Checks that IOSimPOR is capable of analysing an infinite simulation -- lazily.