Skip to content

Commit

Permalink
Test returning small integers from callbacks.
Browse files Browse the repository at this point in the history
This currently fails on PowerPC.
  • Loading branch information
yallop committed Jun 18, 2016
1 parent d00922e commit 9f3cb97
Show file tree
Hide file tree
Showing 4 changed files with 23 additions and 0 deletions.
5 changes: 5 additions & 0 deletions tests/clib/test_functions.c
Original file line number Diff line number Diff line change
Expand Up @@ -637,3 +637,8 @@ int return_10(void)
{
return 10;
}

int callback_returns_char_a(char (*f)(void))
{
return f() == 'a' ? 1 : 0;
}
1 change: 1 addition & 0 deletions tests/clib/test_functions.h
Original file line number Diff line number Diff line change
Expand Up @@ -234,4 +234,5 @@ void *retrieve_ocaml_value(void);
int sixargs(int, int, int, int, int, int);
int return_10(void);

int callback_returns_char_a(char (*)(void));
#endif /* TEST_FUNCTIONS_H */
3 changes: 3 additions & 0 deletions tests/test-higher_order/stubs/functions.ml
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,9 @@ struct
funptr Ctypes.(int @-> int @-> returning int) @->
int @-> int @-> returning int)

let callback_returns_char_a = foreign "callback_returns_char_a"
(funptr Ctypes.(void @-> returning char) @-> returning int)

let returning_funptr = foreign "returning_funptr"
(int @-> returning (funptr Ctypes.(int @-> int @-> returning int)))

Expand Down
14 changes: 14 additions & 0 deletions tests/test-higher_order/test_higher_order.ml
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,14 @@ struct
assert_equal 10 (higher_order_3 acceptor ( + ) 3 4);
assert_equal 36 (higher_order_3 acceptor ( * ) 3 4)

(*
Call a C function of type
int (char( * )(void))
and check that the char returned by the function pointer is handled
correctly
*)
let test_function_pointer_returning_char _ =
assert_equal 1 (callback_returns_char_a (fun () -> 'a'))

(*
Call a C function of type
Expand Down Expand Up @@ -142,6 +150,12 @@ let suite = "Higher-order tests" >:::
"test_higher_higher_order (stubs)"
>:: Stub_tests.test_higher_higher_order;

"test_function_pointer_returning_char (stubs)"
>:: Stub_tests.test_function_pointer_returning_char;

"test_function_pointer_returning_char (foreign)"
>:: Foreign_tests.test_function_pointer_returning_char;

"test_returning_pointer_to_function (foreign)"
>:: Foreign_tests.test_returning_pointer_to_function;

Expand Down

0 comments on commit 9f3cb97

Please sign in to comment.