Merge pull request #1471 from ZackerySpytz/OCaml-segfaults-list-args
[OCaml] Fix segfaults when too few arguments are passed to a function
diff --git a/Examples/ocaml/callback/runme.ml b/Examples/ocaml/callback/runme.ml
index a7d7052..ddc9749 100644
--- a/Examples/ocaml/callback/runme.ml
+++ b/Examples/ocaml/callback/runme.ml
@@ -18,7 +18,7 @@
let callback = new_Callback '()
let _ = caller -> "setCallback" (callback)
let _ = caller -> "call" ()
-let _ = caller -> "delCallback" (0)
+let _ = caller -> "delCallback" ()
let _ = print_endline "\nAdding and calling an OCaml callback"
let _ = print_endline "------------------------------------"
@@ -26,5 +26,5 @@
let callback = new_derived_object new_Callback (new_OCamlCallback) '()
let _ = caller -> "setCallback" (callback)
let _ = caller -> "call" ()
-let _ = caller -> "delCallback" (0)
+let _ = caller -> "delCallback" ()
let _ = print_endline "\nOCaml exit"
diff --git a/Examples/test-suite/ocaml/cpp_nodefault_runme.ml b/Examples/test-suite/ocaml/cpp_nodefault_runme.ml
index 51809c2..a0bd840 100644
--- a/Examples/test-suite/ocaml/cpp_nodefault_runme.ml
+++ b/Examples/test-suite/ocaml/cpp_nodefault_runme.ml
@@ -12,7 +12,6 @@
let gvar = _gvar '()
let args = (C_list [ gvar ; foo2 ])
let _ = bar1 -> "consume" (args)
-let args = '(1, 2)
-let foo3 = bar1 -> "create" (args)
+let foo3 = bar1 -> "create" (1, 2)
let _ = foo3 -> "[a]" (6)
let _ = assert ((foo3 -> "[a]" () as int) = 6)
diff --git a/Examples/test-suite/ocaml/default_args_runme.ml b/Examples/test-suite/ocaml/default_args_runme.ml
new file mode 100644
index 0000000..1654b01
--- /dev/null
+++ b/Examples/test-suite/ocaml/default_args_runme.ml
@@ -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');
+;;
diff --git a/Examples/test-suite/ocaml/exception_order_runme.ml b/Examples/test-suite/ocaml/exception_order_runme.ml
index 728c3c3..9e987c8 100644
--- a/Examples/test-suite/ocaml/exception_order_runme.ml
+++ b/Examples/test-suite/ocaml/exception_order_runme.ml
@@ -5,7 +5,7 @@
let check meth args expected =
try
- ignore ((invoke a) meth (C_list [ args ])); assert false
+ ignore ((invoke a) meth (args)); assert false
with Failure msg -> assert (msg = expected)
let _ =
diff --git a/Examples/test-suite/ocaml/global_ns_arg_runme.ml b/Examples/test-suite/ocaml/global_ns_arg_runme.ml
index a78910d..7717e52 100644
--- a/Examples/test-suite/ocaml/global_ns_arg_runme.ml
+++ b/Examples/test-suite/ocaml/global_ns_arg_runme.ml
@@ -2,4 +2,4 @@
open Global_ns_arg
let _ = assert ((_foo '(1) as int) = 1)
-let _ = assert ((_bar_fn '(1) as int) = 1)
+let _ = assert ((_bar_fn '() as int) = 1)
diff --git a/Examples/test-suite/ocaml/throw_exception_runme.ml b/Examples/test-suite/ocaml/throw_exception_runme.ml
index 8c26061..5c4c092 100644
--- a/Examples/test-suite/ocaml/throw_exception_runme.ml
+++ b/Examples/test-suite/ocaml/throw_exception_runme.ml
@@ -5,7 +5,7 @@
let check meth args expected =
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)
let _ =
diff --git a/Examples/test-suite/ocaml/typemap_arrays_runme.ml b/Examples/test-suite/ocaml/typemap_arrays_runme.ml
index 17a133c..611e1d3 100644
--- a/Examples/test-suite/ocaml/typemap_arrays_runme.ml
+++ b/Examples/test-suite/ocaml/typemap_arrays_runme.ml
@@ -1,4 +1,4 @@
open Swig
open Typemap_arrays
-let _ = assert (_sumA '() as int = 60)
+let _ = assert (_sumA '(0) as int = 60)
diff --git a/Source/Modules/ocaml.cxx b/Source/Modules/ocaml.cxx
index 4174543..8b248ba 100644
--- a/Source/Modules/ocaml.cxx
+++ b/Source/Modules/ocaml.cxx
@@ -553,7 +553,18 @@
numargs = emit_num_arguments(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");
// Now write code to extract the parameters (this is super ugly)
