Wolfgang Jeltsch pushed to branch wip/jeltsch/obtaining-os-handles at Glasgow Haskell Compiler / GHC

Commits:

13 changed files:

Changes:

  • libraries/base/tests/IO/all.T
    ... ... @@ -186,3 +186,15 @@ test('T17912', [only_ways(['threaded1']), when(opsys('mingw32'),expect_broken(1)
    186 186 
     test('T18832', only_ways(['threaded1']), compile_and_run, [''])
    187 187
    188 188 
     test('mkdirExists', [exit_code(1), when(opsys('mingw32'), ignore_stderr)], compile_and_run, [''])
    189 
    +
    190 
    +test('osHandles001FileDescriptors', omit_ways(['winio', 'winio_threaded']), compile_and_run, [''])
    191 
    +test('osHandles001WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, [''])
    192 
    +test('osHandles002FileDescriptors', when(opsys('mingw32'), skip), compile_and_run, [''])
    193 
    +test('osHandles002WindowsHandles', only_ways(['winio', 'winio_threaded']), compile_and_run, [''])
    194 
    +# It would be good to let `osHandles002FileDescriptors` run also on
    195 
    +# Windows with the file-descriptor-based I/O manager. However, this
    196 
    +# test, as it is currently implemented, requires the `unix` package.
    197 
    +# That said, `UCRT.DLL`, which is used by GHC-generated Windows
    198 
    +# executables, emulates part of POSIX, enough for this test. As a
    199 
    +# result, this test could be generalized to also supporting Windows, but
    200 
    +# this would likely involve creating bindings to C code.

  • 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 
    +       )
    13 
    +
    14 
    +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 
    +       ]

  • 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)

  • 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 
    +       )
    13 
    +
    14 
    +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 
    +       ]

  • 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 "_"

  • 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)
    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
    1 
    +And every single door
    2 
    +That I've walked through
    3 
    +Brings me back, back here again

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

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

  • 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)
    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
    1 
    +And every single door
    2 
    +That I've walked through
    3 
    +Brings me back, back here again

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

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

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