[commit: ghc] master: Add test for inline array allocation (22e4bba)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/22e4bba2df99a2c9ad2822b3a7a5ac6de0f805e4/ghc

>---------------------------------------------------------------

commit 22e4bba2df99a2c9ad2822b3a7a5ac6de0f805e4
Author: Johan Tibell <johan.tibell at gmail.com>
Date:   Tue Mar 11 16:01:19 2014 +0100

    Add test for inline array allocation


>---------------------------------------------------------------

22e4bba2df99a2c9ad2822b3a7a5ac6de0f805e4
 .../tests/codeGen/should_run/StaticArraySize.hs    |   87 ++++++++++++++++++++
 .../{T8256.stdout => StaticArraySize.stdout}       |    0
 testsuite/tests/codeGen/should_run/all.T           |    1 +
 3 files changed, 88 insertions(+)

diff --git a/testsuite/tests/codeGen/should_run/StaticArraySize.hs b/testsuite/tests/codeGen/should_run/StaticArraySize.hs
new file mode 100644
index 0000000..1052e2d
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/StaticArraySize.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
+
+-- Test allocation of statically sized 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 arrays of different
+-- sizes and reading elements from them, 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
+import Prelude hiding (read)
+
+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.
+        marr0 <- newArray 0
+        marr1 <- newArray 1
+        marr2 <- newArray 2
+        marr3 <- newArray 3
+        marr4 <- newArray 4
+        marr5 <- newArray 5
+        marr6 <- newArray 6
+        marr7 <- newArray 7
+        marr8 <- newArray 8
+        marr9 <- newArray 9
+        marr10 <- newArray 10
+        marr11 <- newArray 11
+        marr12 <- newArray 12
+        marr13 <- newArray 13
+        marr14 <- newArray 14
+        marr15 <- newArray 15
+        marr16 <- newArray 16
+        marr17 <- newArray 17
+        let marrs = [marr0, marr1, marr2, marr3, marr4, marr5, marr6, marr7,
+                     marr8, marr9, marr10, marr11, marr12, marr13, marr14,
+                     marr15, marr16, marr17]
+        print `fmap` sumManyArrays marrs
+        loop (i-1)
+
+sumManyArrays :: [MArray] -> IO Int
+sumManyArrays = go 0
+  where
+    go !acc [] = return acc
+    go acc (marr:marrs) = do
+        n <- sumArray marr
+        go (acc+n) marrs
+
+sumArray :: MArray -> IO Int
+sumArray marr = go 0 0
+  where
+    go :: Int -> Int -> IO Int
+    go !acc i
+      | i < len = do
+          k <- read marr i
+          go (acc + k) (i+1)
+      | otherwise = return acc
+    len = lengthM marr
+
+data MArray = MArray { unMArray :: !(MutableArray# RealWorld Int) }
+
+newArray :: Int -> IO MArray
+newArray (I# sz#) = IO $ \s -> case newArray# sz# 1 s of
+    (# s', marr #) -> (# s', MArray marr #)
+{-# INLINE newArray #-}  -- to make sure optimization triggers
+
+lengthM :: MArray -> Int
+lengthM marr = I# (sizeofMutableArray# (unMArray marr))
+
+read :: MArray -> Int -> IO Int
+read marr i@(I# i#)
+  | i < 0 || i >= len =
+      error $ "bounds error, offset " ++ show i ++ ", length " ++ show len
+  | otherwise = IO $ \ s -> readArray# (unMArray marr) i# s
+  where len = lengthM marr
diff --git a/testsuite/tests/codeGen/should_run/T8256.stdout b/testsuite/tests/codeGen/should_run/StaticArraySize.stdout
similarity index 100%
copy from testsuite/tests/codeGen/should_run/T8256.stdout
copy to testsuite/tests/codeGen/should_run/StaticArraySize.stdout
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index b1a9fd4..a8b013e 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -116,3 +116,4 @@ test('T8103', only_ways(['normal']), compile_and_run, [''])
 test('T7953', reqlib('random'), compile_and_run, [''])
 test('T8256', reqlib('vector'), compile_and_run, [''])
 test('T6084',normal, compile_and_run, ['-O2'])
+test('StaticArraySize', normal, compile_and_run, ['-O2'])