X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FHandle.hs;h=ddf17e7540782bc91f93b4377b90b32af87e12c2;hb=b99920eab7fba4e027fd39985840d4e854b8f923;hp=10b70049d8d58ab353e58c78f959aeef369cbb53;hpb=cdc356f8844b93fc3ad8748c8e6fa6b82fa27dad;p=ghc-base.git diff --git a/GHC/IO/Handle.hs b/GHC/IO/Handle.hs index 10b7004..ddf17e7 100644 --- a/GHC/IO/Handle.hs +++ b/GHC/IO/Handle.hs @@ -206,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. @@ -437,14 +417,17 @@ hTell handle = 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)