diff --git a/Doc/Manual/SWIGPlus.html b/Doc/Manual/SWIGPlus.html index a6cb93f63..8ad9daedf 100644 --- a/Doc/Manual/SWIGPlus.html +++ b/Doc/Manual/SWIGPlus.html @@ -4616,7 +4616,7 @@ except Error, e:

Details of how to tailor code for handling the caught C++ exception and converting it into the target language's exception/error handling mechanism -is outlined in the "throws" typemap section. +is outlined in the "throws" typemap section.

diff --git a/Examples/test-suite/ocaml/extend_placement_runme.ml b/Examples/test-suite/ocaml/extend_placement_runme.ml new file mode 100644 index 000000000..31d9ae671 --- /dev/null +++ b/Examples/test-suite/ocaml/extend_placement_runme.ml @@ -0,0 +1,53 @@ +open Swig +open Extend_placement + +let _ = + let f = new_Foo '() in + assert (f -> spam () as int = 1); + assert (new_Foo '(1) -> spam () as int = 1); + let f = new_Foo '(1, 1) in + assert (f -> spam () as int = 1); + assert (f -> spam ("hello") as int = 2); + assert (f -> spam (1) as int = 1); + assert (f -> spam (1, 2) as int = 3); + assert (f -> spam (2, 4, 6) as int = 6); + assert (f -> spam (f) as int = 0); + let arg = C_double 1. in + assert (f -> spam (f, arg) as int = 0); + + assert (new_Bar '() -> spam () as int = 1); + let b = new_Bar '(1) in + assert (b -> spam () as int = 1); + assert (b -> spam ("hello") as int = 2); + assert (b -> spam (1) as int = 1); + assert (b -> spam (1, 2) as int = 3); + assert (b -> spam (2, 4, 6) as int = 6); + assert (b -> spam (b) as int = 0); + let arg = C_double 1. in + assert (b -> spam (b, arg) as int = 0); + + assert (new_FooTi '() -> spam () as int = 1); + assert (new_FooTi '(1) -> spam () as int = 1); + let f = new_FooTi '(1, 1) in + assert (f -> spam () as int = 1); + assert (f -> spam ("hello") as int = 2); + assert (f -> spam (1) as int = 1); + assert (f -> spam (1, 2) as int = 3); + assert (f -> spam (2, 4, 6) as int = 6); + let foo = new_Foo '() in + assert (f -> spam (foo) as int = 0); + let arg = C_double 1. in + assert (f -> spam (foo, arg) as int = 0); + + assert (new_BarTi '() -> spam () as int = 1); + let b = new_BarTi '(1) in + assert (b -> spam () as int = 1); + assert (b -> spam ("hello") as int = 2); + assert (b -> spam (1) as int = 1); + assert (b -> spam (1, 2) as int = 3); + assert (b -> spam (2, 4, 6) as int = 6); + let bar = new_Bar '() in + assert (b -> spam (bar) as int = 0); + let arg = C_double 1. in + assert (b -> spam (bar, arg) as int = 0); +;; diff --git a/Examples/test-suite/ocaml/overload_template_runme.ml b/Examples/test-suite/ocaml/overload_template_runme.ml new file mode 100644 index 000000000..42a4a397a --- /dev/null +++ b/Examples/test-suite/ocaml/overload_template_runme.ml @@ -0,0 +1,60 @@ +open Swig +open Overload_template + +let _ = + assert (_foo '() as int = 3); + assert (_maximum '(3, 4) as int = 4); + assert (_maximum '(3.4, 5.2) as float > 5.); + assert (_mix1 '("hi") as int = 101); + assert (_mix1 '(1.0, 1.0) as int = 102); + assert (_mix1 '(1.0) as int = 103); + assert (_mix2 '("hi") as int = 101); + assert (_mix2 '(1.0, 1.0) as int = 102); + assert (_mix2 '(1.0) as int = 103); + assert (_mix3 '("hi") as int = 101); + assert (_mix3 '(1.0, 1.0) as int = 102); + assert (_mix3 '(1.0) as int = 103); + + assert (_overtparams1 '(100) as int = 10); + assert (_overtparams1 '(100.0, 100) as int = 20); + assert (_overtparams2 '(100.0, 100) as int = 40); + assert (_overloaded '() as int = 60); + assert (_overloaded '(100.0, 100) as int = 70); + assert (_overloadedagain '("hello") as int = 80); + assert (_overloadedagain '() as int = 90); + + assert (_specialization '(10) as int = 202); + assert (_specialization '(10.0) as int = 203); + assert (_specialization '(10, 10) as int = 204); + assert (_specialization '(10.0, 10.0) as int = 205); + assert (_specialization '("hi", "hi") as int = 201); + + assert (_xyz '() = C_void); + assert (_xyz_int '() = C_void); + assert (_xyz_double '() = C_void); + + assert (_overload '("hi") as int = 0); + assert (_overload '(1) as int = 10); + assert (_overload '(1, 1) as int = 20); + assert (_overload '(1, "hello") as int = 30); + let k = new_Klass '() in + assert (_overload '(k) as int = 10); + assert (_overload '(k, k) as int = 20); + assert (_overload '(k, "hello") as int = 30); + assert (_overload '(10.0, "hi") as int = 40); + assert (_overload '() as int = 50); + + assert (_nsoverload '("hi") as int = 1000); + assert (_nsoverload '(1) as int = 1010); + assert (_nsoverload '(1, 1) as int = 1020); + assert (_nsoverload '(1, "hello") as int = 1030); + assert (_nsoverload '(k) as int = 1010); + assert (_nsoverload '(k, k) as int = 1020); + assert (_nsoverload '(k, "hello") as int = 1030); + assert (_nsoverload '(10.0, "hi") as int = 1040); + assert (_nsoverload '() as int = 1050); + + assert (_A_foo '(1) = C_void); + let b = new_B '() in + assert (b -> foo(1) = C_void); +;; diff --git a/Examples/test-suite/ocaml/template_default_arg_overloaded_extend_runme.ml b/Examples/test-suite/ocaml/template_default_arg_overloaded_extend_runme.ml new file mode 100644 index 000000000..27fb9b543 --- /dev/null +++ b/Examples/test-suite/ocaml/template_default_arg_overloaded_extend_runme.ml @@ -0,0 +1,17 @@ +open Swig +open Template_default_arg_overloaded_extend + +let _ = + let rs = new_ResultSet '() and sp = new_SearchPoint '() in + assert (rs -> go_get_method (0, sp) as int = -1); + assert (rs -> go_get_method (0, sp, 100) as int = 100); + assert (rs -> go_get_template (0, sp) as int = -2); + assert (rs -> go_get_template (0, sp, 100) as int = 100); + + assert (rs -> over () as string = "over(int)"); + assert (rs -> over (10) as string = "over(int)"); + assert (rs -> over (sp) as string = "over(giai2::SearchPoint, int)"); + assert (rs -> over (sp, 10) as string = "over(giai2::SearchPoint, int)"); + assert (rs -> over (true, sp) as string = "over(bool, gaia2::SearchPoint, int)"); + assert (rs -> over (true, sp, 10) as string = "over(bool, gaia2::SearchPoint, int)"); +;; diff --git a/Examples/test-suite/ocaml/template_default_arg_runme.ml b/Examples/test-suite/ocaml/template_default_arg_runme.ml new file mode 100644 index 000000000..94f2291f1 --- /dev/null +++ b/Examples/test-suite/ocaml/template_default_arg_runme.ml @@ -0,0 +1,52 @@ +open Swig +open Template_default_arg + +let _ = + let helloInt = new_Hello_int '() and enumArg = _hi '() in + assert (helloInt -> foo (enumArg) = C_void); + assert (helloInt -> foo () = C_void); + + let x = new_X_int '() in + assert (x -> meth (20.0, 200) as int = 200); + assert (x -> meth (20) as int = 20); + assert (x -> meth () as int = 0); + + let x = new_Y_unsigned '() in + let args = C_list [ C_double 20.0 ; C_uint 200l ] in + assert (x -> meth (args) as int = 200); + let args = C_uint 20l in + assert (x -> meth (args) as int = 20); + assert (x -> meth () as int = 0); + + let x = new_X_longlong '() in + assert (x -> meth (20.0) as int = 0); + let x = new_X_longlong '(20.0) in + assert (x -> meth (20.0) as int = 0); + let args = C_list [ C_double 20.0 ; C_int64 200L ] in + let x = new_X_longlong '(args) in + assert (x -> meth (20.0) as int = 0); + + let x = new_X_int '() in + assert (x -> meth (20.0) as int = 0); + let x = new_X_int '(20.0) in + assert (x -> meth (20.0) as int = 0); + let x = new_X_int '(20.0, 200) in + assert (x -> meth (20.0) as int = 0); + + let arg = new_Foo_int '() in + assert (_ott '(arg) as int = 30); + assert (_ott '() as int = 10); + assert (_ott '(1) as int = 10); + assert (_ott '(1, 1) as int = 10); + assert (_ott '("hi") as int = 20); + assert (_ott '("hi", 1) as int = 20); + assert (_ott '("hi", 1, 1) as int = 20); + + let arg = new_Hello_int '() in + assert (_ottstring '(arg, "hi") as int = 40); + assert (_ottstring '(arg) as int = 40); + assert (_ottint '(arg, 1) as int = 50); + assert (_ottint '(arg) as int = 50); + assert (_ott '(arg, 1.0) as int = 60); + assert (_ott '(arg) as int = 60); +;; diff --git a/Lib/ocaml/ocaml.swg b/Lib/ocaml/ocaml.swg index 2da3fb769..3d552cc50 100644 --- a/Lib/ocaml/ocaml.swg +++ b/Lib/ocaml/ocaml.swg @@ -62,7 +62,7 @@ extern "C" { SWIG_TypeCheckStruct(source_type, dest_type ); #ifdef TYPE_CAST_VERBOSE fprintf( stderr, "Typecheck -> %s\n", - tc ? tc->str : "" ); + tc ? tc->type->str : "" ); #endif if( tc ) { int newmemory = 0; diff --git a/Lib/ocaml/std_string.i b/Lib/ocaml/std_string.i index 0ea9b4e2d..712c3bb73 100644 --- a/Lib/ocaml/std_string.i +++ b/Lib/ocaml/std_string.i @@ -86,6 +86,7 @@ class wstring; %typemap(out) string * { $result = caml_val_string_len((*$1).c_str(),(*$1).size()); } +%typemap(typecheck) string, const string & = char *; } #ifdef ENABLE_CHARPTR_ARRAY diff --git a/Lib/ocaml/typecheck.i b/Lib/ocaml/typecheck.i index 2cc8dcbec..fd1cb16ed 100644 --- a/Lib/ocaml/typecheck.i +++ b/Lib/ocaml/typecheck.i @@ -135,24 +135,42 @@ } %typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [] { - void *ptr; - $1 = !caml_ptr_val_internal($input, &ptr,$descriptor); + if (!Is_block($input) || !(SWIG_Tag_val($input) == C_obj || SWIG_Tag_val($input) == C_ptr)) { + $1 = 0; + } else { + void *ptr; + $1 = !caml_ptr_val_internal($input, &ptr, $descriptor); + } } -#if 0 - %typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE { - void *ptr; - $1 = !caml_ptr_val_internal($input, &ptr, $&1_descriptor); + swig_type_info *typeinfo; + if (!Is_block($input)) { + $1 = 0; + } else { + switch (SWIG_Tag_val($input)) { + case C_obj: { + void *ptr; + $1 = !caml_ptr_val_internal($input, &ptr, $&1_descriptor); + break; + } + case C_ptr: { + typeinfo = (swig_type_info *)SWIG_Int64_val(SWIG_Field($input, 1)); + $1 = SWIG_TypeCheck("$1_type", typeinfo) != NULL; + break; + } + default: $1 = 0; break; + } + } } -#endif - %typecheck(SWIG_TYPECHECK_VOIDPTR) void * { void *ptr; $1 = !caml_ptr_val_internal($input, &ptr, 0); } +%typecheck(SWIG_TYPECHECK_SWIGOBJECT) CAML_VALUE "$1 = 1;" + /* ------------------------------------------------------------ * Exception handling * ------------------------------------------------------------ */