diff options
| author | Ömer Sinan Ağacan <omeragacan@gmail.com> | 2020-04-16 10:32:14 +0300 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-04-18 13:21:44 -0400 |
| commit | 15ab6cd548f284732a7f89d78c2b89b1bfc4ea1d (patch) | |
| tree | b790a245d25d56c170ed8dd1451d52286804ae0a | |
| parent | e2586828a30202a28dcacac9ab7fc83c43da9e02 (diff) | |
| download | haskell-15ab6cd548f284732a7f89d78c2b89b1bfc4ea1d.tar.gz | |
Improve prepForeignCall error reporting
Show parameters and description of the error code when ffi_prep_cif
fails.
This may be helpful for debugging #17018.
| -rw-r--r-- | libraries/ghci/GHCi/FFI.hsc | 30 |
1 files changed, 21 insertions, 9 deletions
diff --git a/libraries/ghci/GHCi/FFI.hsc b/libraries/ghci/GHCi/FFI.hsc index f88e9e8bd8..74c9e175b1 100644 --- a/libraries/ghci/GHCi/FFI.hsc +++ b/libraries/ghci/GHCi/FFI.hsc @@ -58,15 +58,29 @@ prepForeignCall cconv arg_types result_type = do cif <- mallocBytes (#const sizeof(ffi_cif)) let abi = convToABI cconv r <- ffi_prep_cif cif abi (fromIntegral n_args) (ffiType result_type) arg_arr - if (r /= fFI_OK) - then throwIO (ErrorCall ("prepForeignCallFailed: " ++ show r)) - else return (castPtr cif) + if r /= fFI_OK then + throwIO $ ErrorCall $ concat + [ "prepForeignCallFailed: ", strError r, + "(cconv: ", show cconv, + " arg tys: ", show arg_types, + " res ty: ", show result_type, ")" ] + else + return (castPtr cif) freeForeignCallInfo :: Ptr C_ffi_cif -> IO () freeForeignCallInfo p = do free ((#ptr ffi_cif, arg_types) p) free p +strError :: C_ffi_status -> String +strError r + | r == fFI_BAD_ABI + = "invalid ABI (FFI_BAD_ABI)" + | r == fFI_BAD_TYPEDEF + = "invalid type description (FFI_BAD_TYPEDEF)" + | otherwise + = "unknown error: " ++ show r + convToABI :: FFIConv -> C_ffi_abi convToABI FFICCall = fFI_DEFAULT_ABI #if defined(mingw32_HOST_OS) && defined(i386_HOST_ARCH) @@ -108,12 +122,10 @@ foreign import ccall "&ffi_type_float" ffi_type_float :: Ptr C_ffi_type foreign import ccall "&ffi_type_double" ffi_type_double :: Ptr C_ffi_type foreign import ccall "&ffi_type_pointer"ffi_type_pointer :: Ptr C_ffi_type -fFI_OK :: C_ffi_status -fFI_OK = (#const FFI_OK) ---fFI_BAD_ABI :: C_ffi_status ---fFI_BAD_ABI = (#const FFI_BAD_ABI) ---fFI_BAD_TYPEDEF :: C_ffi_status ---fFI_BAD_TYPEDEF = (#const FFI_BAD_TYPEDEF) +fFI_OK, fFI_BAD_ABI, fFI_BAD_TYPEDEF :: C_ffi_status +fFI_OK = (#const FFI_OK) +fFI_BAD_ABI = (#const FFI_BAD_ABI) +fFI_BAD_TYPEDEF = (#const FFI_BAD_TYPEDEF) fFI_DEFAULT_ABI :: C_ffi_abi fFI_DEFAULT_ABI = (#const FFI_DEFAULT_ABI) |