Fix concurrency issue by re-implementting 'hANDLEToHandle'

Fixes #15
hasufell · Jan 12, 2024 · ce3ac73 · ce3ac73
1 parent 05b13a7
commit ce3ac73
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 13 deletions.
diff --git a/tests/Properties.hs b/tests/Properties.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
@@ -53,11 +52,7 @@ iomodeReadFile = do
     baseDir <- OSP.encodeFS baseDir'
     OSP.writeFile (baseDir </> [osp|foo|]) ""
     r <- try @IOException $ OSP.withFile (baseDir </> [osp|foo|]) ReadMode $ \h -> BS.hPut h "test"
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-    Left PermissionDenied
-#else
     Left IllegalOperation
-#endif
       @=? first ioe_type r
 
 iomodeWriteFile :: IO ()
@@ -66,11 +61,7 @@ iomodeWriteFile = do
     baseDir <- OSP.encodeFS baseDir'
     OSP.writeFile (baseDir </> [osp|foo|]) ""
     r <- try @IOException $ OSP.withFile (baseDir </> [osp|foo|]) WriteMode $ \h -> BS.hGetContents h
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-    Left InvalidArgument
-#else
     Left IllegalOperation
-#endif
       @=? first ioe_type r
 
 iomodeAppendFile :: IO ()
@@ -79,11 +70,7 @@ iomodeAppendFile = do
     baseDir <- OSP.encodeFS baseDir'
     OSP.writeFile (baseDir </> [osp|foo|]) ""
     r <- try @IOException $ OSP.withFile (baseDir </> [osp|foo|]) AppendMode $ \h -> BS.hGetContents h
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
-    Left InvalidArgument
-#else
     Left IllegalOperation
-#endif
       @=? first ioe_type r
 
 iomodeReadWriteFile :: IO ()

diff --git a/windows/System/File/Platform.hs → windows/System/File/Platform.hsc b/windows/System/File/Platform.hs → windows/System/File/Platform.hsc
@@ -6,12 +6,17 @@ import Control.Exception (bracketOnError)
 import Data.Bits
 import System.IO (IOMode(..), Handle)
 import System.OsPath.Windows ( WindowsPath )
+import Foreign.C.Types
+import Foreign.Ptr (ptrToIntPtr)
 
 import qualified System.Win32 as Win32
 import qualified System.Win32.WindowsString.File as WS
 import Control.Monad (when, void)
 #if defined(__IO_MANAGER_WINIO__)
 import GHC.IO.SubSystem
+#else
+import GHC.IO.Handle.FD (fdToHandle')
+#include <fcntl.h>
 #endif
 
 -- | Open a file and return the 'Handle'.
@@ -35,9 +40,16 @@ openFile fp iomode = bracketOnError
     Win32.closeHandle
     toHandle
  where
+#if defined(__IO_MANAGER_WINIO__)
   toHandle h = do
     when (iomode == AppendMode ) $ void $ Win32.setFilePointerEx h 0 Win32.fILE_END
     Win32.hANDLEToHandle h
+#else
+  toHandle h = do
+    when (iomode == AppendMode ) $ void $ Win32.setFilePointerEx h 0 Win32.fILE_END
+    fd <- _open_osfhandle (fromIntegral (ptrToIntPtr h)) (#const _O_BINARY)
+    fdToHandle' fd Nothing False ("<file descriptor: " ++ show fd ++ ">") iomode True
+#endif
   accessMode = case iomode of
     ReadMode      -> Win32.gENERIC_READ
     WriteMode     -> Win32.gENERIC_WRITE
@@ -109,3 +121,8 @@ openExistingFile fp iomode = bracketOnError
     AppendMode    -> writeShareMode
     ReadWriteMode -> maxShareMode
 
+#if !defined(__IO_MANAGER_WINIO__)
+foreign import ccall "_open_osfhandle"
+  _open_osfhandle :: CIntPtr -> CInt -> IO CInt
+#endif
+