From 581039a0ae82bb9f52b7422f2c23eef9611c9dd1 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Sat, 16 May 1998 20:03:02 +0000
Subject: [PATCH] [project @ 1998-05-16 20:03:02 by sof] Added comment on the
vagaries of combining runProcess and lazy file I/O
---
ghc/lib/posix/Posix.lhs | 44 ++++++++++++++++++++++++++++++-----------
1 file changed, 33 insertions(+), 11 deletions(-)
diff --git a/ghc/lib/posix/Posix.lhs b/ghc/lib/posix/Posix.lhs
index fa3c233592bd..8eeb0f7b4856 100644
--- a/ghc/lib/posix/Posix.lhs
+++ b/ghc/lib/posix/Posix.lhs
@@ -14,6 +14,7 @@ module Posix (
module PosixTTY,
runProcess,
+ exec,
ByteCount,
Fd, intToFd,
@@ -48,6 +49,26 @@ import PosixUtil
-- [OLD COMMENT:]
-- runProcess is our candidate for the high-level OS-independent primitive
-- If accepted, it will be moved out of Posix into LibSystem.
+--
+-- ***NOTE***: make sure you completely force the evaluation of the path
+-- and arguments to the child before calling runProcess. If you don't do
+-- this *and* the arguments from runProcess are read in from a file lazily,
+-- be prepared for some rather weird parent-child file I/O behaviour.
+--
+-- [If you don't force the args, consider the case where the
+-- arguments emanate from a file that is read lazily, using hGetContents
+-- or some such. Since a child of a fork() inherits the opened files of
+-- the parent, the child can force the evaluation of the arguments and
+-- read them off the file without any problems. The problem is that
+-- while the child share a file table with the parent, it has
+-- separate buffers, so a child may fill up its (copy of) the buffer, but
+-- only read it partially. When the *parent* tries to read from the shared file again,
+-- the (shared) file offset will have been stepped on by whatever number of chars
+-- that was copied into the file buffer of the child. i.e., the unused parts of the
+-- buffer will *not* be seen, resulting in random/unpredicatable results.
+--
+-- Based on a true (, debugged :-) story.
+-- ]
import Directory ( setCurrentDirectory )
@@ -60,19 +81,19 @@ runProcess :: FilePath -- Command
-> Maybe Handle -- stdout
-> Maybe Handle -- stderr
-> IO ()
-runProcess path args env dir stdin stdout stderr =
- forkProcess >>= \ pid ->
+runProcess path args env dir stdin stdout stderr = do
+ pid <- forkProcess
case pid of
Nothing -> doTheBusiness
Just x -> return ()
where
doTheBusiness :: IO ()
- doTheBusiness =
- maybeChangeWorkingDirectory >>
- maybeDup2 0 stdin >>
- maybeDup2 1 stdout >>
- maybeDup2 2 stderr >>
- executeFile path True args env >>
+ doTheBusiness = do
+ maybeChangeWorkingDirectory
+ maybeDup2 0 stdin
+ maybeDup2 1 stdout
+ maybeDup2 2 stderr
+ executeFile path True args env
syserr "runProcess"
maybeChangeWorkingDirectory :: IO ()
@@ -84,8 +105,9 @@ runProcess path args env dir stdin stdout stderr =
maybeDup2 :: Int -> Maybe Handle -> IO ()
maybeDup2 dest h =
case h of Nothing -> return ()
- Just x -> handleToFd x >>= \ src ->
- dupTo src (intToFd dest) >>
- return ()
+ Just x -> do
+ src <- handleToFd x
+ dupTo src (intToFd dest)
+ return ()
\end{code}
--
GitLab