[commit: ghc] master: testsuite: Make T4442 compile on i386 and mark as broken (b7deeed)

git at git.haskell.org git at git.haskell.org
Fri Jun 15 17:02:52 UTC 2018


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

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

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

commit b7deeed00d93c306e55572c9c1c09ced4be61eef
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Fri Jun 15 12:58:59 2018 -0400

    testsuite: Make T4442 compile on i386 and mark as broken
    
    There are some rather suspicious failures in the 64-bit case. See #15184 for
    details.


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

b7deeed00d93c306e55572c9c1c09ced4be61eef
 testsuite/tests/primops/should_run/T4442.hs | 33 +++++++++++++++++++++++++----
 testsuite/tests/primops/should_run/all.T    |  4 +++-
 2 files changed, 32 insertions(+), 5 deletions(-)

diff --git a/testsuite/tests/primops/should_run/T4442.hs b/testsuite/tests/primops/should_run/T4442.hs
index 40d7879..d9e6500 100644
--- a/testsuite/tests/primops/should_run/T4442.hs
+++ b/testsuite/tests/primops/should_run/T4442.hs
@@ -10,6 +10,7 @@ import GHC.Exts
 import Data.Char(ord)
 #if WORD_SIZE_IN_BITS < 64
 import GHC.Int (Int64(..))
+import GHC.Word (Word64(..))
 #endif
 
 assertEqual :: (Show a, Eq a) => a -> a -> IO ()
@@ -124,20 +125,21 @@ testInt64Array ::
         -> (# State# RealWorld, Int64# #))
   -> (MutableByteArray# RealWorld -> Int# -> Int64# -> State# RealWorld
         -> State# RealWorld)
-  -> Int
+  -> Int64
   -> Int
   -> IO ()
 testInt64Array name0 index read write val0 len = do
   doOne (name0 ++ " positive") val0
   doOne (name0 ++ " negative") (negate val0)
  where
+  doOne :: String -> Int64 -> IO ()
   doOne name val = test
     name
     (\arr i -> I64# (index arr i))
-    (\arr i s -> case read arr i s of (# s', a #) -> (# s', I# a #))
+    (\arr i s -> case read arr i s of (# s', a #) -> (# s', I64# a #))
     (\arr i (I64# a) s -> write arr i a s)
     val
-    (intToBytes val len)
+    (intToBytes (fromIntegral val) len)
     len
 #endif
 
@@ -160,6 +162,29 @@ testWordArray name index read write val len = test
   (intToBytes (fromIntegral val) len)
   len
 
+#if WORD_SIZE_IN_BITS == 64
+testWord64Array = testWordArray
+#else
+testWord64Array ::
+     String
+  -> (ByteArray# -> Int# -> Word64#)
+  -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld
+        -> (# State# RealWorld, Word64# #))
+  -> (MutableByteArray# RealWorld -> Int# -> Word64# -> State# RealWorld
+        -> State# RealWorld)
+  -> Word64
+  -> Int
+  -> IO ()
+testWord64Array name index read write val len = test
+  name
+  (\arr i -> W64# (index arr i))
+  (\arr i s -> case read arr i s of (# s', a #) -> (# s', W64# a #))
+  (\arr i (W64# a) s -> write arr i a s)
+  val
+  (intToBytes (fromIntegral val) len)
+  len
+#endif
+
 wordSizeInBytes :: Int
 wordSizeInBytes = WORD_SIZE_IN_BITS `div` 8
 
@@ -218,7 +243,7 @@ main = do
   testWordArray "Word32#"
     indexWord8ArrayAsWord32# readWord8ArrayAsWord32# writeWord8ArrayAsWord32#
     12345678 4
-  testWordArray "Word64#"
+  testWord64Array "Word64#"
     indexWord8ArrayAsWord64# readWord8ArrayAsWord64# writeWord8ArrayAsWord64#
     1234567890123 8
   testWordArray "Word#"
diff --git a/testsuite/tests/primops/should_run/all.T b/testsuite/tests/primops/should_run/all.T
index 53d875b..742206d 100644
--- a/testsuite/tests/primops/should_run/all.T
+++ b/testsuite/tests/primops/should_run/all.T
@@ -2,7 +2,9 @@ test('T6135', normal, compile_and_run, [''])
 test('T7689', normal, compile_and_run, [''])
 # These tests are using unboxed tuples, so omit ghci
 test('T9430', omit_ways(['ghci']), compile_and_run, [''])
-test('T4442', omit_ways(['ghci']), compile_and_run, [''])
+test('T4442',
+     [omit_ways(['ghci']), when(wordsize(32), expect_broken(15184))],
+     compile_and_run, [''])
 test('T10481', exit_code(1), compile_and_run, [''])
 test('T10678',
      [stats_num_field('bytes allocated',



More information about the ghc-commits mailing list