[OCaml] Fix segfaults when too few arguments are passed to a function
Prevent segfaults when too few arguments are passed to a function. Length checks are not needed for the wrappers of overloaded functions -- the generated dispatch function already checks. Add default_args_runme.ml. Fix minor errors in some runtime tests. Extra args were being passed in some cases.
This commit is contained in:
parent
7b0402f89b
commit
071803f000
8 changed files with 77 additions and 9 deletions
|
|
@ -18,7 +18,7 @@ let _ = print_endline "----------------------------------------"
|
||||||
let callback = new_Callback '()
|
let callback = new_Callback '()
|
||||||
let _ = caller -> "setCallback" (callback)
|
let _ = caller -> "setCallback" (callback)
|
||||||
let _ = caller -> "call" ()
|
let _ = caller -> "call" ()
|
||||||
let _ = caller -> "delCallback" (0)
|
let _ = caller -> "delCallback" ()
|
||||||
|
|
||||||
let _ = print_endline "\nAdding and calling an OCaml callback"
|
let _ = print_endline "\nAdding and calling an OCaml callback"
|
||||||
let _ = print_endline "------------------------------------"
|
let _ = print_endline "------------------------------------"
|
||||||
|
|
@ -26,5 +26,5 @@ let _ = print_endline "------------------------------------"
|
||||||
let callback = new_derived_object new_Callback (new_OCamlCallback) '()
|
let callback = new_derived_object new_Callback (new_OCamlCallback) '()
|
||||||
let _ = caller -> "setCallback" (callback)
|
let _ = caller -> "setCallback" (callback)
|
||||||
let _ = caller -> "call" ()
|
let _ = caller -> "call" ()
|
||||||
let _ = caller -> "delCallback" (0)
|
let _ = caller -> "delCallback" ()
|
||||||
let _ = print_endline "\nOCaml exit"
|
let _ = print_endline "\nOCaml exit"
|
||||||
|
|
|
||||||
|
|
@ -12,7 +12,6 @@ let bar1 = new_Bar '()
|
||||||
let gvar = _gvar '()
|
let gvar = _gvar '()
|
||||||
let args = (C_list [ gvar ; foo2 ])
|
let args = (C_list [ gvar ; foo2 ])
|
||||||
let _ = bar1 -> "consume" (args)
|
let _ = bar1 -> "consume" (args)
|
||||||
let args = '(1, 2)
|
let foo3 = bar1 -> "create" (1, 2)
|
||||||
let foo3 = bar1 -> "create" (args)
|
|
||||||
let _ = foo3 -> "[a]" (6)
|
let _ = foo3 -> "[a]" (6)
|
||||||
let _ = assert ((foo3 -> "[a]" () as int) = 6)
|
let _ = assert ((foo3 -> "[a]" () as int) = 6)
|
||||||
|
|
|
||||||
58
Examples/test-suite/ocaml/default_args_runme.ml
Normal file
58
Examples/test-suite/ocaml/default_args_runme.ml
Normal file
|
|
@ -0,0 +1,58 @@
|
||||||
|
open Swig
|
||||||
|
open Default_args
|
||||||
|
|
||||||
|
let _ =
|
||||||
|
assert (_anonymous '() as int = 7771);
|
||||||
|
assert (_anonymous '(1234) as int = 1234);
|
||||||
|
assert (_booltest '() as bool = true);
|
||||||
|
assert (_booltest '(true) as bool = true);
|
||||||
|
assert (_booltest '(false) as bool = false);
|
||||||
|
let ec = new_EnumClass '() in
|
||||||
|
assert (ec -> blah () as bool = true);
|
||||||
|
let de = new_DerivedEnumClass '() in
|
||||||
|
assert (de -> accelerate () = C_void);
|
||||||
|
let args = _SLOW '() in
|
||||||
|
assert (de -> accelerate (args) = C_void);
|
||||||
|
assert (_Statics_staticmethod '() as int = 60);
|
||||||
|
assert (_cfunc1 '(1) as float = 2.);
|
||||||
|
assert (_cfunc2 '(1) as float = 3.);
|
||||||
|
assert (_cfunc3 '(1) as float = 4.);
|
||||||
|
|
||||||
|
let f = new_Foo '() in
|
||||||
|
assert (f -> newname () = C_void);
|
||||||
|
assert (f -> newname (1) = C_void);
|
||||||
|
(* TODO: There needs to be a more elegant way to pass NULL/nullptr. *)
|
||||||
|
let args = C_list [ C_int 2 ; C_ptr (0L, 0L) ] in
|
||||||
|
assert (f -> double_if_void_ptr_is_null (args) as int = 4);
|
||||||
|
assert (f -> double_if_void_ptr_is_null (3) as int = 6);
|
||||||
|
let args = C_list [ C_int 4 ; C_ptr (0L, 0L) ] in
|
||||||
|
assert (f -> double_if_handle_is_null (args) as int = 8);
|
||||||
|
assert (f -> double_if_handle_is_null (5) as int = 10);
|
||||||
|
let args = C_list [ C_int 6 ; C_ptr (0L, 0L) ] in
|
||||||
|
assert (f -> double_if_dbl_ptr_is_null (args) as int = 12);
|
||||||
|
assert (f -> double_if_dbl_ptr_is_null (7) as int = 14);
|
||||||
|
|
||||||
|
let k = new_Klass '(22) in
|
||||||
|
let k2 = _Klass_inc (C_list [ C_int 100 ; k ]) in
|
||||||
|
assert (k2 -> "[val]" () as int = 122);
|
||||||
|
let k2 = _Klass_inc '(100) in
|
||||||
|
assert (k2 -> "[val]" () as int = 99);
|
||||||
|
let k2 = _Klass_inc '() in
|
||||||
|
assert (k2 -> "[val]" () as int = 0);
|
||||||
|
|
||||||
|
assert (_seek '() = C_void);
|
||||||
|
assert (_seek (C_int64 10L) = C_void);
|
||||||
|
|
||||||
|
assert (_slightly_off_square '(10) as int = 102);
|
||||||
|
assert (_slightly_off_square '() as int = 291);
|
||||||
|
|
||||||
|
assert (_casts1 '() as char = '\x00');
|
||||||
|
assert (_casts2 '() as string = "Hello");
|
||||||
|
assert (_casts1 '("Ciao") as string = "Ciao");
|
||||||
|
assert (_chartest1 '() as char = 'x');
|
||||||
|
assert (_chartest2 '() as char = '\x00');
|
||||||
|
assert (_chartest3 '() as char = '\x01');
|
||||||
|
assert (_chartest4 '() as char = '\n');
|
||||||
|
assert (_chartest5 '() as char = 'B');
|
||||||
|
assert (_chartest6 '() as char = 'C');
|
||||||
|
;;
|
||||||
|
|
@ -5,7 +5,7 @@ let a = new_A '()
|
||||||
|
|
||||||
let check meth args expected =
|
let check meth args expected =
|
||||||
try
|
try
|
||||||
ignore ((invoke a) meth (C_list [ args ])); assert false
|
ignore ((invoke a) meth (args)); assert false
|
||||||
with Failure msg -> assert (msg = expected)
|
with Failure msg -> assert (msg = expected)
|
||||||
|
|
||||||
let _ =
|
let _ =
|
||||||
|
|
|
||||||
|
|
@ -2,4 +2,4 @@ open Swig
|
||||||
open Global_ns_arg
|
open Global_ns_arg
|
||||||
|
|
||||||
let _ = assert ((_foo '(1) as int) = 1)
|
let _ = assert ((_foo '(1) as int) = 1)
|
||||||
let _ = assert ((_bar_fn '(1) as int) = 1)
|
let _ = assert ((_bar_fn '() as int) = 1)
|
||||||
|
|
|
||||||
|
|
@ -5,7 +5,7 @@ let x = new_Foo '()
|
||||||
|
|
||||||
let check meth args expected =
|
let check meth args expected =
|
||||||
try
|
try
|
||||||
let _ = ((invoke x) meth (C_list [ args ])) in assert false
|
let _ = ((invoke x) meth (args)) in assert false
|
||||||
with Failure msg -> assert (msg = expected)
|
with Failure msg -> assert (msg = expected)
|
||||||
|
|
||||||
let _ =
|
let _ =
|
||||||
|
|
|
||||||
|
|
@ -1,4 +1,4 @@
|
||||||
open Swig
|
open Swig
|
||||||
open Typemap_arrays
|
open Typemap_arrays
|
||||||
|
|
||||||
let _ = assert (_sumA '() as int = 60)
|
let _ = assert (_sumA '(0) as int = 60)
|
||||||
|
|
|
||||||
|
|
@ -553,7 +553,18 @@ public:
|
||||||
|
|
||||||
numargs = emit_num_arguments(l);
|
numargs = emit_num_arguments(l);
|
||||||
numreq = emit_num_required(l);
|
numreq = emit_num_required(l);
|
||||||
|
if (!isOverloaded) {
|
||||||
|
if (numargs > 0) {
|
||||||
|
if (numreq > 0) {
|
||||||
|
Printf(f->code, "if (caml_list_length(args) < %d || caml_list_length(args) > %d) {\n", numreq, numargs);
|
||||||
|
} else {
|
||||||
|
Printf(f->code, "if (caml_list_length(args) > %d) {\n", numargs);
|
||||||
|
}
|
||||||
|
Printf(f->code, "caml_invalid_argument(\"Incorrect number of arguments passed to '%s'\");\n}\n", iname);
|
||||||
|
} else {
|
||||||
|
Printf(f->code, "if (caml_list_length(args) > 0) caml_invalid_argument(\"'%s' takes no arguments\");\n", iname);
|
||||||
|
}
|
||||||
|
}
|
||||||
Printf(f->code, "swig_result = Val_unit;\n");
|
Printf(f->code, "swig_result = Val_unit;\n");
|
||||||
|
|
||||||
// Now write code to extract the parameters (this is super ugly)
|
// Now write code to extract the parameters (this is super ugly)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue