Update Trac ticket URLs to point to GitLab
[ghc.git] / testsuite / tests / rts / T10590.hs
1 import Foreign.C
2 import Foreign.Marshal.Array
3 import Foreign.Storable
4 import Control.Concurrent
5
6 -- The test works only on UNIX like.
7 -- unportable bits:
8 import qualified System.Posix.Internals as SPI
9 import qualified System.Posix.Types as SPT
10
11 pipe :: IO (CInt, CInt)
12 pipe = allocaArray 2 $ \fds -> do
13 throwErrnoIfMinus1_ "pipe" $ SPI.c_pipe fds
14 rd <- peekElemOff fds 0
15 wr <- peekElemOff fds 1
16 return (rd, wr)
17
18 main :: IO ()
19 main = do
20 (r1, w1) <- pipe
21 (r2, _w2) <- pipe
22 _ <- forkIO $ do -- thread A
23 threadWaitRead (SPT.Fd r1)
24 _ <- forkIO $ do -- thread B
25 threadWaitRead (SPT.Fd r2)
26 yield -- switch to A, then B
27 -- now both are blocked
28 _ <- SPI.c_close w1 -- unblocking thread A fd
29 _ <- SPI.c_close r2 -- breaking thread B fd
30 yield -- kick RTS IO manager
31
32 {-
33 #10590 exposed a bug as:
34 T10590: internal error: removeThreadFromDeQueue: not found
35 (GHC version 7.11.20150702 for x86_64_unknown_linux)
36 Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug
37 -}