import GHC.Num ( Integer(..), Num(..) )
import GHC.Show
import GHC.Real ( toInteger )
+#if defined(DEBUG_DUMP)
+import GHC.Pack
+#endif
import GHC.Conc
-- buffer better be empty:
assert (r == 0 && w == 0) $ do
#ifdef DEBUG_DUMP
- puts ("fillReadBufferLoopNoBlock: bytes = " ++ show bytes ++ "\n")
+ puts ("fillReadBufferLoopNoBlock: bytes = " ++ show size ++ "\n")
#endif
res <- readRawBufferNoBlock "fillReadBuffer" fd is_stream b
0 (fromIntegral size)
throwErrnoIfMinus1Retry "openFile"
(c_open f (fromIntegral oflags) 0o666)
- h <- openFd fd Nothing False filepath mode binary
+ fd_type <- fdType fd
+
+ h <- openFd fd (Just fd_type) False filepath mode binary
`catchException` \e -> do c_close (fromIntegral fd); throw e
-- NB. don't forget to close the FD if openFd fails, otherwise
-- this FD leaks.
-- ASSERT: if we just created the file, then openFd won't fail
-- (so we don't need to worry about removing the newly created file
-- in the event of an error).
+
#ifndef mingw32_HOST_OS
- if mode == WriteMode
+ -- we want to truncate() if this is an open in WriteMode, but only
+ -- if the target is a RegularFile. ftruncate() fails on special files
+ -- like /dev/null.
+ if mode == WriteMode && fd_type == RegularFile
then throwErrnoIf (/=0) "openFile"
(c_ftruncate (fromIntegral fd) 0)
else return 0
-- 'raw' mode under win32 is a bit too specialised (and troublesome
-- for most common uses), so simply disable its use here.
NoBuffering -> setCooked (haFD handle_) False
+#else
+ NoBuffering -> return ()
#endif
_ -> setCooked (haFD handle_) True
c_dup (fromIntegral (haFD h_))
dupHandle_ other_side h_ new_fd
-dupHandleTo other_side h_ hto_ = do
+dupHandleTo other_side hto_ h_ = do
flushBuffer h_
new_fd <- throwErrnoIfMinus1 "dupHandleTo" $
- c_dup2 (fromIntegral (haFD hto_)) (fromIntegral (haFD h_))
+ c_dup2 (fromIntegral (haFD h_)) (fromIntegral (haFD hto_))
dupHandle_ other_side h_ new_fd
dupHandle_ other_side h_ new_fd = do
-- ---------------------------------------------------------------------------
-- debugging
-#ifdef DEBUG_DUMP
+#if defined(DEBUG_DUMP)
puts :: String -> IO ()
-puts s = withCString s $ \cstr -> do write_rawBuffer 1 False cstr 0 (fromIntegral (length s))
- return ()
+puts s = do write_rawBuffer 1 (unsafeCoerce# (packCString# s)) 0 (fromIntegral (length s))
+ return ()
#endif
-- -----------------------------------------------------------------------------