[OCaml] Add a typecheck typemap for SWIGTYPE
This fixes many of the remaining warnings in the OCaml test suite. Add multiple runtime tests.
This commit is contained in:
parent
6522afe90a
commit
b7a400f991
8 changed files with 211 additions and 10 deletions
|
|
@ -4616,7 +4616,7 @@ except Error, e:
|
|||
|
||||
<p>
|
||||
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 <a href="Typemaps.html#throws_typemap">"throws" typemap</a> section.
|
||||
is outlined in the <a href="Typemaps.html#Typemaps_throws_typemap">"throws" typemap</a> section.
|
||||
</p>
|
||||
|
||||
<p>
|
||||
|
|
|
|||
53
Examples/test-suite/ocaml/extend_placement_runme.ml
Normal file
53
Examples/test-suite/ocaml/extend_placement_runme.ml
Normal file
|
|
@ -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);
|
||||
;;
|
||||
60
Examples/test-suite/ocaml/overload_template_runme.ml
Normal file
60
Examples/test-suite/ocaml/overload_template_runme.ml
Normal file
|
|
@ -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);
|
||||
;;
|
||||
|
|
@ -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)");
|
||||
;;
|
||||
52
Examples/test-suite/ocaml/template_default_arg_runme.ml
Normal file
52
Examples/test-suite/ocaml/template_default_arg_runme.ml
Normal file
|
|
@ -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);
|
||||
;;
|
||||
|
|
@ -62,7 +62,7 @@ extern "C" {
|
|||
SWIG_TypeCheckStruct(source_type, dest_type );
|
||||
#ifdef TYPE_CAST_VERBOSE
|
||||
fprintf( stderr, "Typecheck -> %s\n",
|
||||
tc ? tc->str : "<none>" );
|
||||
tc ? tc->type->str : "<none>" );
|
||||
#endif
|
||||
if( tc ) {
|
||||
int newmemory = 0;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
* ------------------------------------------------------------ */
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue