diff options
| -rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 53 | ||||
| -rw-r--r-- | compiler/prelude/primops.txt.pp | 210 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/T4442.hs | 257 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/T4442.stdout | 21 | ||||
| -rw-r--r-- | testsuite/tests/primops/should_run/all.T | 3 |
5 files changed, 543 insertions, 1 deletions
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index b5cd267c6b..809dc55a58 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-} +-- emitPrimOp is quite large +{-# OPTIONS_GHC -fmax-pmcheck-iterations=4000000 #-} ---------------------------------------------------------------------------- -- @@ -519,6 +521,40 @@ emitPrimOp dflags res ReadByteArrayOp_Word16 args = doIndexByteArrayOp emitPrimOp dflags res ReadByteArrayOp_Word32 args = doIndexByteArrayOp (Just (mo_u_32ToWord dflags)) b32 res args emitPrimOp _ res ReadByteArrayOp_Word64 args = doIndexByteArrayOp Nothing b64 res args +-- IndexWord8ArrayAsXXX + +emitPrimOp dflags res IndexByteArrayOp_Word8AsChar args = doIndexByteArrayOpAs (Just (mo_u_8ToWord dflags)) b8 b8 res args +emitPrimOp dflags res IndexByteArrayOp_Word8AsWideChar args = doIndexByteArrayOpAs (Just (mo_u_32ToWord dflags)) b32 b8 res args +emitPrimOp dflags res IndexByteArrayOp_Word8AsInt args = doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args +emitPrimOp dflags res IndexByteArrayOp_Word8AsWord args = doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args +emitPrimOp dflags res IndexByteArrayOp_Word8AsAddr args = doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args +emitPrimOp _ res IndexByteArrayOp_Word8AsFloat args = doIndexByteArrayOpAs Nothing f32 b8 res args +emitPrimOp _ res IndexByteArrayOp_Word8AsDouble args = doIndexByteArrayOpAs Nothing f64 b8 res args +emitPrimOp dflags res IndexByteArrayOp_Word8AsStablePtr args = doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args +emitPrimOp dflags res IndexByteArrayOp_Word8AsInt16 args = doIndexByteArrayOpAs (Just (mo_s_16ToWord dflags)) b16 b8 res args +emitPrimOp dflags res IndexByteArrayOp_Word8AsInt32 args = doIndexByteArrayOpAs (Just (mo_s_32ToWord dflags)) b32 b8 res args +emitPrimOp _ res IndexByteArrayOp_Word8AsInt64 args = doIndexByteArrayOpAs Nothing b64 b8 res args +emitPrimOp dflags res IndexByteArrayOp_Word8AsWord16 args = doIndexByteArrayOpAs (Just (mo_u_16ToWord dflags)) b16 b8 res args +emitPrimOp dflags res IndexByteArrayOp_Word8AsWord32 args = doIndexByteArrayOpAs (Just (mo_u_32ToWord dflags)) b32 b8 res args +emitPrimOp _ res IndexByteArrayOp_Word8AsWord64 args = doIndexByteArrayOpAs Nothing b64 b8 res args + +-- ReadInt8ArrayAsXXX, identical to IndexInt8ArrayAsXXX + +emitPrimOp dflags res ReadByteArrayOp_Word8AsChar args = doIndexByteArrayOpAs (Just (mo_u_8ToWord dflags)) b8 b8 res args +emitPrimOp dflags res ReadByteArrayOp_Word8AsWideChar args = doIndexByteArrayOpAs (Just (mo_u_32ToWord dflags)) b32 b8 res args +emitPrimOp dflags res ReadByteArrayOp_Word8AsInt args = doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args +emitPrimOp dflags res ReadByteArrayOp_Word8AsWord args = doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args +emitPrimOp dflags res ReadByteArrayOp_Word8AsAddr args = doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args +emitPrimOp _ res ReadByteArrayOp_Word8AsFloat args = doIndexByteArrayOpAs Nothing f32 b8 res args +emitPrimOp _ res ReadByteArrayOp_Word8AsDouble args = doIndexByteArrayOpAs Nothing f64 b8 res args +emitPrimOp dflags res ReadByteArrayOp_Word8AsStablePtr args = doIndexByteArrayOpAs Nothing (bWord dflags) b8 res args +emitPrimOp dflags res ReadByteArrayOp_Word8AsInt16 args = doIndexByteArrayOpAs (Just (mo_s_16ToWord dflags)) b16 b8 res args +emitPrimOp dflags res ReadByteArrayOp_Word8AsInt32 args = doIndexByteArrayOpAs (Just (mo_s_32ToWord dflags)) b32 b8 res args +emitPrimOp _ res ReadByteArrayOp_Word8AsInt64 args = doIndexByteArrayOpAs Nothing b64 b8 res args +emitPrimOp dflags res ReadByteArrayOp_Word8AsWord16 args = doIndexByteArrayOpAs (Just (mo_u_16ToWord dflags)) b16 b8 res args +emitPrimOp dflags res ReadByteArrayOp_Word8AsWord32 args = doIndexByteArrayOpAs (Just (mo_u_32ToWord dflags)) b32 b8 res args +emitPrimOp _ res ReadByteArrayOp_Word8AsWord64 args = doIndexByteArrayOpAs Nothing b64 b8 res args + -- WriteXXXoffAddr emitPrimOp dflags res WriteOffAddrOp_Char args = doWriteOffAddrOp (Just (mo_WordTo8 dflags)) b8 res args @@ -557,6 +593,23 @@ emitPrimOp dflags res WriteByteArrayOp_Word16 args = doWriteByteArrayO emitPrimOp dflags res WriteByteArrayOp_Word32 args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b32 res args emitPrimOp _ res WriteByteArrayOp_Word64 args = doWriteByteArrayOp Nothing b64 res args +-- WriteInt8ArrayAsXXX + +emitPrimOp dflags res WriteByteArrayOp_Word8AsChar args = doWriteByteArrayOp (Just (mo_WordTo8 dflags)) b8 res args +emitPrimOp dflags res WriteByteArrayOp_Word8AsWideChar args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b8 res args +emitPrimOp _ res WriteByteArrayOp_Word8AsInt args = doWriteByteArrayOp Nothing b8 res args +emitPrimOp _ res WriteByteArrayOp_Word8AsWord args = doWriteByteArrayOp Nothing b8 res args +emitPrimOp _ res WriteByteArrayOp_Word8AsAddr args = doWriteByteArrayOp Nothing b8 res args +emitPrimOp _ res WriteByteArrayOp_Word8AsFloat args = doWriteByteArrayOp Nothing b8 res args +emitPrimOp _ res WriteByteArrayOp_Word8AsDouble args = doWriteByteArrayOp Nothing b8 res args +emitPrimOp _ res WriteByteArrayOp_Word8AsStablePtr args = doWriteByteArrayOp Nothing b8 res args +emitPrimOp dflags res WriteByteArrayOp_Word8AsInt16 args = doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b8 res args +emitPrimOp dflags res WriteByteArrayOp_Word8AsInt32 args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b8 res args +emitPrimOp _ res WriteByteArrayOp_Word8AsInt64 args = doWriteByteArrayOp Nothing b8 res args +emitPrimOp dflags res WriteByteArrayOp_Word8AsWord16 args = doWriteByteArrayOp (Just (mo_WordTo16 dflags)) b8 res args +emitPrimOp dflags res WriteByteArrayOp_Word8AsWord32 args = doWriteByteArrayOp (Just (mo_WordTo32 dflags)) b8 res args +emitPrimOp _ res WriteByteArrayOp_Word8AsWord64 args = doWriteByteArrayOp Nothing b8 res args + -- Copying and setting byte arrays emitPrimOp _ [] CopyByteArrayOp [src,src_off,dst,dst_off,n] = doCopyByteArrayOp src src_off dst dst_off n diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp index 996e0bb3e8..1362704074 100644 --- a/compiler/prelude/primops.txt.pp +++ b/compiler/prelude/primops.txt.pp @@ -1254,6 +1254,76 @@ primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp {Read 64-bit word; offset in 64-bit words.} with can_fail = True +primop IndexByteArrayOp_Word8AsChar "indexWord8ArrayAsChar#" GenPrimOp + ByteArray# -> Int# -> Char# + {Read 8-bit character; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsWideChar "indexWord8ArrayAsWideChar#" GenPrimOp + ByteArray# -> Int# -> Char# + {Read 31-bit character; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsAddr "indexWord8ArrayAsAddr#" GenPrimOp + ByteArray# -> Int# -> Addr# + {Read address; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsFloat "indexWord8ArrayAsFloat#" GenPrimOp + ByteArray# -> Int# -> Float# + {Read float; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsDouble "indexWord8ArrayAsDouble#" GenPrimOp + ByteArray# -> Int# -> Double# + {Read double; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsStablePtr "indexWord8ArrayAsStablePtr#" GenPrimOp + ByteArray# -> Int# -> StablePtr# a + {Read stable pointer; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsInt16 "indexWord8ArrayAsInt16#" GenPrimOp + ByteArray# -> Int# -> Int# + {Read 16-bit int; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsInt32 "indexWord8ArrayAsInt32#" GenPrimOp + ByteArray# -> Int# -> INT32 + {Read 32-bit int; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsInt64 "indexWord8ArrayAsInt64#" GenPrimOp + ByteArray# -> Int# -> INT64 + {Read 64-bit int; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsInt "indexWord8ArrayAsInt#" GenPrimOp + ByteArray# -> Int# -> Int# + {Read int; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsWord16 "indexWord8ArrayAsWord16#" GenPrimOp + ByteArray# -> Int# -> Word# + {Read 16-bit word; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsWord32 "indexWord8ArrayAsWord32#" GenPrimOp + ByteArray# -> Int# -> WORD32 + {Read 32-bit word; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsWord64 "indexWord8ArrayAsWord64#" GenPrimOp + ByteArray# -> Int# -> WORD64 + {Read 64-bit word; offset in bytes.} + with can_fail = True + +primop IndexByteArrayOp_Word8AsWord "indexWord8ArrayAsWord#" GenPrimOp + ByteArray# -> Int# -> Word# + {Read word; offset in bytes.} + with can_fail = True + primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) {Read 8-bit character; offset in bytes.} @@ -1338,6 +1408,76 @@ primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp with has_side_effects = True can_fail = True +primop ReadByteArrayOp_Word8AsChar "readWord8ArrayAsChar#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsWideChar "readWord8ArrayAsWideChar#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsAddr "readWord8ArrayAsAddr#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsFloat "readWord8ArrayAsFloat#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsDouble "readWord8ArrayAsDouble#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsStablePtr "readWord8ArrayAsStablePtr#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, StablePtr# a #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsInt16 "readWord8ArrayAsInt16#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsInt32 "readWord8ArrayAsInt32#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, INT32 #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsInt64 "readWord8ArrayAsInt64#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, INT64 #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsInt "readWord8ArrayAsInt#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsWord16 "readWord8ArrayAsWord16#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsWord32 "readWord8ArrayAsWord32#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, WORD32 #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsWord64 "readWord8ArrayAsWord64#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, WORD64 #) + with has_side_effects = True + can_fail = True + +primop ReadByteArrayOp_Word8AsWord "readWord8ArrayAsWord#" GenPrimOp + MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #) + with has_side_effects = True + can_fail = True + primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp MutableByteArray# s -> Int# -> Char# -> State# s -> State# s {Write 8-bit character; offset in bytes.} @@ -1420,6 +1560,76 @@ primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp with has_side_effects = True can_fail = True +primop WriteByteArrayOp_Word8AsChar "writeWord8ArrayAsChar#" GenPrimOp + MutableByteArray# s -> Int# -> Char# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsWideChar "writeWord8ArrayAsWideChar#" GenPrimOp + MutableByteArray# s -> Int# -> Char# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsAddr "writeWord8ArrayAsAddr#" GenPrimOp + MutableByteArray# s -> Int# -> Addr# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsFloat "writeWord8ArrayAsFloat#" GenPrimOp + MutableByteArray# s -> Int# -> Float# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsDouble "writeWord8ArrayAsDouble#" GenPrimOp + MutableByteArray# s -> Int# -> Double# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsStablePtr "writeWord8ArrayAsStablePtr#" GenPrimOp + MutableByteArray# s -> Int# -> StablePtr# a -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsInt16 "writeWord8ArrayAsInt16#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsInt32 "writeWord8ArrayAsInt32#" GenPrimOp + MutableByteArray# s -> Int# -> INT32 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsInt64 "writeWord8ArrayAsInt64#" GenPrimOp + MutableByteArray# s -> Int# -> INT64 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsInt "writeWord8ArrayAsInt#" GenPrimOp + MutableByteArray# s -> Int# -> Int# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsWord16 "writeWord8ArrayAsWord16#" GenPrimOp + MutableByteArray# s -> Int# -> Word# -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsWord32 "writeWord8ArrayAsWord32#" GenPrimOp + MutableByteArray# s -> Int# -> WORD32 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsWord64 "writeWord8ArrayAsWord64#" GenPrimOp + MutableByteArray# s -> Int# -> WORD64 -> State# s -> State# s + with has_side_effects = True + can_fail = True + +primop WriteByteArrayOp_Word8AsWord "writeWord8ArrayAsWord#" GenPrimOp + MutableByteArray# s -> Int# -> Word# -> State# s -> State# s + with has_side_effects = True + can_fail = True + primop CompareByteArraysOp "compareByteArrays#" GenPrimOp ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int# {{\tt compareByteArrays# src1 src1_ofs src2 src2_ofs n} compares diff --git a/testsuite/tests/primops/should_run/T4442.hs b/testsuite/tests/primops/should_run/T4442.hs new file mode 100644 index 0000000000..76320e4ef5 --- /dev/null +++ b/testsuite/tests/primops/should_run/T4442.hs @@ -0,0 +1,257 @@ +{-# LANGUAGE MagicHash, UnboxedTuples, CPP #-} +module Main where + +#include "MachDeps.h" + +import GHC.Ptr(Ptr(..), nullPtr, plusPtr, minusPtr) +import GHC.Stable( + StablePtr(..), castStablePtrToPtr, castPtrToStablePtr, newStablePtr) +import GHC.Exts +import Data.Char(ord) + +assertEqual :: (Show a, Eq a) => a -> a -> IO () +assertEqual a b + | a /= b = putStrLn (show a ++ " /= " ++ show b) + | otherwise = return () + +readBytes :: MutableByteArray# s -> State# s -> Int# -> (# State# s, [Int] #) +readBytes marr s0 len = go s0 len [] + where + go s 0# bs = (# s, bs #) + go s i bs = case readWord8Array# marr (i -# 1#) s of + (# s', b #) -> go s' (i -# 1#) (I# (word2Int# b):bs) + +indexBytes :: ByteArray# -> Int# -> [Int] +indexBytes arr len = + [I# (word2Int# (indexWord8Array# arr i)) | I# i <- [0..I# len - 1]] + +fillByteArray :: MutableByteArray# s -> Int# -> Int -> State# s -> State# s +fillByteArray arr len (I# a) = go len + where + go 0# s = s + go i s = go (i -# 1#) (writeInt8Array# arr (i -# 1#) a s) + +test :: (Eq a, Show a) + => String + -> (ByteArray# -> Int# -> a) + -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld + -> (# State# RealWorld, a #)) + -> (MutableByteArray# RealWorld -> Int# -> a -> State# RealWorld + -> State# RealWorld) + -> a + -> [Int] + -> Int + -> IO () +test name index read write val valBytes len = do + putStrLn name + mapM_ testAtOffset [0..16] + where + arrLen :: Int# + arrLen = 24# + + fillerByte :: Int + fillerByte = 0x34 + + expectedArrayBytes :: Int -> [Int] + expectedArrayBytes offset = + replicate offset fillerByte + ++ valBytes + ++ replicate (I# arrLen - len - offset) fillerByte + + testAtOffset :: Int -> IO () + testAtOffset offset@(I# offset#) = runRW# (\s0 -> let + (# s1, marr #) = newByteArray# arrLen s0 + s2 = fillByteArray marr arrLen fillerByte s1 + s3 = write marr offset# val s2 + (# s4, actual0 #) = read marr offset# s3 + (# s5, actualBytes0 #) = readBytes marr s4 arrLen + (# _, arr #) = unsafeFreezeByteArray# marr s5 + actual1 = index arr offset# + actualBytes1 = indexBytes arr arrLen + in do + assertEqual actual0 val + assertEqual actual1 val + assertEqual actualBytes0 (expectedArrayBytes offset) + assertEqual actualBytes1 (expectedArrayBytes offset) + ) + +intToBytes :: Int -> Int -> [Int] +intToBytes (I# val0) (I# len0) = let + result = go val0 len0 + go v 0# = [] + go v len = + I# (v `andI#` 0xff#) : go (v `uncheckedIShiftRL#` 8#) (len -# 1#) + in +#if defined(WORDS_BIGENDIAN) + reverse result +#else + result +#endif + +testIntArray :: + String + -> (ByteArray# -> Int# -> Int#) + -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld + -> (# State# RealWorld, Int# #)) + -> (MutableByteArray# RealWorld -> Int# -> Int# -> State# RealWorld + -> State# RealWorld) + -> Int + -> Int + -> IO () +testIntArray name0 index read write val0 len = do + doOne (name0 ++ " positive") val0 + doOne (name0 ++ " negative") (negate val0) + where + doOne name val = test + name + (\arr i -> I# (index arr i)) + (\arr i s -> case read arr i s of (# s', a #) -> (# s', I# a #)) + (\arr i (I# a) s -> write arr i a s) + val + (intToBytes val len) + len + +testWordArray :: + String + -> (ByteArray# -> Int# -> Word#) + -> (MutableByteArray# RealWorld -> Int# -> State# RealWorld + -> (# State# RealWorld, Word# #)) + -> (MutableByteArray# RealWorld -> Int# -> Word# -> State# RealWorld + -> State# RealWorld) + -> Word + -> Int + -> IO () +testWordArray name index read write val len = test + name + (\arr i -> W# (index arr i)) + (\arr i s -> case read arr i s of (# s', a #) -> (# s', W# a #)) + (\arr i (W# a) s -> write arr i a s) + val + (intToBytes (fromIntegral val) len) + len + +wordSizeInBytes :: Int +wordSizeInBytes = WORD_SIZE_IN_BITS `div` 8 + +int :: Int +int + | WORD_SIZE_IN_BITS == 32 = 12345678 + | otherwise = 1234567890123 + +word :: Word +word = fromIntegral int + +float :: Float +float = 123.456789 + +-- Test pattern generated by this python code: +-- >>> import struct +-- >>> import binascii +-- >>> binascii.hexlify(struct.pack('>f', 123.456789)) +floatBytes :: Int +floatBytes = 0x42f6e9e0 + +double :: Double +double = 123.45678901234 + +-- Test pattern generated by this python code: +-- >>> import struct +-- >>> import binascii +-- >>> binascii.hexlify(struct.pack('>d', 123.45678901234)) +doubleBytes :: Int +doubleBytes = 0x405edd3c07fb4b09 + +main :: IO () +main = do + testIntArray "Int8#" + indexInt8Array# readInt8Array# writeInt8Array# + 123 1 + testIntArray "Int16#" + indexWord8ArrayAsInt16# readWord8ArrayAsInt16# writeWord8ArrayAsInt16# + 12345 2 + testIntArray "Int32#" + indexWord8ArrayAsInt32# readWord8ArrayAsInt32# writeWord8ArrayAsInt32# + 12345678 4 + testIntArray "Int64#" + indexWord8ArrayAsInt64# readWord8ArrayAsInt64# writeWord8ArrayAsInt64# + 1234567890123 8 + testIntArray "Int#" + indexWord8ArrayAsInt# readWord8ArrayAsInt# writeWord8ArrayAsInt# + int wordSizeInBytes + + testWordArray "Word8#" + indexWord8Array# readWord8Array# writeWord8Array# + 123 1 + testWordArray "Word16#" + indexWord8ArrayAsWord16# readWord8ArrayAsWord16# writeWord8ArrayAsWord16# + 12345 2 + testWordArray "Word32#" + indexWord8ArrayAsWord32# readWord8ArrayAsWord32# writeWord8ArrayAsWord32# + 12345678 4 + testWordArray "Word64#" + indexWord8ArrayAsWord64# readWord8ArrayAsWord64# writeWord8ArrayAsWord64# + 1234567890123 8 + testWordArray "Word#" + indexWord8ArrayAsWord# readWord8ArrayAsWord# writeWord8ArrayAsWord# + word wordSizeInBytes + + test + "Char#" + (\arr i -> C# (indexWord8ArrayAsChar# arr i)) + (\arr i s -> + case readWord8ArrayAsChar# arr i s of (# s', a #) -> (# s', C# a #)) + (\arr i (C# a) s -> writeWord8ArrayAsChar# arr i a s) + 'z' + [ord 'z'] + 1 + test + "WideChar#" + (\arr i -> C# (indexWord8ArrayAsWideChar# arr i)) + (\arr i s -> + case readWord8ArrayAsWideChar# arr i s of (# s', a #) -> (# s', C# a #)) + (\arr i (C# a) s -> writeWord8ArrayAsWideChar# arr i a s) + '𠜎' -- See http://www.i18nguy.com/unicode/supplementary-test.html + (intToBytes (ord '𠜎') 4) + 4 + test + "Addr#" + (\arr i -> Ptr (indexWord8ArrayAsAddr# arr i)) + (\arr i s -> + case readWord8ArrayAsAddr# arr i s of (# s', a #) -> (# s', Ptr a #)) + (\arr i (Ptr a) s -> writeWord8ArrayAsAddr# arr i a s) + (nullPtr `plusPtr` int) + (intToBytes int wordSizeInBytes) + wordSizeInBytes + + stablePtr <- newStablePtr () + test + "StablePtr#" + (\arr i -> + castStablePtrToPtr (StablePtr (indexWord8ArrayAsStablePtr# arr i))) + (\arr i s -> case readWord8ArrayAsStablePtr# arr i s of + (# s', a #) -> (# s', castStablePtrToPtr (StablePtr a) #)) + (\arr i p s -> case castPtrToStablePtr p of + (StablePtr a) -> writeWord8ArrayAsStablePtr# arr i a s) + (castStablePtrToPtr stablePtr) + (intToBytes (castStablePtrToPtr stablePtr `minusPtr` nullPtr) + wordSizeInBytes) + wordSizeInBytes + + test + "Float#" + (\arr i -> F# (indexWord8ArrayAsFloat# arr i)) + (\arr i s -> + case readWord8ArrayAsFloat# arr i s of (# s', a #) -> (# s', F# a #)) + (\arr i (F# a) s -> writeWord8ArrayAsFloat# arr i a s) + float + (intToBytes floatBytes 4) + 4 + test + "Double#" + (\arr i -> D# (indexWord8ArrayAsDouble# arr i)) + (\arr i s -> + case readWord8ArrayAsDouble# arr i s of (# s', a #) -> (# s', D# a #)) + (\arr i (D# a) s -> writeWord8ArrayAsDouble# arr i a s) + double + (intToBytes doubleBytes 8) + 8 diff --git a/testsuite/tests/primops/should_run/T4442.stdout b/testsuite/tests/primops/should_run/T4442.stdout new file mode 100644 index 0000000000..8c5293d558 --- /dev/null +++ b/testsuite/tests/primops/should_run/T4442.stdout @@ -0,0 +1,21 @@ +Int8# positive +Int8# negative +Int16# positive +Int16# negative +Int32# positive +Int32# negative +Int64# positive +Int64# negative +Int# positive +Int# negative +Word8# +Word16# +Word32# +Word64# +Word# +Char# +WideChar# +Addr# +StablePtr# +Float# +Double#
\ No newline at end of file diff --git a/testsuite/tests/primops/should_run/all.T b/testsuite/tests/primops/should_run/all.T index 30e871ac11..53d875bf8f 100644 --- a/testsuite/tests/primops/should_run/all.T +++ b/testsuite/tests/primops/should_run/all.T @@ -1,7 +1,8 @@ test('T6135', normal, compile_and_run, ['']) test('T7689', normal, compile_and_run, ['']) -# The test is using unboxed tuples, so omit ghci +# 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('T10481', exit_code(1), compile_and_run, ['']) test('T10678', [stats_num_field('bytes allocated', |