Commit 80349a8f authored by Simon Marlow's avatar Simon Marlow

add test for #2594

parent e9114531
{-# options -fffi #-}
import Foreign
import Foreign.C.Types
main = do
wprint <- wrap8 print
call8 wprint
wprint <- wrap16 print
call16 wprint
wprint <- wrap32 print
call32 wprint
wprint <- wrap64 print
call64 wprint
foreign import ccall "wrapper"
wrap8 :: (Int8 -> IO ()) -> IO (FunPtr (Int8 -> IO ()))
foreign import ccall "FunPtrBug.h call8"
call8 :: FunPtr (Int8 -> IO ()) -> IO ()
foreign import ccall "wrapper"
wrap16 :: (Int16 -> IO ()) -> IO (FunPtr (Int16 -> IO ()))
foreign import ccall "FunPtrBug.h call16"
call16 :: FunPtr (Int16 -> IO ()) -> IO ()
foreign import ccall "wrapper"
wrap32 :: (Int32 -> IO ()) -> IO (FunPtr (Int32 -> IO ()))
foreign import ccall "FunPtrBug.h call32"
call32 :: FunPtr (Int32 -> IO ()) -> IO ()
foreign import ccall "wrapper"
wrap64 :: (Int64 -> IO ()) -> IO (FunPtr (Int64 -> IO ()))
foreign import ccall "FunPtrBug.h call64"
call64 :: FunPtr (Int64 -> IO ()) -> IO ()
#include "2594_c.h"
void call8 (funtype8 fun) { fun(-1); }
void call16(funtype16 fun) { fun(-1); }
void call32(funtype32 fun) { fun(-1); }
void call64(funtype64 fun) { fun(-1); }
#include "HsFFI.h"
typedef void (* funtype8)(HsInt8);
typedef void (* funtype16)(HsInt16);
typedef void (* funtype32)(HsInt32);
typedef void (* funtype64)(HsInt64);
void call8(funtype8 fun);
void call16(funtype16 fun);
void call32(funtype32 fun);
void call64(funtype64 fun);
int cmain();
......@@ -83,7 +83,8 @@ test('ffi012', skip_if_not_windows, compile_and_run, [''])
# Doesn't work with External Core due to __labels
test('ffi013', expect_fail_for(['extcore','optextcore']), compile_and_run, [''])
test('ffi014', only_ways(['threaded']), compile_and_run, ['ffi014_cbits.c'])
# threaded2 sometimes gives ffi014: Main_dDu: interrupted
test('ffi014', only_ways(['threaded1']), compile_and_run, ['ffi014_cbits.c'])
# GHCi can't handle the separate C file (ToDo: fix this somehow)
test('ffi015', [ omit_ways(['ghci']), extra_clean(['ffi015_cbits.o']) ],
......@@ -124,3 +125,5 @@ test('2276_ghci', [ skip_if_not_windows, only_ways(['ghci']),
compile_and_run, ['-fobject-code 2276_ghci_c.o'])
test('2469', normal, compile_and_run, ['-optc-std=gnu99'])
test('2594', omit_ways(['ghci']), compile_and_run, ['2594_c.c'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment