[project @ 2005-12-13 13:28:53 by simonmar]

[haskell-directory.git] / GHC / Handle.hs

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index a3cf25b..52bf8cd 100644 (file)
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -915,10 +915,6 @@ openFd fd mb_fd_type is_socket filepath mode binary = do
           ioException (IOError Nothing InappropriateType "openFile"
                           "is a directory" Nothing) 
 
-       Stream
-          | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_socket filepath binary
-          | otherwise                  -> mkFileHandle fd is_socket filepath ha_type binary
-
        -- regular files need to be locked
        RegularFile -> do
 #ifndef mingw32_HOST_OS
@@ -929,6 +925,20 @@ openFd fd mb_fd_type is_socket filepath mode binary = do
 #endif
           mkFileHandle fd is_socket filepath ha_type binary
 
+       Stream
+          -- only *Streams* can be DuplexHandles.  Other read/write
+          -- Handles must share a buffer.
+          | ReadWriteHandle <- ha_type -> 
+               mkDuplexHandle fd is_socket filepath binary
+          | otherwise ->
+               mkFileHandle   fd is_socket filepath ha_type binary
+
+       RawDevice -> 
+               mkFileHandle fd is_socket filepath ha_type binary
+
+       _ ->
+         ioException (IOError Nothing UnsupportedOperation "openFd"
+                                  "unknown file type" Nothing) 
 
 fdToHandle :: FD -> IO Handle
 fdToHandle fd = do
@@ -1462,9 +1472,8 @@ hIsSeekable handle =
       SemiClosedHandle            -> ioe_closedHandle
       AppendHandle        -> return False
       _                    -> do t <- fdType (haFD handle_)
-                                 return (t == RegularFile
-                                         && (haIsBin handle_ 
-                                               || tEXT_MODE_SEEK_ALLOWED))
+                                 return ((t == RegularFile    || t == RawDevice)
+                                         && (haIsBin handle_  || tEXT_MODE_SEEK_ALLOWED))
 
 -- -----------------------------------------------------------------------------
 -- Changing echo status (Non-standard GHC extensions)