From 071803f0009dae51ecc07c6b0b80a0bcea70c2aa Mon Sep 17 00:00:00 2001 From: Zackery Spytz Date: Fri, 15 Feb 2019 01:17:15 -0700 Subject: [PATCH] [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. --- Examples/ocaml/callback/runme.ml | 4 +- .../test-suite/ocaml/cpp_nodefault_runme.ml | 3 +- .../test-suite/ocaml/default_args_runme.ml | 58 +++++++++++++++++++ .../test-suite/ocaml/exception_order_runme.ml | 2 +- .../test-suite/ocaml/global_ns_arg_runme.ml | 2 +- .../test-suite/ocaml/throw_exception_runme.ml | 2 +- .../test-suite/ocaml/typemap_arrays_runme.ml | 2 +- Source/Modules/ocaml.cxx | 13 ++++- 8 files changed, 77 insertions(+), 9 deletions(-) create mode 100644 Examples/test-suite/ocaml/default_args_runme.ml diff --git a/Examples/ocaml/callback/runme.ml b/Examples/ocaml/callback/runme.ml index a7d705241..ddc974984 100644 --- a/Examples/ocaml/callback/runme.ml +++ b/Examples/ocaml/callback/runme.ml @@ -18,7 +18,7 @@ let _ = print_endline "----------------------------------------" 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 _ = print_endline "------------------------------------" 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 51809c2ef..a0bd84071 100644 --- a/Examples/test-suite/ocaml/cpp_nodefault_runme.ml +++ b/Examples/test-suite/ocaml/cpp_nodefault_runme.ml @@ -12,7 +12,6 @@ let bar1 = new_Bar '() 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 000000000..1654b011f --- /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 728c3c315..9e987c84b 100644 --- a/Examples/test-suite/ocaml/exception_order_runme.ml +++ b/Examples/test-suite/ocaml/exception_order_runme.ml @@ -5,7 +5,7 @@ let a = new_A '() 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 a78910db4..7717e52d9 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 Swig 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 8c2606129..5c4c0922a 100644 --- a/Examples/test-suite/ocaml/throw_exception_runme.ml +++ b/Examples/test-suite/ocaml/throw_exception_runme.ml @@ -5,7 +5,7 @@ let x = new_Foo '() 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 17a133c3c..611e1d338 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 417454375..8b248bad2 100644 --- a/Source/Modules/ocaml.cxx +++ b/Source/Modules/ocaml.cxx @@ -553,7 +553,18 @@ public: 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)