From: simonmar Date: Fri, 29 Jun 2001 12:45:39 +0000 (+0000) Subject: [project @ 2001-06-29 12:45:39 by simonmar] X-Git-Tag: Approximately_9120_patches~1654 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=ed89811565f1966d9418902688461f469d985201;p=ghc-hetmet.git [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. --- diff --git a/ghc/lib/std/PrelHandle.hsc b/ghc/lib/std/PrelHandle.hsc index 9c72ab2..a7e51d2 100644 --- a/ghc/lib/std/PrelHandle.hsc +++ b/ghc/lib/std/PrelHandle.hsc @@ -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 -- ----------------------------------------------------------------------------- diff --git a/ghc/lib/std/PrelIO.hsc b/ghc/lib/std/PrelIO.hsc index a8573ba..637d64f 100644 --- a/ghc/lib/std/PrelIO.hsc +++ b/ghc/lib/std/PrelIO.hsc @@ -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]