diff options
Diffstat (limited to 'testsuite/tests/ffi/should_run/ffi012.hs')
-rw-r--r-- | testsuite/tests/ffi/should_run/ffi012.hs | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/testsuite/tests/ffi/should_run/ffi012.hs b/testsuite/tests/ffi/should_run/ffi012.hs new file mode 100644 index 0000000000..de101ea769 --- /dev/null +++ b/testsuite/tests/ffi/should_run/ffi012.hs @@ -0,0 +1,53 @@ +-- !!! Same as ffi006, but using the stdcall calling convention. + +import Foreign +import Foreign.C + +-- With Ints: --------------------------------- + +type IOF = Int -> IO Int +type F = Int -> Int + +foreign import stdcall "wrapper" wrap_f :: F -> IO (FunPtr F) +foreign import stdcall "wrapper" wrap_f_io :: IOF -> IO (FunPtr IOF) + +foreign import stdcall "dynamic" f :: FunPtr F -> F +foreign import stdcall "dynamic" f_io :: FunPtr IOF -> IOF + +fn_int :: Int -> Int +fn_int x = x * 2 + +fn_int_io :: Int -> IO Int +fn_int_io x = return (x * 2) + +-- With Doubles: --------------------------------- + +type IOD = Double -> IO Double +type D = Double -> Double + +foreign import stdcall "wrapper" wrap_d :: D -> IO (FunPtr D) +foreign import stdcall "wrapper" wrap_d_io :: IOD -> IO (FunPtr IOD) + +foreign import stdcall "dynamic" d :: FunPtr D -> D +foreign import stdcall "dynamic" d_io :: FunPtr IOD -> IOD + +fn_double :: Double -> Double +fn_double x = x * 2 + +fn_double_io :: Double -> IO Double +fn_double_io x = return (x * 2) + +-------------------------------------------------- + +main = do + wrapped_fn_int <- wrap_f fn_int + print (f wrapped_fn_int 42) + wrapped_fn_int_io <- wrap_f_io fn_int_io + x <- f_io wrapped_fn_int_io 42 + print x + + wrapped_fn_double <- wrap_d fn_double + print (d wrapped_fn_double 42) + wrapped_fn_double_io <- wrap_d_io fn_double_io + x <- d_io wrapped_fn_double_io 42 + print x |