Director: added disown. It now mutates the reference held by the object.

mlheading and mliheading: Added C_director_core, which holds the state needed
by the director to disown.
std_string and std_vector: Added specific support for the common case of
a zero-terminated char **.
typemaps.i: Withdraw default argout for SWIGTYPE &


git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@4481 626c5289-ae23-0410-ae9c-e8d60b6d4f22

Lib/ocaml/director.swg

@@ -95,6 +95,9 @@ public:
     
     /* discard our reference at destruction */
     virtual ~__DIRECTOR__() {
+	__disown(); 
+        // Disown is safe here because we're just divorcing a reference that
+	// points to us.  
     }
     
     /* return a pointer to the wrapped ocaml object */
@@ -146,6 +149,7 @@ public:
 	assert(_self); 
 	if (!_disown) { 
 	    _disown=1;
+	    callback(*caml_named_value("caml_obj_disown"),_self);
 	} 
     }
 };
@@ -162,3 +166,32 @@ int __DIRECTOR__::_mutex_active = 0;
 
 %}
 
+%insert(mli) %{
+    val new_derived_object: 
+	(c_obj -> c_obj) ->
+	(c_obj -> string -> c_obj -> c_obj) ->
+	c_obj -> c_obj
+%}
+
+%insert(ml) %{
+let new_derived_object cfun x_class args =
+  begin
+    let get_object ob =
+      match !ob with
+          None ->
+    raise (NotObject C_void)
+        | Some o -> o in
+    let class_fun class_f ob_r =
+    (fun meth args -> class_f (get_object ob_r) meth args) in
+    let ob_ref = ref None in
+    let new_class = class_fun x_class ob_ref in
+    let obj =
+    cfun (match args with
+                C_list argl ->
+	  (C_list ((C_obj new_class) :: argl))
+	  | a -> (C_list [ C_director_core 
+			   (C_obj new_class,ob_ref)  ; a ])) in
+    ob_ref := Some obj ;
+      obj
+  end
+%}

Lib/ocaml/mlheading.swg

@@ -21,6 +21,7 @@ type c_obj =
   | C_obj of (string -> c_obj -> c_obj)
   | C_string of string
   | C_enum of c_enum_tag
+  | C_director_core of c_obj * c_obj option ref
 exception BadArgs of string
 exception BadMethodName of c_obj * string * string
 exception NotObject of c_obj
@@ -85,6 +86,17 @@ let rec get_bool x =
     | _ -> 
 	(try if get_int x != 0 then true else false
 	 with _ -> raise (Failure "Can't convert to bool"))
+
+let disown_object obj = 
+  match obj with
+      C_director_core (o,r) -> r := None
+    | _ -> raise (Failure "Not a director core object")
+let _ = Callback.register "caml_obj_disown" disown_object
+let director_get_self obj = 
+  match obj with
+      C_director_core (self,r) -> self
+    | _ -> raise (Failure "Not a director core object")
+let _ = Callback.register "caml_director_get_self" director_get_self
       
 let addr_of obj = (invoke obj) "&" C_void
 let _ = Callback.register "caml_obj_ptr" addr_of

Lib/ocaml/mliheading.swg

@@ -18,6 +18,7 @@ type c_obj =
   | C_obj of (string -> c_obj -> c_obj)
   | C_string of string
   | C_enum of c_enum_tag
+  | C_director_core of c_obj * c_obj option ref
 exception BadArgs of string
 exception BadMethodName of c_obj * string * string
 exception NotObject of c_obj

Lib/ocaml/ocaml.swg

@@ -23,6 +23,7 @@ extern "C" {
 #define C_obj 14
 #define C_string 15
 #define C_enum 16
+#define C_director_core 17
 
 /* Cast a pointer if possible; returns 1 if successful */
     
@@ -114,8 +115,15 @@ extern "C" {
 	    break;
 
 	case C_ptr:
-	    fprintf( stderr, "PTR(%p) ", caml_ptr_val(v,0) );
+	{
-	    break;
+	    void *vout = 0;
+	    caml_ptr_val_internal(v,&vout,0);
+	    swig_type_info *ty = (swig_type_info *)Int64_val(Field(v,1));
+	    fprintf( stderr, "PTR(%p,%s) ", 
+		     vout,
+		     ty ? ty->name : "(null)" );
+	}
+	break;
 	case C_array:
 	{
 	    unsigned int i;
@@ -130,8 +138,12 @@ extern "C" {
 	    fprintf( stderr, "OBJ(%p) ", (void *)Field(v,0) );
 	    break;
 	case C_string:
-	    fprintf( stderr, "'%s' ", (char *)caml_ptr_val(v,0) );
+	{
-	    break;
+	    void *cout;
+	    caml_ptr_val_internal(v,&cout,0);
+	    fprintf( stderr, "'%s' ", (char *)cout );
+	} 
+	break;
 	}
     }
 
@@ -444,6 +456,9 @@ extern "C" {
 
     SWIGSTATIC void *caml_ptr_val( value v, swig_type_info *descriptor ) {
 	CAMLparam0();
+#ifdef TYPE_CAST_VERBOSE
+	caml_print_val( v );
+#endif
 	void *out = NULL;
 	if( !caml_ptr_val_internal( v, &out, descriptor ) )
 	    CAMLreturn(out);

Lib/ocaml/std_string.i

@@ -17,8 +17,11 @@
 
 %{
 #include <string>
+#include <vector>
 %}
 
+%include std_vector.i
+
 namespace std {
     template <class charT> class basic_string {
     public:
@@ -113,3 +116,32 @@ namespace std {
     }
 }
 
+%template (StringVector) std::vector<string >;
+
+char **c_charptr_array( const std::vector <string > &str_v );
+
+%{
+  SWIGEXT char **c_charptr_array( const std::vector <string > &str_v ) {
+    char **out = new char *[str_v.size() + 1];
+    out[str_v.size()] = 0;
+    for( int i = 0; i < str_v.size(); i++ ) {
+      out[i] = (char *)str_v[i].c_str();
+    }
+    return out;
+  }
+%}
+
+%insert(ml) %{
+  (* Some STL convenience items *)
+
+  let string_array_to_vector sa = 
+    let nv = _new_StringVector C_void in
+      array_to_vector nv (fun x -> C_string x) sa ; nv
+	
+  let c_string_array ar = 
+    _c_charptr_array (string_array_to_vector ar)
+%}
+
+%insert(mli) %{
+  val c_string_array: string array -> c_obj
+%}

Lib/ocaml/std_vector.i

@@ -58,5 +58,35 @@ namespace std {
 		(*self)[i] = x;
 	    }
 	};
+	%extend {
+	    T *to_array() {
+		T *array = new T[self->size() + 1];
+		array[self->size()] = T();
+		for( int i = 0; i < self->size(); i++ ) 
+		    array[i] = (*self)[i];
+		return array;
+	    }
+	};
     };
 };
+
+%insert(ml) %{
+  
+  let array_to_vector v argcons array = 
+    for i = 0 to (Array.length array) - 1 do
+	(invoke v) "set" (C_list [ C_int i ; (argcons array.(i)) ])
+    done ;
+    v
+    
+  let vector_to_array v argcons array =
+    for i = 0; to (get_int ((invoke v) "size" C_void)) - 1 do
+	array.(i) <- argcons ((invoke v) "[]" (C_int i))
+    done ; 
+    v
+      
+%}
+
+%insert(mli) %{
+    val array_to_vector : c_obj -> ('a -> c_obj) -> 'a array -> c_obj
+    val vector_to_array : c_obj -> (c_obj -> 'a) -> 'a array -> c_obj
+%}

Lib/ocaml/typemaps.i

@@ -86,6 +86,7 @@
     }
 }
 
+#if 0
 %typemap(ocaml,argout) SWIGTYPE & {
     value *fromval = caml_named_value("create_$ntype_from_ptr");
     if( fromval ) {
@@ -99,6 +100,9 @@
 			     caml_val_ptr ((void *) $1,$1_descriptor));
     }
 }
+#endif
+
+%typemap(ocaml,argout) const SWIGTYPE & { }
 
 %typemap(ocaml,in) SWIGTYPE {
     $1 = *(($&1_ltype) caml_ptr_val($input,$&1_descriptor)) ;