X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FHandle.hs;h=a7e9e983a3d48d655d6ea34c5bad6832df3e53fd;hb=0a96e3a4e174425627020b93565041cfcaa746ab;hp=cde2ef526553be87a7694988df38692a1fc516d2;hpb=474a36adb08ce63ba208c81c9881b04567ddf008;p=ghc-base.git

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index cde2ef5..a7e9e98 100644
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -299,6 +299,10 @@ ioe_notSeekable_notBin = ioException
       "seek operations on text-mode handles are not allowed on this platform" 
         Nothing)
  
+ioe_finalizedHandle fp = throw (IOException
+   (IOError Nothing IllegalOperation "" 
+	"handle is finalized" (Just fp)))
+
 ioe_bufsiz :: Int -> IO a
 ioe_bufsiz n = ioException 
    (IOError Nothing InvalidArgument "hSetBuffering"
@@ -314,13 +318,21 @@ ioe_bufsiz n = ioException
 -- The finalizer is then placed on the write side, and the handle only gets
 -- finalized once, when both sides are no longer required.
 
-stdHandleFinalizer :: MVar Handle__ -> IO ()
-stdHandleFinalizer m = do
+-- NOTE about finalized handles: It's possible that a handle can be
+-- finalized and then we try to use it later, for example if the
+-- handle is referenced from another finalizer, or from a thread that
+-- has become unreferenced and then resurrected (arguably in the
+-- latter case we shouldn't finalize the Handle...).  Anyway,
+-- we try to emit a helpful message which is better than nothing.
+
+stdHandleFinalizer :: FilePath -> MVar Handle__ -> IO ()
+stdHandleFinalizer fp m = do
   h_ <- takeMVar m
   flushWriteBufferOnly h_
+  putMVar m (ioe_finalizedHandle fp)
 
-handleFinalizer :: MVar Handle__ -> IO ()
-handleFinalizer m = do
+handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
+handleFinalizer fp m = do
   handle_ <- takeMVar m
   case haType handle_ of 
       ClosedHandle -> return ()
@@ -329,6 +341,7 @@ handleFinalizer m = do
 		-- descriptor anyway...
 	      hClose_handle_ handle_
 	      return ()
+  putMVar m (ioe_finalizedHandle fp)
 
 -- ---------------------------------------------------------------------------
 -- Grimy buffer operations
@@ -513,7 +526,7 @@ readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 readRawBuffer loc fd is_stream buf off len = 
   throwErrnoIfMinus1RetryMayBlock loc
 	    (read_rawBuffer fd buf off len)
-	    (threadWaitRead fd)
+	    (threadWaitRead (fromIntegral fd))
 
 readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 readRawBufferNoBlock loc fd is_stream buf off len = 
@@ -525,19 +538,19 @@ readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 readRawBufferPtr loc fd is_stream buf off len = 
   throwErrnoIfMinus1RetryMayBlock loc
 	    (read_off fd buf off len)
-	    (threadWaitRead fd)
+	    (threadWaitRead (fromIntegral fd))
 
 writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 writeRawBuffer loc fd is_stream buf off len = 
   throwErrnoIfMinus1RetryMayBlock loc
 		(write_rawBuffer (fromIntegral fd) buf off len)
-		(threadWaitWrite fd)
+		(threadWaitWrite (fromIntegral fd))
 
 writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 writeRawBufferPtr loc fd is_stream buf off len = 
   throwErrnoIfMinus1RetryMayBlock loc
 		(write_off (fromIntegral fd) buf off len)
-		(threadWaitWrite fd)
+		(threadWaitWrite (fromIntegral fd))
 
 foreign import ccall unsafe "__hscore_PrelHandle_read"
    read_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt
@@ -869,7 +882,7 @@ mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
 	-> IO Handle
 mkStdHandle fd filepath ha_type buf bmode = do
    spares <- newIORef BufferListNil
-   newFileHandle filepath stdHandleFinalizer
+   newFileHandle filepath (stdHandleFinalizer filepath)
 	    (Handle__ { haFD = fd,
 			haType = ha_type,
                         haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
@@ -884,7 +897,7 @@ mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
 mkFileHandle fd is_stream filepath ha_type binary = do
   (buf, bmode) <- getBuffer fd (initBufferState ha_type)
   spares <- newIORef BufferListNil
-  newFileHandle filepath handleFinalizer
+  newFileHandle filepath (handleFinalizer filepath)
 	    (Handle__ { haFD = fd,
 			haType = ha_type,
                         haIsBin = binary,
@@ -925,7 +938,7 @@ mkDuplexHandle fd is_stream filepath binary = do
 		      }
   read_side <- newMVar r_handle_
 
-  addMVarFinalizer write_side (handleFinalizer write_side)
+  addMVarFinalizer write_side (handleFinalizer filepath write_side)
   return (DuplexHandle filepath read_side write_side)
    
 
@@ -1434,13 +1447,13 @@ foreign import ccall unsafe "__hscore_setmode"
 hDuplicate :: Handle -> IO Handle
 hDuplicate h@(FileHandle path m) = do
   new_h_ <- withHandle' "hDuplicate" h m (dupHandle_ Nothing)
-  new_m <- newMVar new_h_
-  return (FileHandle path new_m)
+  newFileHandle path (handleFinalizer path) new_h_
 hDuplicate h@(DuplexHandle path r w) = do
   new_w_ <- withHandle' "hDuplicate" h w (dupHandle_ Nothing)
   new_w <- newMVar new_w_
   new_r_ <- withHandle' "hDuplicate" h r (dupHandle_ (Just new_w))
   new_r <- newMVar new_r_
+  addMVarFinalizer new_w (handleFinalizer path new_w)
   return (DuplexHandle path new_r new_w)
 
 dupHandle_ other_side h_ = do