Merge branch 'ZackerySpytz-OCaml-director-ctors'

* ZackerySpytz-OCaml-director-ctors:
  [OCaml] Fix a bug in the ctors of director classes

Examples/test-suite/ocaml/director_default_runme.ml

@@ -0,0 +1,25 @@
+open Swig
+open Director_default
+
+let director_default_MyFoo ob meth args =
+  match meth with
+      "Msg" -> (match args with
+                  | C_list [ msg ] -> C_string ("director_default_MyFoo-" ^ (msg as string))
+                  | _ -> raise (Failure "director_default_MyFoo::Msg()"))
+    | _ -> (invoke ob) meth args
+
+let _ =
+  let a = new_derived_object new_Foo (director_default_MyFoo) '(10) in
+  assert (a -> GetMsg () as string = "director_default_MyFoo-default");
+  assert (a -> GetMsg ("boo") as string = "director_default_MyFoo-boo");
+  let f = new_Foo '(10) in
+  assert (f -> GetMsg () as string = "Foo-default");
+  assert (f -> GetMsg ("boo") as string = "Foo-boo");
+
+  let b = new_Bar '(1) in
+  assert (b -> GetMsg () as string = "Bar-default");
+  assert (b -> GetMsg ("boo") as string = "Bar-boo");
+  let b2 = new_Bar '() in
+  assert (b2 -> GetMsg () as string = "Bar-default");
+  assert (b2 -> GetMsg ("boo") as string = "Bar-boo");
+;;

Lib/ocaml/std_string.i

@@ -70,6 +70,11 @@ class wstring;
   swig_result =	caml_list_append(swig_result,caml_val_string_len((*$1).c_str(), (*$1).size()));
 }
 
+%typemap(directorin) string {
+    swig_result = caml_val_string_len($1.c_str(), $1.size());
+    args = caml_list_append(args, swig_result);
+}
+
 %typemap(directorout) string {
 	$result.assign((char *)caml_ptr_val($input,0), caml_string_len($input));
 }

Lib/ocaml/swig.ml

@@ -44,6 +44,13 @@ let _ = Callback.register "swig_runmethod" invoke
 let fnhelper arg =
   match arg with C_list l -> l | C_void -> [] | _ -> [ arg ]
 
+let director_core_helper fnargs =
+  try
+    match List.hd fnargs with
+      | C_director_core (o,r) -> fnargs
+      | _ -> C_void :: fnargs
+  with Failure _ -> C_void :: fnargs
+
 let rec get_int x = 
   match x with
       C_bool b -> if b then 1 else 0

Lib/ocaml/swig.mli

@@ -30,6 +30,7 @@ exception NoSuchClass of string
 
 val invoke : ('a c_obj_t) -> (string -> 'a c_obj_t -> 'a c_obj_t)
 val fnhelper : 'a c_obj_t -> 'a c_obj_t list
+val director_core_helper : 'a c_obj_t list -> 'a c_obj_t list
 
 val get_int : 'a c_obj_t -> int
 val get_float : 'a c_obj_t -> float

Source/Modules/ocaml.cxx

@@ -762,14 +762,15 @@ public:
       }
     }
 
-    if (expose_func)
-      Printf(f_mlbody,
-	     "external %s_f : c_obj list -> c_obj list = \"%s\" ;;\n"
-	     "let %s arg = match %s_f (fnhelper arg) with\n"
-	     "  [] -> C_void\n"
+    if (expose_func) {
+      Printf(f_mlbody, "external %s_f : c_obj list -> c_obj list = \"%s\" ;;\n", mangled_name, wname);
+      Printf(f_mlbody, "let %s arg = match %s_f (%s(fnhelper arg)) with\n", mangled_name, mangled_name,
+	     in_constructor && Swig_directorclass(getCurrentClass()) ? "director_core_helper " : "");
+      Printf(f_mlbody, "  [] -> C_void\n"
 	     "| [x] -> (if %s then Gc.finalise \n"
 	     "  (fun x -> ignore ((invoke x) \"~\" C_void)) x) ; x\n"
-	     "| lst -> C_list lst ;;\n", mangled_name, wname, mangled_name, mangled_name, newobj ? "true" : "false");
+	     "| lst -> C_list lst ;;\n", newobj ? "true" : "false");
+    }
 
     if ((!classmode || in_constructor || in_destructor || static_member_function) && expose_func)
       Printf(f_mlibody, "val %s : c_obj -> c_obj\n", mangled_name);