[commit: testsuite] master: Add testcase for #8138 (ea96a0f)

git at git.haskell.org git at git.haskell.org
Fri Aug 16 21:24:53 CEST 2013


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/ea96a0fcb5c756f5c2c77f8bc651b3345ca6d09f/testsuite

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

commit ea96a0fcb5c756f5c2c77f8bc651b3345ca6d09f
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Fri Aug 16 13:32:44 2013 -0400

    Add testcase for #8138


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

ea96a0fcb5c756f5c2c77f8bc651b3345ca6d09f
 tests/deriving/should_compile/T8138.hs |   48 ++++++++++++++++++++++++++++++++
 tests/deriving/should_compile/all.T    |    1 +
 2 files changed, 49 insertions(+)

diff --git a/tests/deriving/should_compile/T8138.hs b/tests/deriving/should_compile/T8138.hs
new file mode 100644
index 0000000..2e7e47b
--- /dev/null
+++ b/tests/deriving/should_compile/T8138.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Main where
+
+import Control.Monad.ST
+import Data.Primitive
+
+main :: IO ()
+main = do
+    let xs :: [Float] = runST $ do
+        barr <- mutableByteArrayFromList [1..fromIntegral n::Float]
+        peekByteArray n barr
+    print xs
+  where
+    n = 13
+
+mutableByteArrayFromList :: forall s a . (Prim a)
+                         => [a]
+                         -> ST s (MutableByteArray s)
+mutableByteArrayFromList xs = do
+    arr <- newByteArray (length xs*sizeOf (undefined :: a))
+    loop arr 0 xs
+    return arr
+  where
+    loop :: (Prim a) => MutableByteArray s -> Int -> [a] -> ST s ()
+    loop _ _ [] = return ()
+
+    loop arr i (x : xs) = do
+        writeByteArray arr i x
+        loop arr (i+1) xs
+
+peekByteArray :: (Prim a)
+              => Int
+              -> MutableByteArray s
+              -> ST s [a]
+peekByteArray n arr =
+    loop 0 arr
+  where
+    loop :: (Prim a)
+         => Int
+         -> MutableByteArray s
+         -> ST s [a]
+    loop i _ | i >= n = return []
+
+    loop i arr = do
+        x  <- readByteArray arr i
+        xs <- loop (i+1) arr
+        return (x : xs)
diff --git a/tests/deriving/should_compile/all.T b/tests/deriving/should_compile/all.T
index e8fa8fe..bae74bf 100644
--- a/tests/deriving/should_compile/all.T
+++ b/tests/deriving/should_compile/all.T
@@ -46,3 +46,4 @@ test('Roles2', only_ways('normal'), compile, ['-ddump-tc'])
 test('Roles3', only_ways('normal'), compile, ['-ddump-tc'])
 test('Roles4', only_ways('normal'), compile, ['-ddump-tc'])
 test('Roles13', only_ways('normal'), compile, ['-ddump-simpl -dsuppress-uniques'])
+test('T8138', normal, compile, ['-O2'])
\ No newline at end of file





More information about the ghc-commits mailing list