Ticket #4001: 0001-atomicReadMVar.3.patch

File 0001-atomicReadMVar.3.patch, 2.2 KB (added by ezyang, 2 years ago)

A set of tests (split me into three files)

  • tests/concurrent/should_run/all.T

    From f8dc6e1ced66e2b4b0078d8ea94a3901fd8b1225 Mon Sep 17 00:00:00 2001
    From: "Edward Z. Yang" <[email protected]>
    Date: Fri, 14 Jun 2013 14:21:02 -0700
    Subject: [PATCH] atomicReadMVar
    
    Signed-off-by: Edward Z. Yang <[email protected]>
    ---
     tests/concurrent/should_run/all.T             |    2 ++
     tests/concurrent/should_run/atomicreadmvar.hs |   44 +++++++++++++++++++++++++
     2 files changed, 46 insertions(+)
     create mode 100644 tests/concurrent/should_run/atomicreadmvar.hs
    
    diff --git a/tests/concurrent/should_run/all.T b/tests/concurrent/should_run/all.T
    index bb2bcd3..0c773d1 100644
    a b test('T5611', normal, compile_and_run, ['']) 
    7474test('T5238', normal, compile_and_run, [''])
    7575test('T5866', exit_code(1), compile_and_run, [''])
    7676
     77test('atomicreadmvar', normal, compile_and_run, [''])
     78
    7779# -----------------------------------------------------------------------------
    7880# These tests we only do for a full run
    7981
  • new file tests/concurrent/should_run/atomicreadmvar.hs

    diff --git a/tests/concurrent/should_run/atomicreadmvar.hs b/tests/concurrent/should_run/atomicreadmvar.hs
    new file mode 100644
    index 0000000..ed32056
    - +  
     1module Main where
     2
     3import GHC.MVar
     4import Control.Concurrent
     5
     6-- test race-freeness
     7test1 = do
     8    let i = 1000000
     9    m <- newMVar (0 :: Int)
     10    let readloop 0 = return ()
     11        readloop i = do
     12            atomicReadMVar m
     13            readloop (i-1)
     14        writeloop 0 = return ()
     15        writeloop i = do
     16            readMVar m
     17            writeloop (i-1)
     18    forkIO $ readloop i
     19    writeloop i
     20
     21-- test removal from queues on exception
     22test2 = do
     23    m <- newEmptyMVar
     24    sync <- newEmptyMVar
     25    let f = atomicReadMVar m
     26    t1 <- forkIO (f >> error "FAILURE")
     27    t2 <- forkIO (f >> putMVar sync ())
     28    killThread t1
     29    putMVar m (0 :: Int)
     30    atomicReadMVar sync
     31
     32-- example from
     33-- http://www.haskell.org/pipermail/glasgow-haskell-users/2008-November/015878.html
     34
     35test3 = do
     36    m <- newMVar (0 :: Int)
     37    forkIO $ putMVar m 1
     38    yield
     39    r1 <- atomicReadMVar m
     40    r2 <- takeMVar m
     41    r3 <- takeMVar m
     42    return ()
     43
     44main = test1 >> test2 >> test3