Merge branch 'ZackerySpytz-OCaml-exception-improvements'

* ZackerySpytz-OCaml-exception-improvements:
  [OCaml] Some exception improvements

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")
+;;

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");

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)

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";
+;;

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");
+;;

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);
+;;

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";
+;;