Andreas Klebinger pushed to branch wip/andreask/arm-ffi at Glasgow Haskell Compiler / GHC Commits: 6892ebce by Andreas Klebinger at 2026-06-25T10:10:20+02:00 Expand CCallConv test On some platforms (e.g. arm64) we have invariants about zeroing the high bits of returned values we want to catch. - - - - - 2 changed files: - testsuite/tests/codeGen/should_run/CCallConv.hs - testsuite/tests/codeGen/should_run/CCallConv_c.c Changes: ===================================== testsuite/tests/codeGen/should_run/CCallConv.hs ===================================== @@ -3,6 +3,7 @@ {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE ExtendedLiterals #-} -- | This test ensures that sub-word signed and unsigned parameters are correctly -- handed over to C functions. I.e. it asserts the calling-convention. @@ -59,6 +60,31 @@ foreign import ccall "fun32" Int32# -> -- s1 Int64# -- result +foreign import ccall "shrink32" + shrink32 :: + Int64# -> -- a0 + Int32# -- result + +foreign import ccall "shrink16" + shrink16 :: + Int64# -> -- a0 + Int16# -- result + +foreign import ccall "shrink8" + shrink8 :: + Int64# -> -- a0 + Int8# -- result + +foreign import ccall "shrink32_16" + shrink32_16 :: + Int32# -> -- a0 + Int16# -- result + +foreign import ccall "shrink32_8" + shrink32_8 :: + Int32# -> -- a0 + Int8# -- result + foreign import ccall "funFloat" funFloat :: Float# -> -- a0 @@ -115,6 +141,42 @@ main = do hFlush stdout assertEqual expected_res32 (I64# res32) + -- Shrinking/zeroing of subword sizes + let input :: Int64# = -1#Int64 + res32 :: Int32# = shrink32 input + expected_res32 :: Int32 = fromIntegral (I64# input) + print $ "fun32 result:" ++ show (I64# res32) + hFlush stdout + assertEqual expected_res32 (I64# res32) + + let input :: Int64# = -1#Int64 + res16 :: Int16# = shrink16 input + expected_res16 :: Int16 = fromIntegral (I64# input) + print $ "shrink16 result:" ++ show (I16# res16) + hFlush stdout + assertEqual expected_res16 (I16# res16) + + let input :: Int64# = -1#Int64 + res8 :: Int8# = shrink8 input + expected_res8 :: Int8 = fromIntegral (I64# input) + print $ "shrink8 result:" ++ show (I8# res8) + hFlush stdout + assertEqual expected_res8 (I8# res8) + + let input32 :: Int32# = -1#Int32 + res16 :: Int16# = shrink32_16 input32 + expected_res16 :: Int16 = fromIntegral (I32# input32) + print $ "shrink32_16 result:" ++ show (I16# res16) + hFlush stdout + assertEqual expected_res16 (I16# res16) + + let input32 :: Int32# = -1#Int32 + res8 :: Int8# = shrink32_8 input32 + expected_res8 :: Int8 = fromIntegral (I32# input32) + print $ "shrink32_8 result:" ++ show (I8# res8) + hFlush stdout + assertEqual expected_res8 (I8# res8) + let resFloat :: Float = F# (funFloat 1.0# 1.1# 1.2# 1.3# 1.4# 1.5# 1.6# 1.7# 1.8# 1.9#) print $ "funFloat result:" ++ show resFloat hFlush stdout ===================================== testsuite/tests/codeGen/should_run/CCallConv_c.c ===================================== @@ -62,6 +62,51 @@ int64_t fun32(int32_t a0, uint32_t a1, int32_t a2, int32_t a3, int32_t a4, s1; } +int32_t shrink32(int64_t a0) { + printf("shrink32:\n"); + printf("a0: %#llx %lld\n", a0, a0); + + fflush(stdout); + + return a0; +} + +int16_t shrink16(int64_t a0) { + printf("shrink16:\n"); + printf("a0: %#llx %lld\n", a0, a0); + + fflush(stdout); + + return a0; +} + +int8_t shrink8(int64_t a0) { + printf("shrink8:\n"); + printf("a0: %#llx %lld\n", a0, a0); + + fflush(stdout); + + return a0; +} + +int16_t shrink32_16(int32_t a0) { + printf("shrink32_16:\n"); + printf("a0: %#llx %lld\n", a0, a0); + + fflush(stdout); + + return a0; +} + +int8_t shrink32_8(int32_t a0) { + printf("shrink32_8:\n"); + printf("a0: %#llx %lld\n", a0, a0); + + fflush(stdout); + + return a0; +} + float funFloat(float a0, float a1, float a2, float a3, float a4, float a5, float a6, float a7, float s0, float s1) { printf("funFloat:\n"); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6892ebcef84407fd82abd9851a0af1e2... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6892ebcef84407fd82abd9851a0af1e2... You're receiving this email because of your account on gitlab.haskell.org.