X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FHandle.hs;h=ddf17e7540782bc91f93b4377b90b32af87e12c2;hb=b99920eab7fba4e027fd39985840d4e854b8f923;hp=5becae8cdb0f424763d7a9d91c1b0134f5cb61fe;hpb=0e5774aefc953d9e9f7cd270177512a819a80e4c;p=ghc-base.git diff --git a/GHC/IO/Handle.hs b/GHC/IO/Handle.hs index 5becae8..ddf17e7 100644 --- a/GHC/IO/Handle.hs +++ b/GHC/IO/Handle.hs @@ -1,6 +1,6 @@ -{-# OPTIONS_GHC -fno-implicit-prelude #-} -{-# OPTIONS_GHC -XRecordWildCards #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-} +{-# LANGUAGE NoImplicitPrelude, RecordWildCards #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.IO.Handle @@ -22,7 +22,7 @@ module GHC.IO.Handle ( mkFileHandle, mkDuplexHandle, hFileSize, hSetFileSize, hIsEOF, hLookAhead, - hSetBuffering, hSetBinaryMode, hSetEncoding, + hSetBuffering, hSetBinaryMode, hSetEncoding, hGetEncoding, hFlush, hFlushAll, hDuplicate, hDuplicateTo, hClose, hClose_help, @@ -52,7 +52,7 @@ import GHC.IO.Device as IODevice import GHC.IO.Handle.Types import GHC.IO.Handle.Internals import GHC.IO.Handle.Text -import System.IO.Error +import qualified GHC.IO.BufferedIO as Buffered import GHC.Base import GHC.Exception @@ -141,14 +141,24 @@ hSetFileSize handle size = -- physical file, if the current I\/O position is equal to the length of -- the file. Otherwise, it returns 'False'. -- --- NOTE: 'hIsEOF' may block, because it is the same as calling --- 'hLookAhead' and checking for an EOF exception. +-- NOTE: 'hIsEOF' may block, because it has to attempt to read from +-- the stream to determine whether there is any more data to be read. hIsEOF :: Handle -> IO Bool -hIsEOF handle = - catch - (do hLookAhead handle; return False) - (\e -> if isEOFError e then return True else ioError e) +hIsEOF handle = wantReadableHandle_ "hIsEOF" handle $ \Handle__{..} -> do + + cbuf <- readIORef haCharBuffer + if not (isEmptyBuffer cbuf) then return False else do + + bbuf <- readIORef haByteBuffer + if not (isEmptyBuffer bbuf) then return False else do + + -- NB. do no decoding, just fill the byte buffer; see #3808 + (r,bbuf') <- Buffered.fillReadBuffer haDevice bbuf + if r == 0 + then return True + else do writeIORef haByteBuffer bbuf' + return False -- --------------------------------------------------------------------------- -- Looking ahead @@ -196,32 +206,12 @@ hSetBuffering handle mode = _ -> do if mode == haBufferMode then return handle_ else do - {- Note: - - we flush the old buffer regardless of whether - the new buffer could fit the contents of the old buffer - or not. - - allow a handle's buffering to change even if IO has - occurred (ANSI C spec. does not allow this, nor did - the previous implementation of IO.hSetBuffering). - - a non-standard extension is to allow the buffering - of semi-closed handles to change [sof 6/98] - -} - flushCharBuffer handle_ - - let state = initBufferState haType - reading = not (isWritableHandleType haType) - - new_buf <- - case mode of - -- See [note Buffer Sizing], GHC.IO.Handle.Types - NoBuffering | reading -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state - | otherwise -> newCharBuffer 1 state - LineBuffering -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state - BlockBuffering Nothing -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state - BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n - | otherwise -> newCharBuffer n state + -- See [note Buffer Sizing] in GHC.IO.Handle.Types - writeIORef haCharBuffer new_buf + -- check for errors: + case mode of + BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n + _ -> return () -- for input terminals we need to put the terminal into -- cooked or raw mode depending on the type of buffering. @@ -246,8 +236,7 @@ hSetBuffering handle mode = -- hSetEncoding -- | The action 'hSetEncoding' @hdl@ @encoding@ changes the text encoding --- for the handle @hdl@ to @encoding@. Encodings are available from the --- module "GHC.IO.Encoding". The default encoding when a 'Handle' is +-- for the handle @hdl@ to @encoding@. The default encoding when a 'Handle' is -- created is 'localeEncoding', namely the default encoding for the current -- locale. -- @@ -255,15 +244,34 @@ hSetBuffering handle mode = -- stop further encoding or decoding on an existing 'Handle', use -- 'hSetBinaryMode'. -- +-- 'hSetEncoding' may need to flush buffered data in order to change +-- the encoding. +-- hSetEncoding :: Handle -> TextEncoding -> IO () hSetEncoding hdl encoding = do - withHandle "hSetEncoding" hdl $ \h_@Handle__{..} -> do + withAllHandles__ "hSetEncoding" hdl $ \h_@Handle__{..} -> do flushCharBuffer h_ + closeTextCodecs h_ openTextEncoding (Just encoding) haType $ \ mb_encoder mb_decoder -> do bbuf <- readIORef haByteBuffer ref <- newIORef (error "last_decode") - return (Handle__{ haLastDecode = ref, haDecoder = mb_decoder, haEncoder = mb_encoder, .. }, - ()) + return (Handle__{ haLastDecode = ref, + haDecoder = mb_decoder, + haEncoder = mb_encoder, + haCodec = Just encoding, .. }) + +-- | Return the current 'TextEncoding' for the specified 'Handle', or +-- 'Nothing' if the 'Handle' is in binary mode. +-- +-- Note that the 'TextEncoding' remembers nothing about the state of +-- the encoder/decoder in use on this 'Handle'. For example, if the +-- encoding in use is UTF-16, then using 'hGetEncoding' and +-- 'hSetEncoding' to save and restore the encoding may result in an +-- extra byte-order-mark being written to the file. +-- +hGetEncoding :: Handle -> IO (Maybe TextEncoding) +hGetEncoding hdl = + withHandle_ "hGetEncoding" hdl $ \h_@Handle__{..} -> return haCodec -- ----------------------------------------------------------------------------- -- hFlush @@ -367,6 +375,9 @@ hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i -- -- This operation may fail with: -- +-- * 'isIllegalOperationError' if the Handle is not seekable, or does +-- not support the requested seek mode. +-- -- * 'isPermissionError' if a system resource limit would be exceeded. hSeek :: Handle -> SeekMode -> Integer -> IO () @@ -391,20 +402,32 @@ hSeek handle mode offset = IODevice.seek haDevice mode offset +-- | Computation 'hTell' @hdl@ returns the current position of the +-- handle @hdl@, as the number of bytes from the beginning of +-- the file. The value returned may be subsequently passed to +-- 'hSeek' to reposition the handle to the current position. +-- +-- This operation may fail with: +-- +-- * 'isIllegalOperationError' if the Handle is not seekable. +-- hTell :: Handle -> IO Integer hTell handle = wantSeekableHandle "hGetPosn" handle $ \ handle_@Handle__{..} -> do posn <- IODevice.tell haDevice - cbuf <- readIORef haCharBuffer + -- we can't tell the real byte offset if there are buffered + -- Chars, so must flush first: + flushCharBuffer handle_ + bbuf <- readIORef haByteBuffer - let real_posn - | isWriteBuffer cbuf = posn + fromIntegral (bufR cbuf) - | otherwise = posn - fromIntegral (bufR cbuf - bufL cbuf) - - fromIntegral (bufR bbuf - bufL bbuf) + let real_posn + | isWriteBuffer bbuf = posn + fromIntegral (bufferElems bbuf) + | otherwise = posn - fromIntegral (bufferElems bbuf) + cbuf <- readIORef haCharBuffer debugIO ("\nhGetPosn: (posn, real_posn) = " ++ show (posn, real_posn)) debugIO (" cbuf: " ++ summaryBuffer cbuf ++ " bbuf: " ++ summaryBuffer bbuf) @@ -534,7 +557,8 @@ hSetBinaryMode :: Handle -> Bool -> IO () hSetBinaryMode handle bin = withAllHandles__ "hSetBinaryMode" handle $ \ h_@Handle__{..} -> do - flushBuffer h_ + flushCharBuffer h_ + closeTextCodecs h_ let mb_te | bin = Nothing | otherwise = Just localeEncoding @@ -551,6 +575,7 @@ hSetBinaryMode handle bin = return Handle__{ haLastDecode = ref, haEncoder = mb_encoder, haDecoder = mb_decoder, + haCodec = mb_te, haInputNL = inputNL nl, haOutputNL = outputNL nl, .. } @@ -668,7 +693,7 @@ dupHandleTo filepath h other_side case cast devTo of Nothing -> ioe_dupHandlesNotCompatible h Just dev' -> do - IODevice.dup2 dev dev' + _ <- IODevice.dup2 dev dev' FileHandle _ m <- dupHandle_ dev' filepath other_side h_ mb_finalizer takeMVar m