From df70405c9c37bfc17579e27beaa06820388799b0 Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Wed, 9 Oct 2024 08:13:32 -0400
Subject: [PATCH] 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.
---
.../src/GHC/Internal/IO/Windows/Handle.hsc | 15 ++++++++-------
1 file changed, 8 insertions(+), 7 deletions(-)
diff --git a/libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc b/libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc
index 5113ff0f44e..db3b624a555 100644
--- a/libraries/ghc-internal/src/GHC/Internal/IO/Windows/Handle.hsc
+++ b/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
--
GitLab