Merge branch 'fix-ghc-8.10'

haskell · Aug 10, 2024 · b2e7a52 · b2e7a52
2 parents 5ab65c4 + 1204e8b
commit b2e7a52
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 2 deletions.
diff --git a/.github/workflows/test.yaml b/.github/workflows/test.yaml
@@ -16,14 +16,16 @@ jobs:
       fail-fast: false
       matrix:
         os: [ubuntu-latest]
-        ghc: ['8.8', '8.10', '9.0', '9.2', '9.4', '9.6', '9.8']
+        ghc: ['8.8', '8.10', '9.0', '9.2', '9.4', '9.6', '9.8', '9.10']
         include:
           - os: macOS-latest
             ghc: '9.4'
           - os: macOS-latest
             ghc: '9.6'
           - os: macOS-latest
             ghc: '9.8'
+          - os: windows-latest
+            ghc: '8.10'
           - os: windows-latest
             ghc: '9.4'
           - os: windows-latest

diff --git a/windows/System/File/Platform.hsc b/windows/System/File/Platform.hsc
@@ -102,7 +102,7 @@ writeShareMode =
   Win32.fILE_SHARE_DELETE .|.
   Win32.fILE_SHARE_READ
 
-  -- | Open an existing file and return the 'Handle'.
+-- | Open an existing file and return the 'Handle'.
 openExistingFile :: WindowsPath -> IOMode -> IO Handle
 openExistingFile fp iomode = bracketOnError
     (WS.createFile
@@ -168,6 +168,7 @@ findTempName (prefix, suffix) loc tmp_dir mode = go
 #endif
       withTString label $ \c_template ->
         withTString suffix $ \c_suffix ->
+#if MIN_VERSION_base(4, 15, 0)
           with nullPtr $ \c_ptr -> do
             res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr
             if not res
@@ -178,13 +179,31 @@ findTempName (prefix, suffix) loc tmp_dir mode = go
                        free c_p
                        let flags = fromIntegral mode .&. o_EXCL
                        handleResultsWinIO filename (flags == o_EXCL)
+#else
+            -- NOTE: revisit this when new I/O manager in place and use a UUID
+            --       based one when we are no longer MAX_PATH bound.
+            allocaBytes (sizeOf (undefined :: CWchar) * 260) $ \c_str -> do
+            res <- c_getTempFileNameErrorNo c_tmp_dir c_template c_suffix 0
+                                            c_str
+            if not res
+               then do errno <- getErrno
+                       ioError (errnoToIOError loc errno Nothing (Just $ lenientDecode tmp_dir))
+               else do filename <- peekTString c_str
+                       let flags = fromIntegral mode .&. o_EXCL
+                       handleResultsWinIO filename (flags == o_EXCL)
+#endif
 
   handleResultsWinIO filename excl = do
     h <- (if excl then openExistingFile else openFile) filename ReadWriteMode
     return (filename, h)
 
+#if MIN_VERSION_base(4, 15, 0)
 foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo
   :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool
+#else
+foreign import ccall "getTempFileNameErrorNo" c_getTempFileNameErrorNo
+  :: CWString -> CWString -> CWString -> CUInt -> Ptr CWchar -> IO Bool
+#endif