Commit ed898115 authored by simonmar's avatar simonmar
Browse files

[project @ 2001-06-29 12:45:39 by simonmar]

Fix a bug in hGetContents, namely that it wasn't closing the handle
when the end of file was reached.  Also tried to tidy the code up a
bit while I was here.
parent 3f95ab8a
......@@ -4,7 +4,7 @@
#undef DEBUG
-- -----------------------------------------------------------------------------
-- $Id: PrelHandle.hsc,v 1.10 2001/06/22 12:36:33 rrt Exp $
-- $Id: PrelHandle.hsc,v 1.11 2001/06/29 12:45:39 simonmar Exp $
--
-- (c) The University of Glasgow, 1994-2001
--
......@@ -22,9 +22,11 @@ module PrelHandle (
stdin, stdout, stderr,
IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
hClose, hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
hFlush,
hClose, hClose_help,
HandlePosn(..), hGetPosn, hSetPosn,
SeekMode(..), hSeek,
......@@ -127,9 +129,7 @@ but we might want to revisit this in the future --SDM ].
{-# INLINE withHandle #-}
withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
withHandle fun h@(FileHandle m) act = withHandle' fun h m act
withHandle fun h@(DuplexHandle r w) act = do
withHandle' fun h r act
withHandle' fun h w act
withHandle fun h@(DuplexHandle m _) act = withHandle' fun h m act
withHandle' fun h m act =
block $ do
......@@ -764,8 +764,9 @@ hClose h@(DuplexHandle r w) = do
haType = ClosedHandle
}
hClose' h m =
withHandle__' "hClose" h m $ \ handle_ -> do
hClose' h m = withHandle__' "hClose" h m $ hClose_help
hClose_help handle_ =
case haType handle_ of
ClosedHandle -> return handle_
_ -> do
......@@ -1164,18 +1165,20 @@ hIsTerminalDevice handle = do
#ifdef _WIN32
hSetBinaryMode handle bin =
withHandle "hSetBinaryMode" handle $ \ handle_ ->
withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
do let flg | bin = (#const O_BINARY)
| otherwise = (#const O_TEXT)
throwErrnoIfMinus1_ "hSetBinaryMode"
(setmode (fromIntegral (haFD handle_)) flg)
return (handle_{haIsBin=bin}, ())
return handle_{haIsBin=bin}
return ()
foreign import "setmode" setmode :: CInt -> CInt -> IO CInt
#else
hSetBinaryMode handle bin =
withHandle "hSetBinaryMode" handle $ \ handle_ ->
return (handle_{haIsBin=bin}, ())
hSetBinaryMode handle bin = do
withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
return handle_{haIsBin=bin}
return ()
#endif
-- -----------------------------------------------------------------------------
......
......@@ -3,7 +3,7 @@
#undef DEBUG_DUMP
-- -----------------------------------------------------------------------------
-- $Id: PrelIO.hsc,v 1.5 2001/06/22 12:36:33 rrt Exp $
-- $Id: PrelIO.hsc,v 1.6 2001/06/29 12:45:39 simonmar Exp $
--
-- (c) The University of Glasgow, 1992-2001
--
......@@ -251,6 +251,16 @@ hGetLineBufferedLoop handle_ ref
hGetLineBufferedLoop handle_ ref new_buf (xs:xss)
maybeFillReadBuffer fd is_line buf
= catch
(do buf <- fillReadBuffer fd is_line buf
return (Just buf)
)
(\e -> do if isEOFError e
then return Nothing
else throw e)
unpack :: RawBuffer -> Int -> Int -> IO [Char]
unpack buf r 0 = return ""
unpack buf (I## r) (I## len) = IO $ \s -> unpack [] (len -## 1##) s
......@@ -297,12 +307,8 @@ hGetLineUnBuffered h = do
-- carry on writing to it afterwards.
hGetContents :: Handle -> IO String
hGetContents handle@(DuplexHandle r w)
= withHandle' "hGetContents" handle r (hGetContents' handle)
hGetContents handle@(FileHandle m)
= withHandle' "hGetContents" handle m (hGetContents' handle)
hGetContents' handle handle_ =
hGetContents handle =
withHandle "hGetContents" handle $ \handle_ ->
case haType handle_ of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_closedHandle
......@@ -318,9 +324,9 @@ hGetContents' handle handle_ =
lazyRead :: Handle -> IO String
lazyRead handle =
unsafeInterleaveIO $
withHandle_ "lazyRead" handle $ \ handle_ -> do
withHandle "lazyRead" handle $ \ handle_ -> do
case haType handle_ of
ClosedHandle -> return ""
ClosedHandle -> return (handle_, "")
SemiClosedHandle -> lazyRead' handle handle_
_ -> ioException
(IOError (Just handle) IllegalOperation "lazyRead"
......@@ -334,7 +340,7 @@ lazyRead' h handle_ = do
-- (see hLookAhead)
buf <- readIORef ref
if not (bufferEmpty buf)
then lazyReadBuffered h fd ref buf
then lazyReadHaveBuffer h handle_ fd ref buf
else do
case haBufferMode handle_ of
......@@ -342,41 +348,36 @@ lazyRead' h handle_ = do
-- make use of the minimal buffer we already have
let raw = bufBuf buf
fd = haFD handle_
r <- throwErrnoIfMinus1RetryMayBlock "hGetChar"
r <- throwErrnoIfMinus1RetryMayBlock "lazyRead"
(read_off (fromIntegral fd) raw 0 1)
(threadWaitRead fd)
if r == 0
then return ""
then do handle_ <- hClose_help handle_
return (handle_, "")
else do (c,_) <- readCharFromBuffer raw 0
rest <- lazyRead h
return (c : rest)
return (handle_, c : rest)
LineBuffering -> lazyReadBuffered h fd ref buf
BlockBuffering _ -> lazyReadBuffered h fd ref buf
LineBuffering -> lazyReadBuffered h handle_ fd ref buf
BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf
-- we never want to block during the read, so we call fillReadBuffer with
-- is_line==True, which tells it to "just read what there is".
lazyReadBuffered h fd ref buf = do
maybe_new_buf <-
if bufferEmpty buf
then maybeFillReadBuffer fd True buf
else return (Just buf)
case maybe_new_buf of
Nothing -> return ""
Just buf -> do
more <- lazyRead h
writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
maybeFillReadBuffer fd is_line buf
= catch
(do buf <- fillReadBuffer fd is_line buf
return (Just buf)
)
(\e -> if isEOFError e
then return Nothing
else throw e)
lazyReadBuffered h handle_ fd ref buf = do
catch
(do buf <- fillReadBuffer fd True{-is_line-} buf
lazyReadHaveBuffer h handle_ fd ref buf
)
-- all I/O errors are discarded. Additionally, we close the handle.
(\e -> do handle_ <- hClose_help handle_
return (handle_, "")
)
lazyReadHaveBuffer h handle_ fd ref buf = do
more <- lazyRead h
writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
return (handle_, s)
unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment