Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
af45af60
Commit
af45af60
authored
Jul 09, 2008
by
Simon Marlow
Browse files
add tests for #1048
parent
4c96813e
Changes
4
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/concurrent/should_run/all.T
View file @
af45af60
...
...
@@ -10,6 +10,7 @@ test('conc003', normal, compile_and_run, [''])
test
('
conc006
',
normal
,
compile_and_run
,
[''])
test
('
conc027
',
normal
,
compile_and_run
,
[''])
test
('
conc051
',
normal
,
compile_and_run
,
[''])
test
('
conc069
',
only_ways
(['
ghci
','
threaded1
','
threaded2
']),
compile_and_run
,
[''])
# -----------------------------------------------------------------------------
# These tests we only do for a full run
...
...
testsuite/tests/ghc-regress/concurrent/should_run/conc015.hs
View file @
af45af60
...
...
@@ -12,6 +12,7 @@ import Control.Exception
main
=
do
main_thread
<-
myThreadId
print
=<<
blocked
m
<-
newEmptyMVar
m2
<-
newEmptyMVar
forkIO
(
do
takeMVar
m
...
...
@@ -22,14 +23,15 @@ main = do
(
do
block
(
do
putMVar
m
()
print
=<<
blocked
sum
[
1
..
10000
]
`
seq
`
-- give 'foo' a chance to be raised
(
unblock
(
myDelay
500000
))
(
unblock
(
do
print
=<<
blocked
;
myDelay
500000
))
`
Control
.
Exception
.
catch
`
(
\
e
->
putStrLn
(
"caught1: "
++
show
e
))
)
takeMVar
m2
)
`
Control
.
Exception
.
catch
`
(
\
e
->
putStrLn
(
"caught2: "
++
show
e
))
(
\
e
->
do
print
=<<
blocked
;
putStrLn
(
"caught2: "
++
show
e
))
-- compensate for the fact that threadDelay is non-interruptible
-- on Windows with the threaded RTS in 6.6.
...
...
testsuite/tests/ghc-regress/concurrent/should_run/conc069.hs
0 → 100644
View file @
af45af60
import
Control.Concurrent
import
Control.Exception
main
=
do
stat
m
<-
newEmptyMVar
forkIO
(
do
stat
;
putMVar
m
()
)
takeMVar
m
block
$
forkIO
(
do
stat
;
putMVar
m
()
)
takeMVar
m
forkOS
(
do
stat
;
putMVar
m
()
)
takeMVar
m
block
$
forkOS
(
do
stat
;
putMVar
m
()
)
takeMVar
m
stat
=
do
x
<-
isCurrentThreadBound
y
<-
blocked
print
(
x
,
y
)
testsuite/tests/ghc-regress/concurrent/should_run/conc069.stdout
0 → 100644
View file @
af45af60
(True,False)
(False,False)
(False,True)
(True,False)
(True,True)
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment