diff --git a/Examples/test-suite/ocaml/catches_runme.ml b/Examples/test-suite/ocaml/catches_runme.ml new file mode 100644 index 000000000..ab38e635d --- /dev/null +++ b/Examples/test-suite/ocaml/catches_runme.ml @@ -0,0 +1,39 @@ +open Swig +open Catches + +let _ = + try + ignore (_test_catches '(1)); assert false + with Failure s -> + assert (s = "C++ int exception thrown, value: 1") + + try + ignore (_test_catches '(2)); assert false + with Failure s -> + assert (s = "two") + + try + ignore (_test_catches '(3)); assert false + with Failure s -> + assert (s = "C++ ThreeException const & exception thrown") + + try + ignore (_test_exception_specification '(1)); assert false + with Failure s -> + assert (s = "C++ int exception thrown, value: 1") + + try + ignore (_test_exception_specification '(2)); assert false + with Failure s -> + assert (s = "unknown exception") + + try + ignore (_test_exception_specification '(3)); assert false + with Failure s -> + assert (s = "unknown exception") + + try + ignore (_test_catches_all '(1)); assert false + with Failure s -> + assert (s = "unknown exception") +;; diff --git a/Examples/test-suite/ocaml/director_exception_runme.ml b/Examples/test-suite/ocaml/director_exception_runme.ml new file mode 100644 index 000000000..1cd769b20 --- /dev/null +++ b/Examples/test-suite/ocaml/director_exception_runme.ml @@ -0,0 +1,46 @@ +open Swig +open Director_exception + +exception MyException of string * string + +let director_exception_MyFoo ob meth args = + match meth with + "ping" -> raise (Failure "MyFoo::ping() EXCEPTION") + | _ -> (invoke ob) meth args + +let director_exception_MyFoo2 ob meth args = + match meth with + "ping" -> (C_bool true) + | _ -> (invoke ob) meth args + +let director_exception_MyFoo3 ob meth args = + match meth with + "ping" -> raise (MyException ("foo", "bar")) + | _ -> (invoke ob) meth args + +(* Check that Failure is raised by MyFoo.ping() (via MyFoo.pong()). *) +let a = + new_derived_object + new_Foo (director_exception_MyFoo) '() +let a = _launder(a) +try + let _ = a -> pong () in assert false +with Failure s -> assert(s = "MyFoo::ping() EXCEPTION") + +let a = + new_derived_object + new_Foo (director_exception_MyFoo2) '() +let a = _launder(a) +try + let _ = a -> pong () in assert false +with Failure s -> assert(s = "No appropriate conversion found.") + +let a = + new_derived_object + new_Foo (director_exception_MyFoo3) '() +let a = _launder(a) +try + let _ = a -> pong () in assert false +with MyException (s1, s2) -> + assert (s1 = "foo"); + assert (s2 = "bar"); diff --git a/Examples/test-suite/ocaml/exception_classname_runme.ml b/Examples/test-suite/ocaml/exception_classname_runme.ml new file mode 100644 index 000000000..8467ed6e8 --- /dev/null +++ b/Examples/test-suite/ocaml/exception_classname_runme.ml @@ -0,0 +1,5 @@ +open Swig +open Exception_classname + +let a = new_Exception '() +assert (a -> testfunc () as int = 42) diff --git a/Examples/test-suite/ocaml/exception_order_runme.ml b/Examples/test-suite/ocaml/exception_order_runme.ml new file mode 100644 index 000000000..728c3c315 --- /dev/null +++ b/Examples/test-suite/ocaml/exception_order_runme.ml @@ -0,0 +1,17 @@ +open Swig +open Exception_order + +let a = new_A '() + +let check meth args expected = + try + ignore ((invoke a) meth (C_list [ args ])); assert false + with Failure msg -> assert (msg = expected) + +let _ = + check "foo" '() "C++ E1 exception thrown"; + check "bar" '() "C++ E2 exception thrown"; + check "foobar" '() "postcatch unknown"; + check "barfoo" (C_int 1) "C++ E1 exception thrown"; + check "barfoo" (C_int 2) "C++ E2 * exception thrown"; +;; diff --git a/Examples/test-suite/ocaml/li_std_except_runme.ml b/Examples/test-suite/ocaml/li_std_except_runme.ml new file mode 100644 index 000000000..e6ad14dc3 --- /dev/null +++ b/Examples/test-suite/ocaml/li_std_except_runme.ml @@ -0,0 +1,18 @@ +open Swig +open Li_std_except + +let _ = + let t = new_Test '() in + try let _ = t -> throw_bad_cast () in assert false with Failure s -> (); + try let _ = t -> throw_bad_exception () in assert false with Failure s -> (); + try let _ = t -> throw_domain_error () in assert false with Failure s -> assert (s = "oops"); + try let _ = t -> throw_exception () in assert false with Failure s -> (); + try let _ = t -> throw_invalid_argument () in assert false with Invalid_argument s -> assert (s = "oops"); + try let _ = t -> throw_length_error () in assert false with Failure s -> assert (s = "oops"); + try let _ = t -> throw_logic_error () in assert false with Failure s -> assert (s = "oops"); + try let _ = t -> throw_out_of_range () in assert false with Failure s -> assert (s = "oops"); + try let _ = t -> throw_overflow_error () in assert false with Failure s -> assert (s = "oops"); + try let _ = t -> throw_range_error () in assert false with Failure s -> assert (s = "oops"); + try let _ = t -> throw_runtime_error () in assert false with Failure s -> assert (s = "oops"); + try let _ = t -> throw_underflow_error () in assert false with Failure s -> assert (s = "oops"); +;; diff --git a/Examples/test-suite/ocaml/swig_exception_runme.ml b/Examples/test-suite/ocaml/swig_exception_runme.ml new file mode 100644 index 000000000..5bf36c36f --- /dev/null +++ b/Examples/test-suite/ocaml/swig_exception_runme.ml @@ -0,0 +1,13 @@ +open Swig +open Swig_exception + +let _ = + let c = new_Circle '(10) and s = new_Square '(10) in + assert (_Shape_nshapes '() as int = 2); + try + ignore (c -> throwException ()); assert false + with Sys_error msg -> assert (msg = "OK"); + let _ = c -> "~" () in + let _ = s -> "~" () in + assert (_Shape_nshapes '() as int = 0); +;; diff --git a/Examples/test-suite/ocaml/throw_exception_runme.ml b/Examples/test-suite/ocaml/throw_exception_runme.ml index 8781926b6..8c2606129 100644 --- a/Examples/test-suite/ocaml/throw_exception_runme.ml +++ b/Examples/test-suite/ocaml/throw_exception_runme.ml @@ -1,28 +1,25 @@ -(* Throw exception test *) - open Swig open Throw_exception -let x = new_Foo C_void ;; -let _ = - try - (invoke x) "test_int" C_void - with (Failure "Exception(37): Thrown exception from C++ (int)\n") -> - try - (invoke x) "test_msg" C_void - with (Failure "Exception(0): Dead\n") -> - try - (invoke x) "test_cls" C_void - with (Failure "Exception(0): Thrown exception from C++ (unknown)\n") -> - try - (invoke x) "test_multi" (C_int 1) - with (Failure "Exception(37): Thrown exception from C++ (int)\n") -> - try - (invoke x) "test_multi" (C_int 2) - with (Failure "Exception(0): Dead\n") -> - try - (invoke x) "test_multi" (C_int 3) - with (Failure "Exception(0): Thrown exception from C++ (unknown)\n") -> - exit 0 +let x = new_Foo '() -let _ = exit 1 +let check meth args expected = + try + let _ = ((invoke x) meth (C_list [ args ])) in assert false + with Failure msg -> assert (msg = expected) + +let _ = + check "test_int" '() "C++ int exception thrown, value: 37"; + check "test_msg" '() "Dead"; + check "test_cls" '() "C++ CError exception thrown"; + check "test_cls_ptr" '() "C++ CError * exception thrown"; + check "test_cls_ref" '() "C++ CError & exception thrown"; + check "test_cls_td" '() "C++ Namespace::ErrorTypedef exception thrown"; + check "test_cls_ptr_td" '() "C++ Namespace::ErrorPtr exception thrown"; + check "test_cls_ref_td" '() "C++ Namespace::ErrorRef exception thrown"; + check "test_array" '() "C++ int [10] exception thrown"; + check "test_enum" '() "C++ Namespace::EnumTest exception thrown"; + check "test_multi" '(1) "C++ int exception thrown, value: 37"; + check "test_multi" '(2) "Dead"; + check "test_multi" '(3) "C++ CError exception thrown"; +;; diff --git a/Lib/exception.i b/Lib/exception.i index c79a76c37..ee9ce9bc6 100644 --- a/Lib/exception.i +++ b/Lib/exception.i @@ -127,13 +127,44 @@ SWIGINTERN void SWIG_JavaException(JNIEnv *jenv, int code, const char *msg) { #ifdef SWIGOCAML %{ -#define OCAML_MSG_BUF_LEN 1024 -SWIGINTERN void SWIG_exception_(int code, const char *msg) { - char msg_buf[OCAML_MSG_BUF_LEN]; - sprintf( msg_buf, "Exception(%d): %s\n", code, msg ); - caml_failwith( msg_buf ); +SWIGINTERN void SWIG_OCamlException(int code, const char *msg) { + CAMLparam0(); + + SWIG_OCamlExceptionCodes exception_code = SWIG_OCamlUnknownError; + switch (code) { + case SWIG_DivisionByZero: + exception_code = SWIG_OCamlArithmeticException; + break; + case SWIG_IndexError: + exception_code = SWIG_OCamlIndexOutOfBoundsException; + break; + case SWIG_IOError: + case SWIG_SystemError: + exception_code = SWIG_OCamlSystemException; + break; + case SWIG_MemoryError: + exception_code = SWIG_OCamlOutOfMemoryError; + break; + case SWIG_OverflowError: + exception_code = SWIG_OCamlOverflowException; + break; + case SWIG_RuntimeError: + exception_code = SWIG_OCamlRuntimeException; + break; + case SWIG_SyntaxError: + case SWIG_TypeError: + case SWIG_ValueError: + exception_code = SWIG_OCamlIllegalArgumentException; + break; + case SWIG_UnknownError: + default: + exception_code = SWIG_OCamlUnknownError; + break; + } + SWIG_OCamlThrowException(exception_code, msg); + CAMLreturn0; } -#define SWIG_exception(a,b) SWIG_exception_((a),(b)) +#define SWIG_exception(code, msg) SWIG_OCamlException(code, msg) %} #endif diff --git a/Lib/ocaml/ocamldec.swg b/Lib/ocaml/ocamldec.swg index 5294ef0ef..0c2faf771 100644 --- a/Lib/ocaml/ocamldec.swg +++ b/Lib/ocaml/ocamldec.swg @@ -127,7 +127,44 @@ CAMLextern int64 Int64_val(caml_value_t v); #define SWIG_GetModule(clientdata) SWIG_Ocaml_GetModule(clientdata) #define SWIG_SetModule(clientdata, pointer) SWIG_Ocaml_SetModule(pointer) -#define SWIG_contract_assert(expr, msg) if(!(expr)) {caml_failwith(msg);} else +typedef enum { + SWIG_OCamlArithmeticException, + SWIG_OCamlDirectorPureVirtual, + SWIG_OCamlOutOfMemoryError, + SWIG_OCamlOverflowException, + SWIG_OCamlIllegalArgumentException, + SWIG_OCamlIndexOutOfBoundsException, + SWIG_OCamlRuntimeException, + SWIG_OCamlSystemException, + SWIG_OCamlUnknownError +} SWIG_OCamlExceptionCodes; + +SWIGINTERN void SWIG_OCamlThrowException(SWIG_OCamlExceptionCodes code, const char *msg) { + CAMLparam0(); + SWIG_CAMLlocal1(str); + + switch (code) { + case SWIG_OCamlIllegalArgumentException: + caml_invalid_argument(msg); + break; + case SWIG_OCamlSystemException: + str = caml_copy_string(msg); + caml_raise_sys_error(str); + break; + case SWIG_OCamlArithmeticException: + case SWIG_OCamlIndexOutOfBoundsException: + case SWIG_OCamlOutOfMemoryError: + case SWIG_OCamlOverflowException: + case SWIG_OCamlRuntimeException: + case SWIG_OCamlUnknownError: + default: + caml_failwith(msg); + break; + } + CAMLreturn0; +} + +#define SWIG_contract_assert(expr, msg) if(!(expr)) {SWIG_OCamlThrowException(SWIG_OCamlRuntimeException, msg);} SWIGINTERN int SWIG_GetPtr(void *source, void **result, swig_type_info *type, swig_type_info *result_type); diff --git a/Lib/ocaml/std_except.i b/Lib/ocaml/std_except.i new file mode 100644 index 000000000..74ddcb51d --- /dev/null +++ b/Lib/ocaml/std_except.i @@ -0,0 +1,23 @@ +%{ +#include +#include +%} + +namespace std +{ + %ignore exception; + struct exception {}; +} + +%typemap(throws) std::bad_cast "SWIG_OCamlThrowException(SWIG_OCamlRuntimeException, $1.what());" +%typemap(throws) std::bad_exception "SWIG_OCamlThrowException(SWIG_OCamlRuntimeException, $1.what());" +%typemap(throws) std::domain_error "SWIG_OCamlThrowException(SWIG_OCamlRuntimeException, $1.what());" +%typemap(throws) std::exception "SWIG_OCamlThrowException(SWIG_OCamlRuntimeException, $1.what());" +%typemap(throws) std::invalid_argument "SWIG_OCamlThrowException(SWIG_OCamlIllegalArgumentException, $1.what());" +%typemap(throws) std::length_error "SWIG_OCamlThrowException(SWIG_OCamlIndexOutOfBoundsException, $1.what());" +%typemap(throws) std::logic_error "SWIG_OCamlThrowException(SWIG_OCamlRuntimeException, $1.what());" +%typemap(throws) std::out_of_range "SWIG_OCamlThrowException(SWIG_OCamlIndexOutOfBoundsException, $1.what());" +%typemap(throws) std::overflow_error "SWIG_OCamlThrowException(SWIG_OCamlArithmeticException, $1.what());" +%typemap(throws) std::range_error "SWIG_OCamlThrowException(SWIG_OCamlIndexOutOfBoundsException, $1.what());" +%typemap(throws) std::runtime_error "SWIG_OCamlThrowException(SWIG_OCamlRuntimeException, $1.what());" +%typemap(throws) std::underflow_error "SWIG_OCamlThrowException(SWIG_OCamlArithmeticException, $1.what());" diff --git a/Lib/ocaml/typecheck.i b/Lib/ocaml/typecheck.i index 416fd9495..2cc8dcbec 100644 --- a/Lib/ocaml/typecheck.i +++ b/Lib/ocaml/typecheck.i @@ -163,19 +163,16 @@ unsigned int, unsigned long, unsigned short { - SWIG_exception($1,"Thrown exception from C++ (int)"); + char error_msg[256]; + sprintf(error_msg, "C++ $1_type exception thrown, value: %d", $1); + SWIG_OCamlThrowException(SWIG_OCamlRuntimeException, error_msg); } -%typemap(throws) SWIGTYPE CLASS { - $&1_ltype temp = new $1_ltype($1); - SWIG_exception((int)temp,"Thrown exception from C++ (object)"); -} - -%typemap(throws) SWIGTYPE { +%typemap(throws) SWIGTYPE, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE *, SWIGTYPE [], SWIGTYPE [ANY] { (void)$1; - SWIG_exception(0,"Thrown exception from C++ (unknown)"); + SWIG_OCamlThrowException(SWIG_OCamlRuntimeException, "C++ $1_type exception thrown"); } %typemap(throws) char * { - SWIG_exception(0,$1); + SWIG_OCamlThrowException(SWIG_OCamlRuntimeException, $1); } diff --git a/Lib/std_except.i b/Lib/std_except.i index 50b5a88a2..0f8b23e70 100644 --- a/Lib/std_except.i +++ b/Lib/std_except.i @@ -19,7 +19,7 @@ * a new std_except.i file in the target library directory. * ----------------------------------------------------------------------------- */ -#if defined(SWIGJAVA) || defined(SWIGCSHARP) || defined(SWIGGUILE) || defined(SWIGUTL) || defined(SWIGD) +#if defined(SWIGJAVA) || defined(SWIGCSHARP) || defined(SWIGGUILE) || defined(SWIGUTL) || defined(SWIGD) || defined(SWIGOCAML) #error "This version of std_except.i should not be used" #endif