Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Alex D
GHC
Commits
561d44cc
Commit
561d44cc
authored
Feb 26, 2008
by
Simon Marlow
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
add test for #2122
parent
03cb3d79
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
72 additions
and
0 deletions
+72
-0
testsuite/tests/ghc-regress/lib/IO/2122.hs
testsuite/tests/ghc-regress/lib/IO/2122.hs
+70
-0
testsuite/tests/ghc-regress/lib/IO/all.T
testsuite/tests/ghc-regress/lib/IO/all.T
+2
-0
No files found.
testsuite/tests/ghc-regress/lib/IO/2122.hs
0 → 100644
View file @
561d44cc
{-
Before running this, check that /tmp/test does not exist and
contain something important. Then do:
$ touch /tmp/test
If you do:
$ runhaskell Test.hs
it will work. If you do:
$ runhaskell Test.hs fail
it will fail every time with:
Test.hs: writeFile: /tmp/test: openFile: resource busy (file is locked)
-}
import
Control.Monad
import
System.Directory
import
System.IO
import
System.Environment
import
System.Posix.IO
fp
=
"2122-test"
main
::
IO
()
main
=
do
writeFile
fp
"test"
test
True
-- fails everytime when causeFailure is True in GHCi, with runhaskell,
-- or when compiled.
test
::
Bool
->
IO
()
test
causeFailure
=
do
h1
<-
openFile
fp
ReadMode
`
Prelude
.
catch
`
(
\
e
->
error
(
"openFile 1: "
++
show
e
))
when
causeFailure
$
do
h2
<-
openFile
fp
ReadMode
`
Prelude
.
catch
`
(
\
e
->
error
(
"openFile 2: "
++
show
e
))
hClose
h2
hClose
h1
removeFile
fp
writeFile
fp
(
show
[
1
..
100
])
`
Prelude
.
catch
`
(
\
e
->
error
(
"writeFile: "
++
show
e
))
-- this version never fails (except in GHCi, if test has previously failed).
-- probably because openFd does not try to lock the file
test2
::
Bool
->
IO
()
test2
causeFailure
=
do
fd1
<-
openFd
fp
ReadOnly
Nothing
defaultFileFlags
`
Prelude
.
catch
`
(
\
e
->
error
(
"openFile 1: "
++
show
e
))
when
causeFailure
$
do
fd2
<-
openFd
fp
ReadOnly
Nothing
defaultFileFlags
`
Prelude
.
catch
`
(
\
e
->
error
(
"openFile 2: "
++
show
e
))
closeFd
fd2
closeFd
fd1
removeFile
fp
writeFile
fp
(
show
[
1
..
100
])
`
Prelude
.
catch
`
(
\
e
->
error
(
"writeFile: "
++
show
e
))
-- fails sometimes when run repeated in GHCi, but seems fine with
-- runhaskell or compiled
test3
::
IO
()
test3
=
do
h1
<-
openFile
fp
ReadMode
`
Prelude
.
catch
`
(
\
e
->
error
(
"openFile 1: "
++
show
e
))
h2
<-
openFile
fp
ReadMode
`
Prelude
.
catch
`
(
\
e
->
error
(
"openFile 2: "
++
show
e
))
removeFile
fp
writeFile
fp
(
show
[
1
..
100
])
`
Prelude
.
catch
`
(
\
e
->
error
(
"writeFile: "
++
show
e
))
print
=<<
hGetContents
h1
print
=<<
hGetContents
h2
hClose
h2
hClose
h1
testsuite/tests/ghc-regress/lib/IO/all.T
View file @
561d44cc
...
...
@@ -102,3 +102,5 @@ test('concio001', skip, run_command, ['$MAKE -s --no-print-directory test.concio
test
('
concio001.thr
',
skip
,
run_command
,
['
$MAKE -s --no-print-directory test.concio001.thr
'])
test
('
concio002
',
reqlib
('
process
'),
compile_and_run
,
[''])
test
('
2122
',
extra_clean
(['
2122-test
']),
compile_and_run
,
[''])
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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