blob: c2d666049ee4fac9c716ddf59c32dad437ba59b3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
{-# LANGUAGE MagicHash, UnboxedTuples #-}
-- Test allocation of statically sized byte arrays. There's an
-- optimization that targets these and we want to make sure that the
-- code generated in the optimized case is correct.
--
-- The tests proceeds by allocating a bunch of byte arrays of
-- different sizes, to try to provoke GC crashes, which would be a
-- symptom of the optimization not generating correct code.
module Main where
import GHC.Exts
import GHC.IO
main :: IO ()
main = do
loop 1000
putStrLn "success"
where
loop :: Int -> IO ()
loop 0 = return ()
loop i = do
-- Sizes have been picked to match the triggering of the
-- optimization and to match boundary conditions. Sizes are
-- given explicitly as to not rely on other optimizations to
-- make the static size known to the compiler.
newByteArray 0
newByteArray 1
newByteArray 2
newByteArray 3
newByteArray 4
newByteArray 5
newByteArray 6
newByteArray 7
newByteArray 8
newByteArray 9
newByteArray 10
newByteArray 11
newByteArray 12
newByteArray 13
newByteArray 14
newByteArray 15
newByteArray 16
newByteArray 64
newByteArray 128
newByteArray 129
loop (i-1)
newByteArray :: Int -> IO ()
newByteArray (I# sz#) = IO $ \s -> case newByteArray# sz# s of
(# s', _ #) -> (# s', () #)
{-# INLINE newByteArray #-} -- to make sure optimization triggers
|
