Wolfgang Jeltsch pushed to branch wip/jeltsch/detecting-os-handle-types at Glasgow Haskell Compiler / GHC

Commits:

20 changed files:

Changes:

  • libraries/base/changelog.md
    ... ... @@ -23,7 +23,7 @@
    23 23 
       * `GHC.Conc.catchSTM` and `GHC.Conc.Sync.catchSTM` now attach `WhileHandling` annotation to exceptions thrown from the handler. ([GHC #25365](https://gitlab.haskell.org/ghc/ghc/-/issues/25365))
    24 24 
       * Remove `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329)
    25 25 
       * Export `labelThread` from `Control.Concurrent`.([CLC proposal #376](https://github.com/haskell/core-libraries-committee/issues/376))
    26 
    -  * Add a new module `System.IO.OS` with operations for obtaining operating-system handles (file descriptors, Windows handles). ([CLC proposal #369](https://github.com/haskell/core-libraries-committee/issues/369))
    26 
    +  * Add a new module `System.IO.OS` with operations for detecting the type of operating-system handles in use (file descriptors, Windows handles) and obtaining such handles. (CLC proposals [#395](https://github.com/haskell/core-libraries-committee/issues/395) and [#369](https://github.com/haskell/core-libraries-committee/issues/369))
    27 27
    28 28 
     ## 4.22.0.0 *TBA*
    29 29 
       * Shipped with GHC 9.14.1

  • libraries/base/src/System/IO/OS.hs
    ... ... @@ -6,6 +6,10 @@
    6 6 
     -}
    7 7 
     module System.IO.OS
    8 8 
     (
    9 
    +    -- * OS handle type detection
    10 
    +    OSHandleType (FileDescriptor, WindowsHandle),
    11 
    +    osHandleType,
    12 
    +
    9 13 
         -- * Obtaining file descriptors and Windows handles
    10 14 
         withFileDescriptorReadingBiased,
    11 15 
         withFileDescriptorWritingBiased,
    ... ... @@ -23,6 +27,8 @@ where
    23 27
    24 28 
     import GHC.Internal.System.IO.OS
    25 29 
            (
    30 
    +           OSHandleType (FileDescriptor, WindowsHandle),
    31 
    +           osHandleType,
    26 32 
                withFileDescriptorReadingBiased,
    27 33 
                withFileDescriptorWritingBiased,
    28 34 
                withWindowsHandleReadingBiased,

  • libraries/base/tests/IO/all.T
    ... ... @@ -189,9 +189,11 @@ test('mkdirExists', [exit_code(1), when(opsys('mingw32'), ignore_stderr)], compi
    189 189
    190 190 
     test('osHandles001FileDescriptors', omit_ways(['winio', 'winio_threaded']), compile_and_run, [''])
    191 191 
     test('osHandles001WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, [''])
    192 
    -test('osHandles002FileDescriptors', [when(opsys('mingw32'), skip), when(arch('javascript'), skip)], compile_and_run, [''])
    192 
    +test('osHandles002FileDescriptors', omit_ways(['winio', 'winio_threaded']), compile_and_run, [''])
    193 193 
     test('osHandles002WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, [''])
    194 
    -# It would be good to let `osHandles002FileDescriptors` run also on
    194 
    +test('osHandles003FileDescriptors', [when(opsys('mingw32'), skip), when(arch('javascript'), skip)], compile_and_run, [''])
    195 
    +test('osHandles003WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, [''])
    196 
    +# It would be good to let `osHandles003FileDescriptors` run also on
    195 197 
     # Windows with the file-descriptor-based I/O manager. However, this
    196 198 
     # test, as it is currently implemented, requires the `unix` package.
    197 199 
     # That said, `UCRT.DLL`, which is used by GHC-generated Windows

  • libraries/base/tests/IO/osHandles001FileDescriptors.hs
    1 
    -{-# LANGUAGE TypeApplications #-}
    2 
    -
    3 
    -import Control.Monad (mapM_)
    4 
    -import Control.Exception (SomeException, try)
    5 
    -import System.IO (stdin, stdout, stderr)
    6 
    -import System.IO.OS
    7 
    -       (
    8 
    -           withFileDescriptorReadingBiasedRaw,
    9 
    -           withFileDescriptorWritingBiasedRaw,
    10 
    -           withWindowsHandleReadingBiasedRaw,
    11 
    -           withWindowsHandleWritingBiasedRaw
    12 
    -       )
    1 
    +import System.IO.OS (osHandleType)
    13 2
    14 3 
     main :: IO ()
    15 
    -main = mapM_ ((>>= print) . try @SomeException) $
    16 
    -       [
    17 
    -           withFileDescriptorReadingBiasedRaw stdin  (return . show),
    18 
    -           withFileDescriptorWritingBiasedRaw stdout (return . show),
    19 
    -           withFileDescriptorWritingBiasedRaw stderr (return . show),
    20 
    -           withWindowsHandleReadingBiasedRaw  stdin  (return . const "_"),
    21 
    -           withWindowsHandleWritingBiasedRaw  stdout (return . const "_"),
    22 
    -           withWindowsHandleWritingBiasedRaw  stderr (return . const "_")
    23 
    -       ]
    4 
    +main = print osHandleType

  • libraries/base/tests/IO/osHandles001FileDescriptors.stdout
    1 
    -Right "0"
    2 
    -Right "1"
    3 
    -Right "2"
    4 
    -Left <stdin>: withWindowsHandleReadingBiasedRaw: inappropriate type (handle does not use Windows handles)
    5 
    -Left <stdout>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles)
    6 
    -Left <stderr>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles)
    1 
    +FileDescriptor

  • libraries/base/tests/IO/osHandles001WindowsHandles.hs
    1 
    -{-# LANGUAGE TypeApplications #-}
    2 
    -
    3 
    -import Control.Monad (mapM_)
    4 
    -import Control.Exception (SomeException, try)
    5 
    -import System.IO (stdin, stdout, stderr)
    6 
    -import System.IO.OS
    7 
    -       (
    8 
    -           withFileDescriptorReadingBiasedRaw,
    9 
    -           withFileDescriptorWritingBiasedRaw,
    10 
    -           withWindowsHandleReadingBiasedRaw,
    11 
    -           withWindowsHandleWritingBiasedRaw
    12 
    -       )
    1 
    +import System.IO.OS (osHandleType)
    13 2
    14 3 
     main :: IO ()
    15 
    -main = mapM_ ((>>= print) . try @SomeException) $
    16 
    -       [
    17 
    -           withFileDescriptorReadingBiasedRaw stdin  (return . show),
    18 
    -           withFileDescriptorWritingBiasedRaw stdout (return . show),
    19 
    -           withFileDescriptorWritingBiasedRaw stderr (return . show),
    20 
    -           withWindowsHandleReadingBiasedRaw  stdin  (return . const "_"),
    21 
    -           withWindowsHandleWritingBiasedRaw  stdout (return . const "_"),
    22 
    -           withWindowsHandleWritingBiasedRaw  stderr (return . const "_")
    23 
    -       ]
    4 
    +main = print osHandleType

  • libraries/base/tests/IO/osHandles001WindowsHandles.stdout
    1 
    -Left <stdin>: withFileDescriptorReadingBiasedRaw: inappropriate type (handle does not use file descriptors)
    2 
    -Left <stdout>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors)
    3 
    -Left <stderr>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors)
    4 
    -Right "_"
    5 
    -Right "_"
    6 
    -Right "_"
    1 
    +WindowsHandle

  • libraries/base/tests/IO/osHandles002FileDescriptors.hs
    1 
    -import Data.Functor (void)
    2 
    -import Data.ByteString.Char8 (pack)
    3 
    -import System.Posix.Types (Fd (Fd), ByteCount)
    4 
    -import System.Posix.IO.ByteString (fdRead, fdWrite)
    1 
    +{-# LANGUAGE TypeApplications #-}
    2 
    +
    3 
    +import Control.Monad (mapM_)
    4 
    +import Control.Exception (SomeException, try)
    5 5 
     import System.IO (stdin, stdout, stderr)
    6 6 
     import System.IO.OS
    7 7 
            (
    8 
    -           withFileDescriptorReadingBiased,
    9 
    -           withFileDescriptorWritingBiased
    8 
    +           withFileDescriptorReadingBiasedRaw,
    9 
    +           withFileDescriptorWritingBiasedRaw,
    10 
    +           withWindowsHandleReadingBiasedRaw,
    11 
    +           withWindowsHandleWritingBiasedRaw
    10 12 
            )
    11 13
    12 14 
     main :: IO ()
    13 
    -main = withFileDescriptorReadingBiased stdin  $ \ stdinFD  ->
    14 
    -       withFileDescriptorWritingBiased stdout $ \ stdoutFD ->
    15 
    -       withFileDescriptorWritingBiased stderr $ \ stderrFD ->
    16 
    -       do
    17 
    -           regularMsg <- fdRead (Fd stdinFD) inputSizeApproximation
    18 
    -           void $ fdWrite (Fd stdoutFD) regularMsg
    19 
    -           void $ fdWrite (Fd stderrFD) (pack errorMsg)
    20 
    -    where
    21 
    -
    22 
    -    inputSizeApproximation :: ByteCount
    23 
    -    inputSizeApproximation = 100
    24 
    -
    25 
    -    errorMsg :: String
    26 
    -    errorMsg = "And every single door\n\
    27 
    -               \That I've walked through\n\
    28 
    -               \Brings me back, back here again\n"
    15 
    +main = mapM_ ((>>= print) . try @SomeException) $
    16 
    +       [
    17 
    +           withFileDescriptorReadingBiasedRaw stdin  (return . show),
    18 
    +           withFileDescriptorWritingBiasedRaw stdout (return . show),
    19 
    +           withFileDescriptorWritingBiasedRaw stderr (return . show),
    20 
    +           withWindowsHandleReadingBiasedRaw  stdin  (return . const "_"),
    21 
    +           withWindowsHandleWritingBiasedRaw  stdout (return . const "_"),
    22 
    +           withWindowsHandleWritingBiasedRaw  stderr (return . const "_")
    23 
    +       ]

  • libraries/base/tests/IO/osHandles002FileDescriptors.stdout
    1 
    -We've got to get in to get out
    1 
    +Right "0"
    2 
    +Right "1"
    3 
    +Right "2"
    4 
    +Left <stdin>: withWindowsHandleReadingBiasedRaw: inappropriate type (handle does not use Windows handles)
    5 
    +Left <stdout>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles)
    6 
    +Left <stderr>: withWindowsHandleWritingBiasedRaw: inappropriate type (handle does not use Windows handles)

  • libraries/base/tests/IO/osHandles002WindowsHandles.hs
    1 
    -import Control.Monad (zipWithM_)
    2 
    -import Data.Functor (void)
    3 
    -import Data.Char (ord)
    4 
    -import Foreign.Marshal.Alloc (allocaBytes)
    5 
    -import Foreign.Storable (pokeElemOff)
    1 
    +{-# LANGUAGE TypeApplications #-}
    2 
    +
    3 
    +import Control.Monad (mapM_)
    4 
    +import Control.Exception (SomeException, try)
    6 5 
     import System.IO (stdin, stdout, stderr)
    7 6 
     import System.IO.OS
    8 7 
            (
    9 
    -           withWindowsHandleReadingBiased,
    10 
    -           withWindowsHandleWritingBiased
    8 
    +           withFileDescriptorReadingBiasedRaw,
    9 
    +           withFileDescriptorWritingBiasedRaw,
    10 
    +           withWindowsHandleReadingBiasedRaw,
    11 
    +           withWindowsHandleWritingBiasedRaw
    11 12 
            )
    12 13
    13 14 
     main :: IO ()
    14 
    -main = withWindowsHandleReadingBiased stdin  $ \ windowsStdin  ->
    15 
    -       withWindowsHandleWritingBiased stdout $ \ windowsStdout ->
    16 
    -       withWindowsHandleWritingBiased stderr $ \ windowsStderr ->
    17 
    -       do
    18 
    -           withBuffer inputSizeApproximation $ \ bufferPtr -> do
    19 
    -               inputSize <- win32_ReadFile windowsStdin
    20 
    -                                           bufferPtr
    21 
    -                                           inputSizeApproximation
    22 
    -                                           Nothing
    23 
    -               void $ win32_WriteFile windowsStdout
    24 
    -                                      bufferPtr
    25 
    -                                      inputSize
    26 
    -                                      Nothing
    27 
    -           withBuffer errorMsgSize $ \ bufferPtr -> do
    28 
    -               zipWithM_ (pokeElemOff bufferPtr)
    29 
    -                         [0 ..]
    30 
    -                         (map (fromIntegral . ord) errorMsg)
    31 
    -               void $ win32_WriteFile windowsStderr
    32 
    -                                      bufferPtr
    33 
    -                                      errorMsgSize
    34 
    -                                      Nothing
    35 
    -    where
    36 
    -
    37 
    -    withBuffer :: DWORD -> (Ptr Word8 -> IO a) -> IO a
    38 
    -    withBuffer = allocaBytes . fromIntegral
    39 
    -
    40 
    -    inputSizeApproximation :: DWORD
    41 
    -    inputSizeApproximation = 100
    42 
    -
    43 
    -    errorMsg :: String
    44 
    -    errorMsg = "And every single door\n\
    45 
    -               \That I've walked through\n\
    46 
    -               \Brings me back, back here again\n"
    47 
    -
    48 
    -    errorMsgSize :: DWORD
    49 
    -    errorMsgSize = fromIntegral (length errorMsg)
    15 
    +main = mapM_ ((>>= print) . try @SomeException) $
    16 
    +       [
    17 
    +           withFileDescriptorReadingBiasedRaw stdin  (return . show),
    18 
    +           withFileDescriptorWritingBiasedRaw stdout (return . show),
    19 
    +           withFileDescriptorWritingBiasedRaw stderr (return . show),
    20 
    +           withWindowsHandleReadingBiasedRaw  stdin  (return . const "_"),
    21 
    +           withWindowsHandleWritingBiasedRaw  stdout (return . const "_"),
    22 
    +           withWindowsHandleWritingBiasedRaw  stderr (return . const "_")
    23 
    +       ]

  • libraries/base/tests/IO/osHandles002WindowsHandles.stdout
    1 
    -We've got to get in to get out
    1 
    +Left <stdin>: withFileDescriptorReadingBiasedRaw: inappropriate type (handle does not use file descriptors)
    2 
    +Left <stdout>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors)
    3 
    +Left <stderr>: withFileDescriptorWritingBiasedRaw: inappropriate type (handle does not use file descriptors)
    4 
    +Right "_"
    5 
    +Right "_"
    6 
    +Right "_"

  • libraries/base/tests/IO/osHandles003FileDescriptors.hs
    1 
    +import Data.Functor (void)
    2 
    +import Data.ByteString.Char8 (pack)
    3 
    +import System.Posix.Types (Fd (Fd), ByteCount)
    4 
    +import System.Posix.IO.ByteString (fdRead, fdWrite)
    5 
    +import System.IO (stdin, stdout, stderr)
    6 
    +import System.IO.OS
    7 
    +       (
    8 
    +           withFileDescriptorReadingBiased,
    9 
    +           withFileDescriptorWritingBiased
    10 
    +       )
    11 
    +
    12 
    +main :: IO ()
    13 
    +main = withFileDescriptorReadingBiased stdin  $ \ stdinFD  ->
    14 
    +       withFileDescriptorWritingBiased stdout $ \ stdoutFD ->
    15 
    +       withFileDescriptorWritingBiased stderr $ \ stderrFD ->
    16 
    +       do
    17 
    +           regularMsg <- fdRead (Fd stdinFD) inputSizeApproximation
    18 
    +           void $ fdWrite (Fd stdoutFD) regularMsg
    19 
    +           void $ fdWrite (Fd stderrFD) (pack errorMsg)
    20 
    +    where
    21 
    +
    22 
    +    inputSizeApproximation :: ByteCount
    23 
    +    inputSizeApproximation = 100
    24 
    +
    25 
    +    errorMsg :: String
    26 
    +    errorMsg = "And every single door\n\
    27 
    +               \That I've walked through\n\
    28 
    +               \Brings me back, back here again\n"

  • libraries/base/tests/IO/osHandles002FileDescriptors.stderr → libraries/base/tests/IO/osHandles003FileDescriptors.stderr

  • libraries/base/tests/IO/osHandles002FileDescriptors.stdin → libraries/base/tests/IO/osHandles003FileDescriptors.stdin

  • libraries/base/tests/IO/osHandles002WindowsHandles.stdin → libraries/base/tests/IO/osHandles003FileDescriptors.stdout

  • libraries/base/tests/IO/osHandles003WindowsHandles.hs
    1 
    +import Control.Monad (zipWithM_)
    2 
    +import Data.Functor (void)
    3 
    +import Data.Char (ord)
    4 
    +import Foreign.Marshal.Alloc (allocaBytes)
    5 
    +import Foreign.Storable (pokeElemOff)
    6 
    +import System.IO (stdin, stdout, stderr)
    7 
    +import System.IO.OS
    8 
    +       (
    9 
    +           withWindowsHandleReadingBiased,
    10 
    +           withWindowsHandleWritingBiased
    11 
    +       )
    12 
    +
    13 
    +main :: IO ()
    14 
    +main = withWindowsHandleReadingBiased stdin  $ \ windowsStdin  ->
    15 
    +       withWindowsHandleWritingBiased stdout $ \ windowsStdout ->
    16 
    +       withWindowsHandleWritingBiased stderr $ \ windowsStderr ->
    17 
    +       do
    18 
    +           withBuffer inputSizeApproximation $ \ bufferPtr -> do
    19 
    +               inputSize <- win32_ReadFile windowsStdin
    20 
    +                                           bufferPtr
    21 
    +                                           inputSizeApproximation
    22 
    +                                           Nothing
    23 
    +               void $ win32_WriteFile windowsStdout
    24 
    +                                      bufferPtr
    25 
    +                                      inputSize
    26 
    +                                      Nothing
    27 
    +           withBuffer errorMsgSize $ \ bufferPtr -> do
    28 
    +               zipWithM_ (pokeElemOff bufferPtr)
    29 
    +                         [0 ..]
    30 
    +                         (map (fromIntegral . ord) errorMsg)
    31 
    +               void $ win32_WriteFile windowsStderr
    32 
    +                                      bufferPtr
    33 
    +                                      errorMsgSize
    34 
    +                                      Nothing
    35 
    +    where
    36 
    +
    37 
    +    withBuffer :: DWORD -> (Ptr Word8 -> IO a) -> IO a
    38 
    +    withBuffer = allocaBytes . fromIntegral
    39 
    +
    40 
    +    inputSizeApproximation :: DWORD
    41 
    +    inputSizeApproximation = 100
    42 
    +
    43 
    +    errorMsg :: String
    44 
    +    errorMsg = "And every single door\n\
    45 
    +               \That I've walked through\n\
    46 
    +               \Brings me back, back here again\n"
    47 
    +
    48 
    +    errorMsgSize :: DWORD
    49 
    +    errorMsgSize = fromIntegral (length errorMsg)

  • libraries/base/tests/IO/osHandles002WindowsHandles.stderr → libraries/base/tests/IO/osHandles003WindowsHandles.stderr

  • libraries/base/tests/IO/osHandles003WindowsHandles.stdin
    1 
    +We've got to get in to get out

  • libraries/base/tests/IO/osHandles003WindowsHandles.stdout
    1 
    +We've got to get in to get out

  • libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs
    ... ... @@ -8,6 +8,10 @@
    8 8 
     -}
    9 9 
     module GHC.Internal.System.IO.OS
    10 10 
     (
    11 
    +    -- * OS handle type detection
    12 
    +    OSHandleType (FileDescriptor, WindowsHandle),
    13 
    +    osHandleType,
    14 
    +
    11 15 
         -- * Obtaining file descriptors and Windows handles
    12 16 
         withFileDescriptorReadingBiased,
    13 17 
         withFileDescriptorWritingBiased,
    ... ... @@ -23,6 +27,10 @@ module GHC.Internal.System.IO.OS
    23 27 
     )
    24 28 
     where
    25 29
    30 
    +import GHC.Internal.Classes (Eq, Ord)
    31 
    +import GHC.Internal.Enum (Bounded, Enum)
    32 
    +import GHC.Internal.Show (Show)
    33 
    +import GHC.Internal.Read (Read)
    26 34 
     import GHC.Internal.Control.Monad (return)
    27 35 
     import GHC.Internal.Control.Concurrent.MVar (MVar)
    28 36 
     import GHC.Internal.Control.Exception (mask)
    ... ... @@ -39,6 +47,7 @@ import GHC.Internal.Data.List ((++))
    39 47 
     import GHC.Internal.Data.String (String)
    40 48 
     import GHC.Internal.Data.Typeable (Typeable, cast)
    41 49 
     import GHC.Internal.System.IO (IO)
    50 
    +import GHC.Internal.IO.SubSystem (conditional)
    42 51 
     import GHC.Internal.IO.FD (fdFD)
    43 52 
     #if defined(mingw32_HOST_OS)
    44 53 
     import GHC.Internal.IO.Windows.Handle
    ... ... @@ -64,6 +73,19 @@ import GHC.Internal.IO.Exception
    64 73 
     import GHC.Internal.Foreign.Ptr (Ptr)
    65 74 
     import GHC.Internal.Foreign.C.Types (CInt)
    66 75
    76 
    +-- * OS handle type detection
    77 
    +
    78 
    +-- | The type of operating-system handle types.
    79 
    +data OSHandleType = FileDescriptor | WindowsHandle
    80 
    +    deriving (Eq, Ord, Bounded, Enum, Show, Read)
    81 
    +
    82 
    +{-|
    83 
    +    The type of operating-system handles that underlie Haskell handles with the
    84 
    +    I/O manager currently in use.
    85 
    +-}
    86 
    +osHandleType :: OSHandleType
    87 
    +osHandleType = conditional FileDescriptor WindowsHandle
    88 
    +
    67 89 
     -- * Obtaining POSIX file descriptors and Windows handles
    68 90
    69 91 
     {-|

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help