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

[Ben Gamari (@bgamari)]

Ben Gamari pushed to branch wip/T25362 at Glasgow Haskell Compiler / GHC


Commits:
ac20ee9d by Ben Gamari at 2024-10-09T14:01:52-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/ac20ee9d4cc3f17aa281c2d10327b33342eac167

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ac20ee9d4cc3f17aa281c2d10327b33342eac167
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/20241009/f1b240b4/attachment-0001.html>