Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC

Commits:

5 changed files:

Changes:

  • libraries/base/tests/IO/all.T
    ... ... @@ -182,7 +182,7 @@ test('T17414',
    182 182 
          compile_and_run, [''])
    183 183 
     test('T17510', expect_broken(17510), compile_and_run, [''])
    184 184 
     test('bytestringread001', extra_run_opts('test.data'), compile_and_run, [''])
    185 
    -test('T17912', [only_ways(['threaded1']), when(opsys('mingw32'),expect_broken(17912))], compile_and_run, [''])
    185 
    +test('T17912', [only_ways(['threaded1']), when(opsys('mingw32'),fragile(24739))], compile_and_run, [''])
    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, [''])

  • libraries/ghc-boot/GHC/Data/SizedSeq.hs
    1 
    -{-# LANGUAGE StandaloneDeriving, DeriveGeneric, CPP #-}
    2 1 
     module GHC.Data.SizedSeq
    3 2 
       ( SizedSeq(..)
    4 3 
       , emptySS
    5 4 
       , addToSS
    6 
    -  , addListToSS
    7 5 
       , ssElts
    8 6 
       , sizeSS
    9 7 
       ) where
    10 8
    11 9 
     import Prelude -- See note [Why do we import Prelude here?]
    12 
    -import Control.DeepSeq
    13 
    -import Data.Binary
    14 
    -import GHC.Generics
    15 
    -
    16 
    -#if ! MIN_VERSION_base(4,20,0)
    17 
    -import Data.List (foldl')
    18 
    -#endif
    19 10
    20 11 
     data SizedSeq a = SizedSeq {-# UNPACK #-} !Word [a]
    21 
    -  deriving (Generic, Show)
    22 
    -
    23 
    -instance Functor SizedSeq where
    24 
    -  fmap f (SizedSeq sz l) = SizedSeq sz (fmap f l)
    25 
    -
    26 
    -instance Foldable SizedSeq where
    27 
    -  foldr f c ss = foldr f c (ssElts ss)
    28 
    -
    29 
    -instance Traversable SizedSeq where
    30 
    -  traverse f (SizedSeq sz l) = SizedSeq sz . reverse <$> traverse f (reverse l)
    31 
    -
    32 
    -instance Binary a => Binary (SizedSeq a)
    33 
    -
    34 
    -instance NFData a => NFData (SizedSeq a) where
    35 
    -  rnf (SizedSeq _ xs) = rnf xs
    36 12
    37 13 
     emptySS :: SizedSeq a
    38 14 
     emptySS = SizedSeq 0 []
    ... ... @@ -40,10 +16,6 @@ emptySS = SizedSeq 0 []
    40 16 
     addToSS :: SizedSeq a -> a -> SizedSeq a
    41 17 
     addToSS (SizedSeq n r_xs) x = SizedSeq (n+1) (x:r_xs)
    42 18
    43 
    --- NB, important this is eta-expand so that foldl' is inlined.
    44 
    -addListToSS :: SizedSeq a -> [a] -> SizedSeq a
    45 
    -addListToSS s xs = foldl' addToSS s xs
    46 
    -
    47 19 
     ssElts :: SizedSeq a -> [a]
    48 20 
     ssElts (SizedSeq _ r_xs) = reverse r_xs
    49 21

  • libraries/ghci/GHCi/BinaryArray.hs deleted
    1 
    -{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples, FlexibleContexts #-}
    2 
    --- | Efficient serialisation for GHCi Instruction arrays
    3 
    ---
    4 
    --- Author: Ben Gamari
    5 
    ---
    6 
    -module GHCi.BinaryArray(putArray, getArray) where
    7 
    -
    8 
    -import Prelude
    9 
    -import Foreign.Ptr
    10 
    -import Data.Binary
    11 
    -import Data.Binary.Put (putBuilder)
    12 
    -import qualified Data.Binary.Get.Internal as Binary
    13 
    -import qualified Data.ByteString.Builder as BB
    14 
    -import qualified Data.ByteString.Builder.Internal as BB
    15 
    -import qualified Data.Array.Base as A
    16 
    -import qualified Data.Array.IO.Internals as A
    17 
    -import qualified Data.Array.Unboxed as A
    18 
    -import GHC.Exts
    19 
    -import GHC.IO
    20 
    -
    21 
    --- | An efficient serialiser of 'A.UArray'.
    22 
    -putArray :: Binary i => A.UArray i a -> Put
    23 
    -putArray (A.UArray l u _ arr#) = do
    24 
    -    put l
    25 
    -    put u
    26 
    -    putBuilder $ byteArrayBuilder arr#
    27 
    -
    28 
    -byteArrayBuilder :: ByteArray# -> BB.Builder
    29 
    -byteArrayBuilder arr# = BB.builder $ go 0 (I# (sizeofByteArray# arr#))
    30 
    -  where
    31 
    -    go :: Int -> Int -> BB.BuildStep a -> BB.BuildStep a
    32 
    -    go !inStart !inEnd k (BB.BufferRange outStart outEnd)
    33 
    -      -- There is enough room in this output buffer to write all remaining array
    34 
    -      -- contents
    35 
    -      | inRemaining <= outRemaining = do
    36 
    -          copyByteArrayToAddr arr# inStart outStart inRemaining
    37 
    -          k (BB.BufferRange (outStart `plusPtr` inRemaining) outEnd)
    38 
    -      -- There is only enough space for a fraction of the remaining contents
    39 
    -      | otherwise = do
    40 
    -          copyByteArrayToAddr arr# inStart outStart outRemaining
    41 
    -          let !inStart' = inStart + outRemaining
    42 
    -          return $! BB.bufferFull 1 outEnd (go inStart' inEnd k)
    43 
    -      where
    44 
    -        inRemaining  = inEnd - inStart
    45 
    -        outRemaining = outEnd `minusPtr` outStart
    46 
    -
    47 
    -    copyByteArrayToAddr :: ByteArray# -> Int -> Ptr a -> Int -> IO ()
    48 
    -    copyByteArrayToAddr src# (I# src_off#) (Ptr dst#) (I# len#) =
    49 
    -        IO $ \s -> case copyByteArrayToAddr# src# src_off# dst# len# s of
    50 
    -                     s' -> (# s', () #)
    51 
    -
    52 
    --- | An efficient deserialiser of 'A.UArray'.
    53 
    -getArray :: (Binary i, A.Ix i, A.MArray A.IOUArray a IO) => Get (A.UArray i a)
    54 
    -getArray = do
    55 
    -    l <- get
    56 
    -    u <- get
    57 
    -    arr@(A.IOUArray (A.STUArray _ _ _ arr#)) <-
    58 
    -        return $ unsafeDupablePerformIO $ A.newArray_ (l,u)
    59 
    -    let go 0 _ = return ()
    60 
    -        go !remaining !off = do
    61 
    -            Binary.readNWith n $ \ptr ->
    62 
    -              copyAddrToByteArray ptr arr# off n
    63 
    -            go (remaining - n) (off + n)
    64 
    -          where n = min chunkSize remaining
    65 
    -    sz <- return $ unsafeDupablePerformIO $ IO $ \s -> case getSizeofMutableByteArray# arr# s of
    66 
    -            (# s2, n #) -> (# s2, I# n #)
    67 
    -    go sz 0
    68 
    -    return $! unsafeDupablePerformIO $ unsafeFreezeIOUArray arr
    69 
    -  where
    70 
    -    chunkSize = 10*1024
    71 
    -
    72 
    -    copyAddrToByteArray :: Ptr a -> MutableByteArray# RealWorld
    73 
    -                        -> Int -> Int -> IO ()
    74 
    -    copyAddrToByteArray (Ptr src#) dst# (I# dst_off#) (I# len#) =
    75 
    -        IO $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of
    76 
    -                     s' -> (# s', () #)
    77 
    -
    78 
    --- this is inexplicably not exported in currently released array versions
    79 
    -unsafeFreezeIOUArray :: A.IOUArray ix e -> IO (A.UArray ix e)
    80 
    -unsafeFreezeIOUArray (A.IOUArray marr) = stToIO (A.unsafeFreezeSTUArray marr)

  • libraries/ghci/ghci.cabal.in
    ... ... @@ -74,7 +74,6 @@ library
    74 74
    75 75 
         exposed-modules:
    76 76 
             GHCi.BreakArray
    77 
    -        GHCi.BinaryArray
    78 77 
             GHCi.Message
    79 78 
             GHCi.ResolvedBCO
    80 79 
             GHCi.RemoteTypes

  • testsuite/tests/ghci/should_run/BinaryArray.hs
    ... ... @@ -4,25 +4,10 @@ import Data.Binary.Put
    4 4 
     import Data.Binary (Binary, get, put)
    5 5 
     import Data.Array.Byte
    6 6 
     import Data.Array.Unboxed as AU
    7 
    -import Data.Array.IO (IOUArray)
    8 
    -import Data.Array.MArray (MArray)
    9 
    -import Data.Array as A
    10 7 
     import Data.Array.Base as A
    11 
    -import Foreign.Storable
    12 
    -import GHCi.BinaryArray
    13 8 
     import GHCi.ResolvedBCO
    14 9 
     import GHC.Word
    15 10
    16 
    -roundtripTest :: (IArray UArray a, MArray IOUArray a IO, Eq a)
    17 
    -              => UArray Int a -> IO ()
    18 
    -roundtripTest arr =
    19 
    -    let ser  = Data.Binary.Put.runPut $ putArray arr
    20 
    -    in case Data.Binary.Get.runGetOrFail getArray ser of
    21 
    -         Right (_, _, arr')
    22 
    -           | arr == arr'  -> return ()
    23 
    -           | otherwise    -> putStrLn "failed to round-trip"
    24 
    -         Left _           -> putStrLn "deserialization failed"
    25 
    -
    26 11 
     -- See Note [BCOByteArray serialization]
    27 12 
     roundtripTestByteArray :: forall a . (IArray UArray a, Eq a, Binary (BCOByteArray a))
    28 13 
                   => UArray Int a -> IO ()
    ... ... @@ -37,12 +22,5 @@ roundtripTestByteArray (UArray _ _ _ arr#) =
    37 22
    38 23 
     main :: IO ()
    39 24 
     main = do
    40 
    -    roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Int)
    41 
    -    roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word)
    42 
    -    roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word8)
    43 
    -    roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word16)
    44 
    -    roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word32)
    45 
    -    roundtripTest (AU.listArray (1,500) [1..] :: UArray Int Word64)
    46 
    -    roundtripTest (AU.listArray (1,500) ['a'..] :: UArray Int Char)
    47 25 
         roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word)
    48 26 
         roundtripTestByteArray (AU.listArray (1,500) [1..] :: UArray Int Word16)

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