Skip to content

Commit 1bdcfd0

Browse files
authored
Merge branch 'main' into wenkokke/export-time
2 parents caf2936 + 978dddb commit 1bdcfd0

File tree

12 files changed

+78
-29
lines changed

12 files changed

+78
-29
lines changed

.github/workflows/haskell.yml

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ jobs:
1111
strategy:
1212
fail-fast: false
1313
matrix:
14-
ghc: ["8.10", "9.2", "9.4", "9.6", "9.8", "9.10"]
14+
ghc: ["8.10", "9.2", "9.4", "9.6", "9.8", "9.10", "9.12"]
1515
os: [ubuntu-latest, macos-latest, windows-latest]
1616

1717
defaults:
@@ -32,9 +32,9 @@ jobs:
3232
- name: Install LLVM (macOS)
3333
if: runner.os == 'macOS' && matrix.ghc == '8.10'
3434
run: |
35-
brew install llvm@13
36-
echo "LLVM_CONFIG=$(brew --prefix llvm@13)/bin/llvm-config" >> $GITHUB_ENV
37-
echo "$(brew --prefix llvm@13)/bin" >> $GITHUB_PATH
35+
brew install llvm@14
36+
echo "LLVM_CONFIG=$(brew --prefix llvm@14)/bin/llvm-config" >> $GITHUB_ENV
37+
echo "$(brew --prefix llvm@14)/bin" >> $GITHUB_PATH
3838
3939
- name: Verify LLVM installation
4040
if: runner.os == 'macOS' && matrix.ghc == '8.10'

cabal.project

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
index-state: hackage.haskell.org 2024-05-17T03:42:00Z
1+
index-state: hackage.haskell.org 2025-01-14T02:09:49Z
22

33
packages: ./io-sim
44
./io-classes
@@ -11,3 +11,14 @@ package io-classes
1111

1212
package strict-stm
1313
flags: +asserts
14+
15+
if impl (ghc >= 9.12)
16+
allow-newer:
17+
-- Stuck on `cabal-3.14` issues and recalcitrant maintainers
18+
-- https://github.com/haskell/aeson/issues/1124
19+
, aeson:ghc-prim
20+
, aeson:template-haskell
21+
22+
-- Fix blocked by aeson
23+
-- https://github.com/haskellari/microstache/issues/43
24+
, microstache:base

io-classes/CHANGELOG.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,8 @@
22

33
### next version
44

5+
* Support ghc-9.12
6+
57
### Breaking changes
68

79
* Added `threadLabel` to `MonadThread`

io-classes/io-classes.cabal

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -31,8 +31,8 @@ description:
3131

3232
license: Apache-2.0
3333
license-files: LICENSE NOTICE
34-
copyright: 2019-2024 Input Output Global Inc (IOG)
35-
author: Alexander Vieth, Duncan Coutts, Marcin Szamotulski, Thomas Winant
34+
copyright: 2019-2025 Input Output Global Inc (IOG)
35+
author: Alexander Vieth, Duncan Coutts, Marcin Szamotulski, Neil Davies, Thomas Winant
3636
maintainer: Duncan Coutts [email protected], Marcin Szamotulski [email protected]
3737
category: Control
3838
build-type: Simple
@@ -112,7 +112,7 @@ library
112112
TypeFamilyDependencies
113113
TypeOperators
114114
UndecidableInstances
115-
build-depends: base >=4.9 && <4.21,
115+
build-depends: base >=4.9 && <4.22,
116116
array,
117117
async >=2.1,
118118
bytestring,
@@ -140,7 +140,7 @@ library strict-stm
140140
reexported-modules: Control.Concurrent.Class.MonadSTM.TSem as Control.Concurrent.Class.MonadSTM.Strict.TSem
141141
default-language: Haskell2010
142142
default-extensions: ImportQualifiedPost
143-
build-depends: base >= 4.9 && <4.21,
143+
build-depends: base >= 4.9 && <4.22,
144144
array,
145145
stm >= 2.5 && <2.6,
146146

@@ -163,7 +163,7 @@ library strict-mvar
163163
exposed-modules: Control.Concurrent.Class.MonadMVar.Strict
164164
default-language: Haskell2010
165165
default-extensions: ImportQualifiedPost
166-
build-depends: base >= 4.9 && <4.21,
166+
build-depends: base >= 4.9 && <4.22,
167167
io-classes:io-classes,
168168
ghc-options: -Wall
169169
-Wno-unticked-promoted-constructors
@@ -190,7 +190,7 @@ library si-timers
190190
NumericUnderscores,
191191
ScopedTypeVariables,
192192
TypeFamilies
193-
build-depends: base >=4.9 && <4.21,
193+
build-depends: base >=4.9 && <4.22,
194194
deepseq,
195195
mtl,
196196
nothunks,
@@ -214,7 +214,7 @@ library mtl
214214
, Control.Monad.Class.MonadTime.SI.Trans
215215
, Control.Monad.Class.MonadTimer.Trans
216216
, Control.Monad.Class.MonadTimer.SI.Trans
217-
build-depends: base >=4.9 && <4.21,
217+
build-depends: base >=4.9 && <4.22,
218218
array,
219219
mtl,
220220

@@ -231,7 +231,7 @@ library testlib
231231
exposed-modules: Test.Control.Concurrent.Class.MonadMVar.Strict.WHNF
232232
default-language: Haskell2010
233233
default-extensions: ImportQualifiedPost
234-
build-depends: base >=4.9 && <4.21,
234+
build-depends: base >=4.9 && <4.22,
235235
nothunks,
236236
QuickCheck,
237237
io-classes:strict-mvar

io-classes/mtl/Control/Monad/Class/MonadSTM/Trans.hs

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -54,9 +54,7 @@ instance ( MonadSTM m, MArray e a (STM m) ) => MArray e a (ContTSTM r m) where
5454
getNumElements = ContTSTM . getNumElements
5555
unsafeRead arr = ContTSTM . unsafeRead arr
5656
unsafeWrite arr i = ContTSTM . unsafeWrite arr i
57-
#if __GLASGOW_HASKELL__ >= 910
5857
newArray idxs = ContTSTM . newArray idxs
59-
#endif
6058

6159

6260
-- note: this (and the following) instance requires 'UndecidableInstances'

io-classes/src/Control/Monad/Class/MonadSTM/Internal.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1030,7 +1030,6 @@ unGetTBQueueDefault (TBQueue rsize read wsize _write _size) a = do
10301030
-- | Default implementation of 'TArray'.
10311031
--
10321032
data TArrayDefault m i e = TArray (Array i (TVar m e))
1033-
deriving Typeable
10341033

10351034
deriving instance (Eq (TVar m e), Ix i) => Eq (TArrayDefault m i e)
10361035

io-sim/CHANGELOG.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,9 @@
2222
- `selectTraceEventsSayWithTime'`
2323
is more general. These functions now accepts trace with any result, rather
2424
than one that finishes with `SimResult`.
25+
- More polymorphic `ppTrace_` type signature.
26+
- Fixed `tryReadTBQueue` when returning `Nothing`.
27+
- Support ghc 9.12
2528
- Export `Time` from `Control.Monad.IOSim`.
2629

2730
## 1.6.0.0

io-sim/io-sim.cabal

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ description:
1212
[here](https://input-output-hk.github.io/io-sim/io-sim).
1313
license: Apache-2.0
1414
license-files: LICENSE NOTICE
15-
copyright: 2022-2024 Input Output Global Inc (IOG)
15+
copyright: 2022-2025 Input Output Global Inc (IOG)
1616
author: Alexander Vieth, Duncan Coutts, John Hughes, Marcin Szamotulski
1717
maintainer: Duncan Coutts [email protected], Marcin Szamotulski [email protected]
1818
category: Testing
@@ -79,7 +79,7 @@ library
7979
RankNTypes,
8080
ScopedTypeVariables,
8181
TypeFamilies
82-
build-depends: base >=4.9 && <4.21,
82+
build-depends: base >=4.9 && <4.22,
8383
io-classes:{io-classes,strict-stm,si-timers}
8484
^>=1.6 || ^>= 1.7,
8585
exceptions >=0.10,

io-sim/src/Control/Monad/IOSim/STM.hs

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -149,9 +149,7 @@ tryReadTBQueueDefault (TBQueue queue _size) = do
149149
return (Just x)
150150
[] ->
151151
case reverse ys of
152-
[] -> do
153-
writeTVar queue $! (xs, r', ys, w)
154-
return Nothing
152+
[] -> return Nothing
155153

156154
-- NB. lazy: we want the transaction to be
157155
-- short, otherwise it will conflict

io-sim/src/Control/Monad/IOSim/Types.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -938,7 +938,7 @@ ppTrace tr = Trace.ppTrace
938938

939939
-- | Like 'ppTrace' but does not show the result value.
940940
--
941-
ppTrace_ :: SimTrace a -> String
941+
ppTrace_ :: Trace.Trace a SimEvent -> String
942942
ppTrace_ tr = Trace.ppTrace
943943
(const "")
944944
(ppSimEvent timeWidth tidWidth labelWidth)

io-sim/test/Test/Control/Monad/IOSim.hs

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -192,6 +192,10 @@ tests =
192192
, testProperty "maintains FIFO order IO" prop_flushTBQueueOrder_IO
193193
, testProperty "maintains FIFO order IOSim" prop_flushTBQueueOrder_IOSim
194194
]
195+
, testGroup "tryReadTBQueue"
196+
[ testProperty "works correctly when the queue is empty IO" prop_tryReadEmptyTBQueue_IO
197+
, testProperty "works correctly when the queue is empty IOSim" prop_tryReadEmptyTBQueue_IOSim
198+
]
195199
]
196200
]
197201

@@ -1464,6 +1468,24 @@ writeAndFlushTBQueue entries =
14641468
forM_ entries $ writeTBQueue q
14651469
flushTBQueue q
14661470

1471+
prop_tryReadEmptyTBQueue_IO :: Bool -> Property
1472+
prop_tryReadEmptyTBQueue_IO sndRead =
1473+
ioProperty $ tryReadEmptyTBQueue sndRead
1474+
1475+
prop_tryReadEmptyTBQueue_IOSim :: Bool -> Property
1476+
prop_tryReadEmptyTBQueue_IOSim sndRead =
1477+
runSimOrThrow $ tryReadEmptyTBQueue sndRead
1478+
1479+
tryReadEmptyTBQueue :: MonadSTM m => Bool -> m Property
1480+
tryReadEmptyTBQueue sndRead = atomically $ do
1481+
q <- newTBQueue 10
1482+
_ <- tryReadTBQueue q
1483+
writeTBQueue q ()
1484+
when sndRead $ void $ tryReadTBQueue q
1485+
l <- lengthTBQueue q
1486+
1487+
pure $ l === if sndRead then 0 else 1
1488+
14671489
--
14681490
-- Utils
14691491
--

io-sim/test/Test/Control/Monad/IOSimPOR.hs

Lines changed: 23 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -434,15 +434,31 @@ doit n = do
434434
threadDelay 1
435435
readTVarIO r
436436

437-
438-
traceNoDuplicates :: (Testable prop1, Show a1) => ((a1 -> a2 -> a2) -> prop1) -> Property
439-
traceNoDuplicates k = r `pseq` (k addTrace .&&. maximum (traceCounts ()) == 1)
437+
traceNoDuplicates :: forall a b.
438+
(Show a)
439+
=> ((a -> b -> b) -> Property)
440+
-> Property
441+
-- this NOINLINE pragma is useful for debugging if `r` didn't flow outside of
442+
-- `traceNoDuplicate`.
443+
{-# NOINLINE traceNoDuplicates #-}
444+
traceNoDuplicates k = unsafePerformIO $ do
445+
r <- newIORef (Map.empty :: Map String Int)
446+
return $ r `pseq`
447+
(k (addTrace r) .&&. counterexample "trace counts" (maximum (Map.elems (traceCounts r)) === 1))
440448
where
441-
r = unsafePerformIO $ newIORef (Map.empty :: Map String Int)
442-
addTrace t x = unsafePerformIO $ do
443-
atomicModifyIORef r (\m->(Map.insertWith (+) (show t) 1 m,()))
449+
addTrace :: IORef (Map String Int) -> a -> b -> b
450+
addTrace r t x = unsafePerformIO $ do
451+
let s = show t
452+
atomicModifyIORef r
453+
(\m->
454+
let m' = Map.insertWith (+) s 1 m
455+
in (m', ())
456+
)
444457
return x
445-
traceCounts () = unsafePerformIO $ Map.elems <$> readIORef r
458+
459+
traceCounts :: IORef (Map String Int) -> Map String Int
460+
traceCounts r = unsafePerformIO $ readIORef r
461+
446462

447463
-- | Checks that IOSimPOR is capable of analysing an infinite simulation
448464
-- lazily.

0 commit comments

Comments
 (0)