[Git][ghc/ghc][wip/andreask/base_c_fstat_refactor] Small cleanup around calls to fstat.

[Andreas Klebinger (@AndreasK)]

Andreas Klebinger pushed to branch wip/andreask/base_c_fstat_refactor at Glasgow Haskell Compiler / GHC


Commits:
3ae5ed83 by Andreas Klebinger at 2024-11-01T14:32:12+01:00
Small cleanup around calls to fstat.

Pulls out some common logic into a new fdWithCStat helper function.

- - - - -


6 changed files:

- libraries/base/src/System/Posix/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-ws-32


Changes:

=====================================
libraries/base/src/System/Posix/Internals.hs
=====================================
@@ -27,4 +27,4 @@ module System.Posix.Internals
   ( module GHC.Internal.System.Posix.Internals -- TODO: deprecate
   ) where
 
-import GHC.Internal.System.Posix.Internals
+import GHC.Internal.System.Posix.Internals hiding (fdWithCStat)


=====================================
libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
=====================================
@@ -57,7 +57,6 @@ import GHC.Internal.Foreign.Storable
 import GHC.Internal.Foreign.C.Types
 import GHC.Internal.Foreign.C.Error
 import GHC.Internal.Foreign.Marshal.Utils
-import GHC.Internal.Foreign.Marshal.Alloc (allocaBytes)
 
 import qualified GHC.Internal.System.Posix.Internals
 import GHC.Internal.System.Posix.Internals hiding (FD, setEcho, getEcho)
@@ -470,9 +469,7 @@ setNonBlockingMode fd set = do
   is_nonblock <-
     if set
       then do
-        allocaBytes sizeof_stat $ \ p_stat -> do
-          throwErrnoIfMinus1Retry_ "fileSize" $
-            c_fstat (fdFD fd) p_stat
+        fdWithCStat (fdFD fd) $ \ p_stat -> do
           fd_type <- statGetType_maybe p_stat
           pure $ fd_type /= Just RegularFile && fd_type /= Just RawDevice
       else pure False


=====================================
libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
=====================================
@@ -105,11 +105,16 @@ type FD = CInt
 -- ---------------------------------------------------------------------------
 -- stat()-related stuff
 
-fdFileSize :: FD -> IO Integer
-fdFileSize fd =
+fdWithCStat :: FD -> (Ptr CStat -> IO a) -> IO a
+fdWithCStat fd fun = do
   allocaBytes sizeof_stat $ \ p_stat -> do
     throwErrnoIfMinus1Retry_ "fileSize" $
-        c_fstat fd p_stat
+      c_fstat fd p_stat
+    fun p_stat
+
+fdFileSize :: FD -> IO Integer
+fdFileSize fd =
+  fdWithCStat fd $ \ p_stat -> do
     c_mode <- st_mode p_stat :: IO CMode
     if not (s_isreg c_mode)
         then return (-1)
@@ -129,9 +134,7 @@ fileType file =
 -- referring to file handles. i.e., it'll fail for socket FDs.
 fdStat :: FD -> IO (IODeviceType, CDev, CIno)
 fdStat fd =
-  allocaBytes sizeof_stat $ \ p_stat -> do
-    throwErrnoIfMinus1Retry_ "fdType" $
-        c_fstat fd p_stat
+  fdWithCStat fd $ \ p_stat -> do
     ty <- statGetType p_stat
     dev <- st_dev p_stat
     ino <- st_ino p_stat


=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -10554,7 +10554,6 @@ module System.Posix.Internals where
   fdFileSize :: FD -> GHC.Types.IO GHC.Num.Integer.Integer
   fdGetMode :: FD -> GHC.Types.IO GHC.Internal.IO.IOMode.IOMode
   fdStat :: FD -> GHC.Types.IO (GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
-  fdStat_maybe :: FD -> GHC.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
   fdType :: FD -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
   fileType :: GHC.Internal.IO.FilePath -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
   getEcho :: FD -> GHC.Types.IO GHC.Types.Bool


=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -13595,7 +13595,6 @@ module System.Posix.Internals where
   fdFileSize :: FD -> GHC.Types.IO GHC.Num.Integer.Integer
   fdGetMode :: FD -> GHC.Types.IO GHC.Internal.IO.IOMode.IOMode
   fdStat :: FD -> GHC.Types.IO (GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
-  fdStat_maybe :: FD -> GHC.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
   fdType :: FD -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
   fileType :: GHC.Internal.IO.FilePath -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
   getEcho :: FD -> GHC.Types.IO GHC.Types.Bool


=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -10554,7 +10554,6 @@ module System.Posix.Internals where
   fdFileSize :: FD -> GHC.Types.IO GHC.Num.Integer.Integer
   fdGetMode :: FD -> GHC.Types.IO GHC.Internal.IO.IOMode.IOMode
   fdStat :: FD -> GHC.Types.IO (GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
-  fdStat_maybe :: FD -> GHC.Types.IO (GHC.Internal.Maybe.Maybe GHC.Internal.IO.Device.IODeviceType, GHC.Internal.System.Posix.Types.CDev, GHC.Internal.System.Posix.Types.CIno)
   fdType :: FD -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
   fileType :: GHC.Internal.IO.FilePath -> GHC.Types.IO GHC.Internal.IO.Device.IODeviceType
   getEcho :: FD -> GHC.Types.IO GHC.Types.Bool



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3ae5ed832e308d0b89bf7d13fc48f7d1e6491d17
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/20241101/eede7e31/attachment-0001.html>