[Git][ghc/ghc][master] ghc-internal: Fix incomplete matches on IOError

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
df70405c by Ben Gamari at 2024-10-11T03:56:26-04:00
ghc-internal: Fix incomplete matches on IOError

As noted in #25362, these incomplete matches were previously not being
warned about. They were easily addressed by use of
`GHC.Internal.Event.Windows.withException`.

Closes #25362.

- - - - -


1 changed file:

- libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc


Changes:

=====================================
libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc
=====================================
@@ -77,7 +77,7 @@ import GHC.Internal.IO.Windows.Encoding (withGhcInternalToUTF16, withUTF16ToGhcI
 import GHC.Internal.IO.Windows.Paths (getDevicePath)
 import GHC.Internal.IO.Handle.Internals (debugIO)
 import GHC.Internal.IORef
-import GHC.Internal.Event.Windows (LPOVERLAPPED, withOverlappedEx, IOResult(..))
+import GHC.Internal.Event.Windows (LPOVERLAPPED, withOverlappedEx)
 import GHC.Internal.Foreign.Ptr
 import GHC.Internal.Foreign.C.Types
 import GHC.Internal.Foreign.C.Error
@@ -465,10 +465,10 @@ hwndReadNonBlocking :: Io NativeHandle -> Ptr Word8 -> Word64 -> Int
                     -> IO (Maybe Int)
 hwndReadNonBlocking hwnd ptr offset bytes
   = do mngr <- Mgr.getSystemManager
-       val <- withOverlappedEx mngr "hwndReadNonBlocking" (toHANDLE hwnd)
+       Mgr.withException "hwndReadNonBlocking" $
+              withOverlappedEx mngr "hwndReadNonBlocking" (toHANDLE hwnd)
                                (isAsynchronous hwnd) offset (startCB ptr)
                                completionCB
-       return $ ioValue val
   where
     startCB inputBuf lpOverlapped = do
       debugIO ":: hwndReadNonBlocking"
@@ -511,10 +511,11 @@ hwndWrite hwnd ptr offset bytes
 hwndWriteNonBlocking :: Io NativeHandle -> Ptr Word8 -> Word64 -> Int -> IO Int
 hwndWriteNonBlocking hwnd ptr offset bytes
   = do mngr <- Mgr.getSystemManager
-       val <- withOverlappedEx mngr "hwndReadNonBlocking" (toHANDLE hwnd)
-                               (isAsynchronous hwnd) offset (startCB ptr)
-                               completionCB
-       return $ fromIntegral $ ioValue val
+       fmap fromIntegral $
+           Mgr.withException "hwndWriteNonBlocking" $
+           withOverlappedEx mngr "hwndWriteNonBlocking" (toHANDLE hwnd)
+                            (isAsynchronous hwnd) offset (startCB ptr)
+                            completionCB
   where
     startCB :: Ptr a -> LPOVERLAPPED -> IO (Mgr.CbResult a1)
     startCB outBuf lpOverlapped = do



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df70405c9c37bfc17579e27beaa06820388799b0

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df70405c9c37bfc17579e27beaa06820388799b0
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241011/c86976bf/attachment-0001.html>