summaryrefslogtreecommitdiff
path: root/testsuite/tests/ffi
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-12-03 18:54:54 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-03-03 08:12:29 -0500
commitd8dc0f96237fe6fe7081c04727c7c2573477e5cb (patch)
treedbc4e8d25cf5a085e979df98bacad5999bf78aee /testsuite/tests/ffi
parenteea96042f1e8682605ae68db10f2bcdd7dab923e (diff)
downloadhaskell-d8dc0f96237fe6fe7081c04727c7c2573477e5cb.tar.gz
Fix array and cleanup conversion primops (#19026)
The first change makes the array ones use the proper fixed-size types, which also means that just like before, they can be used without explicit conversions with the boxed sized types. (Before, it was Int# / Word# on both sides, now it is fixed sized on both sides). For the second change, don't use "extend" or "narrow" in some of the user-facing primops names for conversions. - Names like `narrowInt32#` are misleading when `Int` is 32-bits. - Names like `extendInt64#` are flat-out wrong when `Int is 32-bits. - `narrow{Int,Word}<N>#` however map a type to itself, and so don't suffer from this problem. They are left as-is. These changes are batched together because Alex happend to use the array ops. We can only use released versions of Alex at this time, sadly, and I don't want to have to have a release thatwon't work for the final GHC 9.2. So by combining these we get all the changes for Alex done at once. Bump hackage state in a few places, and also make that workflow slightly easier for the future. Bump minimum Alex version Bump Cabal, array, bytestring, containers, text, and binary submodules
Diffstat (limited to 'testsuite/tests/ffi')
-rw-r--r--testsuite/tests/ffi/should_run/PrimFFIInt16.hs22
-rw-r--r--testsuite/tests/ffi/should_run/PrimFFIInt32.hs22
-rw-r--r--testsuite/tests/ffi/should_run/PrimFFIInt8.hs22
-rw-r--r--testsuite/tests/ffi/should_run/PrimFFIWord16.hs22
-rw-r--r--testsuite/tests/ffi/should_run/PrimFFIWord32.hs22
-rw-r--r--testsuite/tests/ffi/should_run/PrimFFIWord8.hs22
-rw-r--r--testsuite/tests/ffi/should_run/T16650a.hs5
-rw-r--r--testsuite/tests/ffi/should_run/T16650b.hs5
-rw-r--r--testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs5
9 files changed, 75 insertions, 72 deletions
diff --git a/testsuite/tests/ffi/should_run/PrimFFIInt16.hs b/testsuite/tests/ffi/should_run/PrimFFIInt16.hs
index 6d4eae328f..7d7737e592 100644
--- a/testsuite/tests/ffi/should_run/PrimFFIInt16.hs
+++ b/testsuite/tests/ffi/should_run/PrimFFIInt16.hs
@@ -14,15 +14,15 @@ foreign import ccall "add_all_int16"
main :: IO ()
main = do
- let a = narrowInt16# 0#
- b = narrowInt16# 1#
- c = narrowInt16# 2#
- d = narrowInt16# 3#
- e = narrowInt16# 4#
- f = narrowInt16# 5#
- g = narrowInt16# 6#
- h = narrowInt16# 7#
- i = narrowInt16# 8#
- j = narrowInt16# 9#
- x = I# (extendInt16# (add_all_int16 a b c d e f g h i j))
+ let a = intToInt16# 0#
+ b = intToInt16# 1#
+ c = intToInt16# 2#
+ d = intToInt16# 3#
+ e = intToInt16# 4#
+ f = intToInt16# 5#
+ g = intToInt16# 6#
+ h = intToInt16# 7#
+ i = intToInt16# 8#
+ j = intToInt16# 9#
+ x = I# (int16ToInt# (add_all_int16 a b c d e f g h i j))
print x
diff --git a/testsuite/tests/ffi/should_run/PrimFFIInt32.hs b/testsuite/tests/ffi/should_run/PrimFFIInt32.hs
index 511e3cec10..7ece989ea2 100644
--- a/testsuite/tests/ffi/should_run/PrimFFIInt32.hs
+++ b/testsuite/tests/ffi/should_run/PrimFFIInt32.hs
@@ -14,15 +14,15 @@ foreign import ccall "add_all_int32"
main :: IO ()
main = do
- let a = narrowInt32# 0#
- b = narrowInt32# 1#
- c = narrowInt32# 2#
- d = narrowInt32# 3#
- e = narrowInt32# 4#
- f = narrowInt32# 5#
- g = narrowInt32# 6#
- h = narrowInt32# 7#
- i = narrowInt32# 8#
- j = narrowInt32# 9#
- x = I# (extendInt32# (add_all_int32 a b c d e f g h i j))
+ let a = intToInt32# 0#
+ b = intToInt32# 1#
+ c = intToInt32# 2#
+ d = intToInt32# 3#
+ e = intToInt32# 4#
+ f = intToInt32# 5#
+ g = intToInt32# 6#
+ h = intToInt32# 7#
+ i = intToInt32# 8#
+ j = intToInt32# 9#
+ x = I# (int32ToInt# (add_all_int32 a b c d e f g h i j))
print x
diff --git a/testsuite/tests/ffi/should_run/PrimFFIInt8.hs b/testsuite/tests/ffi/should_run/PrimFFIInt8.hs
index 4124e074aa..f0ce283388 100644
--- a/testsuite/tests/ffi/should_run/PrimFFIInt8.hs
+++ b/testsuite/tests/ffi/should_run/PrimFFIInt8.hs
@@ -14,15 +14,15 @@ foreign import ccall "add_all_int8"
main :: IO ()
main = do
- let a = narrowInt8# 0#
- b = narrowInt8# 1#
- c = narrowInt8# 2#
- d = narrowInt8# 3#
- e = narrowInt8# 4#
- f = narrowInt8# 5#
- g = narrowInt8# 6#
- h = narrowInt8# 7#
- i = narrowInt8# 8#
- j = narrowInt8# 9#
- x = I# (extendInt8# (add_all_int8 a b c d e f g h i j))
+ let a = intToInt8# 0#
+ b = intToInt8# 1#
+ c = intToInt8# 2#
+ d = intToInt8# 3#
+ e = intToInt8# 4#
+ f = intToInt8# 5#
+ g = intToInt8# 6#
+ h = intToInt8# 7#
+ i = intToInt8# 8#
+ j = intToInt8# 9#
+ x = I# (int8ToInt# (add_all_int8 a b c d e f g h i j))
print x
diff --git a/testsuite/tests/ffi/should_run/PrimFFIWord16.hs b/testsuite/tests/ffi/should_run/PrimFFIWord16.hs
index 0d801433cf..30f4e2f8d8 100644
--- a/testsuite/tests/ffi/should_run/PrimFFIWord16.hs
+++ b/testsuite/tests/ffi/should_run/PrimFFIWord16.hs
@@ -14,15 +14,15 @@ foreign import ccall "add_all_word16"
main :: IO ()
main = do
- let a = narrowWord16# 0##
- b = narrowWord16# 1##
- c = narrowWord16# 2##
- d = narrowWord16# 3##
- e = narrowWord16# 4##
- f = narrowWord16# 5##
- g = narrowWord16# 6##
- h = narrowWord16# 7##
- i = narrowWord16# 8##
- j = narrowWord16# 9##
- x = W# (extendWord16# (add_all_word16 a b c d e f g h i j))
+ let a = wordToWord16# 0##
+ b = wordToWord16# 1##
+ c = wordToWord16# 2##
+ d = wordToWord16# 3##
+ e = wordToWord16# 4##
+ f = wordToWord16# 5##
+ g = wordToWord16# 6##
+ h = wordToWord16# 7##
+ i = wordToWord16# 8##
+ j = wordToWord16# 9##
+ x = W# (word16ToWord# (add_all_word16 a b c d e f g h i j))
print x
diff --git a/testsuite/tests/ffi/should_run/PrimFFIWord32.hs b/testsuite/tests/ffi/should_run/PrimFFIWord32.hs
index 996bae1b61..b20702cd2b 100644
--- a/testsuite/tests/ffi/should_run/PrimFFIWord32.hs
+++ b/testsuite/tests/ffi/should_run/PrimFFIWord32.hs
@@ -14,15 +14,15 @@ foreign import ccall "add_all_word32"
main :: IO ()
main = do
- let a = narrowWord32# 0##
- b = narrowWord32# 1##
- c = narrowWord32# 2##
- d = narrowWord32# 3##
- e = narrowWord32# 4##
- f = narrowWord32# 5##
- g = narrowWord32# 6##
- h = narrowWord32# 7##
- i = narrowWord32# 8##
- j = narrowWord32# 9##
- x = W# (extendWord32# (add_all_word32 a b c d e f g h i j))
+ let a = wordToWord32# 0##
+ b = wordToWord32# 1##
+ c = wordToWord32# 2##
+ d = wordToWord32# 3##
+ e = wordToWord32# 4##
+ f = wordToWord32# 5##
+ g = wordToWord32# 6##
+ h = wordToWord32# 7##
+ i = wordToWord32# 8##
+ j = wordToWord32# 9##
+ x = W# (word32ToWord# (add_all_word32 a b c d e f g h i j))
print x
diff --git a/testsuite/tests/ffi/should_run/PrimFFIWord8.hs b/testsuite/tests/ffi/should_run/PrimFFIWord8.hs
index 87e46636d1..bf8717ec7f 100644
--- a/testsuite/tests/ffi/should_run/PrimFFIWord8.hs
+++ b/testsuite/tests/ffi/should_run/PrimFFIWord8.hs
@@ -14,15 +14,15 @@ foreign import ccall "add_all_word8"
main :: IO ()
main = do
- let a = narrowWord8# 0##
- b = narrowWord8# 1##
- c = narrowWord8# 2##
- d = narrowWord8# 3##
- e = narrowWord8# 4##
- f = narrowWord8# 5##
- g = narrowWord8# 6##
- h = narrowWord8# 7##
- i = narrowWord8# 8##
- j = narrowWord8# 9##
- x = W# (extendWord8# (add_all_word8 a b c d e f g h i j))
+ let a = wordToWord8# 0##
+ b = wordToWord8# 1##
+ c = wordToWord8# 2##
+ d = wordToWord8# 3##
+ e = wordToWord8# 4##
+ f = wordToWord8# 5##
+ g = wordToWord8# 6##
+ h = wordToWord8# 7##
+ i = wordToWord8# 8##
+ j = wordToWord8# 9##
+ x = W# (word8ToWord# (add_all_word8 a b c d e f g h i j))
print x
diff --git a/testsuite/tests/ffi/should_run/T16650a.hs b/testsuite/tests/ffi/should_run/T16650a.hs
index 6a43a55118..3424a2c4f2 100644
--- a/testsuite/tests/ffi/should_run/T16650a.hs
+++ b/testsuite/tests/ffi/should_run/T16650a.hs
@@ -38,10 +38,11 @@ box (MutableByteArray x) = Box (unsafeCoerce# x)
luckySingleton :: IO MutableByteArray
luckySingleton = IO $ \s0 -> case newByteArray# 1# s0 of
- (# s1, marr# #) -> case writeWord8Array# marr# 0# 42## s1 of
+ (# s1, marr# #) -> case writeWord8Array# marr# 0# fortyTwo s1 of
s2 -> (# s2, MutableByteArray marr# #)
+ where W8# fortyTwo = 42
readByteArray :: MutableByteArray -> Int -> IO Word8
readByteArray (MutableByteArray b#) (I# i#) = IO $ \s0 ->
case readWord8Array# b# i# s0 of
- (# s1, w #) -> (# s1, W8# (narrowWord8# w) #)
+ (# s1, w #) -> (# s1, W8# w #)
diff --git a/testsuite/tests/ffi/should_run/T16650b.hs b/testsuite/tests/ffi/should_run/T16650b.hs
index ba0d4a72a0..06ffcb1d5e 100644
--- a/testsuite/tests/ffi/should_run/T16650b.hs
+++ b/testsuite/tests/ffi/should_run/T16650b.hs
@@ -47,13 +47,14 @@ box (MutableByteArrays x) = Box (unsafeCoerce# x)
luckySingleton :: IO MutableByteArray
luckySingleton = IO $ \s0 -> case newByteArray# 1# s0 of
- (# s1, marr# #) -> case writeWord8Array# marr# 0# 42## s1 of
+ (# s1, marr# #) -> case writeWord8Array# marr# 0# fortyTwo s1 of
s2 -> (# s2, MutableByteArray marr# #)
+ where W8# fortyTwo = 42
readByteArray :: MutableByteArray -> Int -> IO Word8
readByteArray (MutableByteArray b#) (I# i#) = IO $ \s0 ->
case readWord8Array# b# i# s0 of
- (# s1, w #) -> (# s1, W8# (narrowWord8# w) #)
+ (# s1, w #) -> (# s1, W8# w #)
-- Write a mutable byte array to the array of mutable byte arrays
-- at the given index.
diff --git a/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs b/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs
index 8953e9b02d..02a2c55c91 100644
--- a/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs
+++ b/testsuite/tests/ffi/should_run/UnliftedNewtypesByteArrayOffset.hs
@@ -35,11 +35,12 @@ main = do
readByteArray :: MutableByteArray -> Int -> IO Word8
readByteArray (MutableByteArray b#) (I# i#) = IO $ \s0 ->
case readWord8Array# b# i# s0 of
- (# s1, w #) -> (# s1, W8# (narrowWord8# w) #)
+ (# s1, w #) -> (# s1, W8# w #)
-- Create a new mutable byte array of length 1 with the sole byte
-- set to the 105.
luckySingleton :: IO MutableByteArray
luckySingleton = IO $ \s0 -> case newByteArray# 1# s0 of
- (# s1, marr# #) -> case writeWord8Array# marr# 0# 105## s1 of
+ (# s1, marr# #) -> case writeWord8Array# marr# 0# lit105 s1 of
s2 -> (# s2, MutableByteArray marr# #)
+ where W8# lit105 = 105