shapes example: slight correction to depth map.

makedebugtop: include swig.cmo
Lib: factored out more common code, slightly reorganized class type.
     added director define and exceptions.
     std_string: length from the original ocaml string (no longer depends on
      null termination)
     ocamldec.swg/ocaml.swg: added caml_string_len
Examples/Makefile.in: quiet about checking out files.
Ocaml.cxx:
     Fixed abstract director test case.
     Include/exclude director.swg based on directors being enabled.
Final edits for 1.3.20, barring bugs being discovered.


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

15 files changed, 261 insertions, 214 deletions

diff --git a/Examples/Makefile.in b/Examples/Makefile.in
index 5e0b77b1c..a4e970778 100644
--- a/Examples/Makefile.in
+++ b/Examples/Makefile.in
@@ -550,9 +550,10 @@ OCAMLMKTOP=@OCAMLMKTOP@ $(SWIGWHERE)
 NOLINK ?= false
 OCAMLPP= -pp "camlp4o ./swigp4.cmo"
 OCAMLCORE=\
-	$(SWIG) -ocaml -co swig.mli ; \
-	$(SWIG) -ocaml -co swig.ml ; \
-	$(SWIG) -ocaml -co swigp4.ml ; \
+	rm -rf swig.mli swig.ml swigp4.ml ;\
+	$(SWIG) -ocaml -co swig.mli 2>/dev/null ; \
+	$(SWIG) -ocaml -co swig.ml 2>/dev/null ; \
+	$(SWIG) -ocaml -co swigp4.ml 2>/dev/null ; \
 	$(OCC) -c swig.mli ; \
 	$(OCC) -c swig.ml ; \
 	$(OCC) -I `camlp4 -where` -pp "camlp4o pa_extend.cmo q_MLast.cmo" \
diff --git a/Examples/ocaml/shapes/example.c b/Examples/ocaml/shapes/example.c
index ecf74cefd..c278eb15a 100644
--- a/Examples/ocaml/shapes/example.c
+++ b/Examples/ocaml/shapes/example.c
@@ -21,7 +21,7 @@ void draw_shape_coverage( shape *s, int div_x, int div_y ) {
 
 void draw_depth_map( volume *v, int div_x, int div_y ) {
     double i,j;
-    char depth_map_chars[] = "#*+;:,. ";
+    char depth_map_chars[] = "#*+o;:,. ";
     double lowbound, highbound;
     double current = 0.0;
     bool bounds_set = false;
diff --git a/Examples/ocaml/strings_test/runme.ml b/Examples/ocaml/strings_test/runme.ml
index 8d3516e9f..0eb56379c 100644
--- a/Examples/ocaml/strings_test/runme.ml
+++ b/Examples/ocaml/strings_test/runme.ml
@@ -1,5 +1,6 @@
 (* This example is meant to reach every case in cstring.i *)
 
+open Swig
 open Example
 
 let _ = _takes_std_string (C_string "foo")
diff --git a/Examples/test-suite/ocaml/makedebugtop b/Examples/test-suite/ocaml/makedebugtop
index 4a64bb74e..d51439a75 100755
--- a/Examples/test-suite/ocaml/makedebugtop
+++ b/Examples/test-suite/ocaml/makedebugtop
@@ -18,4 +18,4 @@ echo "Making the test"
 make $swigtest
 echo "Building ${thetest}_top"
 gcc -c -g $cppopt -I$OCAMLINC ${thetest}_wrap.c
-ocamlmktop -cclib -g -custom ${thetest}_wrap.o ${thetest}.cmo -o ${thetest}_top -cclib -lstdc++
+ocamlmktop -cclib -g -custom swig.cmo ${thetest}_wrap.o ${thetest}.cmo -o ${thetest}_top -cclib -lstdc++
diff --git a/Examples/test-suite/ocaml/results b/Examples/test-suite/ocaml/results
deleted file mode 100644
index e69de29bb..000000000
--- a/Examples/test-suite/ocaml/results
+++ /dev/null
diff --git a/Lib/ocaml/class.swg b/Lib/ocaml/class.swg
index 253600ce9..135ccaa9a 100644
--- a/Lib/ocaml/class.swg
+++ b/Lib/ocaml/class.swg
@@ -1,24 +1,7 @@
 (*Stream:class_ctors*)
 let create_$classname_from_ptr raw_ptr =
   C_obj 
-    (let rec method_table = [
-       "nop", (fun args -> C_void) ;
-       $classbody
-	 "&", (fun args -> raw_ptr) ;
-       ":parents",
-       (fun args ->
-          C_list
-          (List.map
-	     (fun (x,y) ->
-		C_string (String.sub x 2 ((String.length x) - 2)))
-	     (List.filter
-		(fun (x,y) ->
-		   ((String.length x) > 2)
-		   && x.[0] == ':' && x.[1] == ':') method_table))) ;
-       ":classof", (fun args -> C_string "$realname") ;
-       ":methods", (fun args -> C_list (List.map (fun (x,y) -> C_string x)
-					  method_table)) ] in
-       (fun mth arg ->
+    (let rec invoke_inner raw_ptr mth arg = 
 	  try
 	    let method_name,application = 
 	      List.hd 
@@ -47,7 +30,25 @@ let create_$classname_from_ptr raw_ptr =
 		      | [] ->
 			  raise (BadMethodName (raw_ptr,mth,"$realname"))
 		  in try_parent parent_classes raw_ptr
-		end))
+		end 
+     and method_table = [
+       "nop", (fun args -> C_void) ;
+       $classbody
+	 "&", (fun args -> raw_ptr) ;
+       ":parents",
+       (fun args ->
+          C_list
+          (List.map
+	     (fun (x,y) ->
+		C_string (String.sub x 2 ((String.length x) - 2)))
+	     (List.filter
+		(fun (x,y) ->
+		   ((String.length x) > 2)
+		   && x.[0] == ':' && x.[1] == ':') method_table))) ;
+       ":classof", (fun args -> C_string "$realname") ;
+       ":methods", (fun args -> C_list (List.map (fun (x,y) -> C_string x)
+					  method_table)) ] in
+       (fun mth arg -> invoke_inner raw_ptr mth arg))
 
 let _ = Callback.register 
           "create_$normalized_from_ptr"
diff --git a/Lib/ocaml/director.swg b/Lib/ocaml/director.swg
index 72dfabf89..2baa952a6 100644
--- a/Lib/ocaml/director.swg
+++ b/Lib/ocaml/director.swg
@@ -9,13 +9,37 @@
  * Original Author : Mark Rose (mrose@stm.lbl.gov)
  ************************************************************************/
 
-%insert(runtime) %{
-
 #ifdef __cplusplus
 
 #include <string>
 
 namespace Swig {
+  /* base class for director exceptions */
+  class DirectorException {
+    protected:
+      std::string swig_msg;
+    public:
+      DirectorException(const char* msg="") {
+      }
+      const char *getMessage() const { 
+        return swig_msg.c_str(); 
+      }
+      virtual ~DirectorException() {}
+  };
+
+  /* type mismatch in the return value from a python method call */
+  class DirectorTypeMismatchException : public Swig::DirectorException {
+    public:
+      DirectorTypeMismatchException(const char* msg="") {
+      }
+  };
+
+  /* any python exception that occurs during a director method call */
+  class DirectorMethodException : public Swig::DirectorException {};
+
+  /* attempt to call a pure virtual method via a director method */
+  class DirectorPureVirtualException : public Swig::DirectorException {};
+
   /* simple thread abstraction for pthreads on win32 */
 #ifdef __THREAD__
 #define __PTHREAD__
@@ -37,8 +61,7 @@ namespace Swig {
       CAML_VALUE swig_self;
       /* flag indicating whether the object is owned by ocaml or c++ */
       mutable bool swig_disown_flag;
-      /* shared flag for breaking recursive director calls */
-      static bool swig_up;
+      mutable bool swig_up;
 
 #ifdef __PTHREAD__
       /* locks for sharing the swig_up flag in a threaded environment */
@@ -50,19 +73,20 @@ namespace Swig {
       /* reset the swig_up flag once the routing direction has been determined */
 #ifdef __PTHREAD__
       void swig_clear_up() const { 
-        Swig::Director::swig_up = false; 
+        swig_up = false; 
         Swig::Director::swig_mutex_active = false;
         pthread_mutex_unlock(&swig_mutex_up);
       }
+
 #else
       void swig_clear_up() const { 
-        Swig::Director::swig_up = false; 
+        swig_up = false; 
       }
 #endif
 
     public:
       /* wrap a ocaml object, optionally taking ownership */
-      Director(CAML_VALUE self, bool disown = false) : swig_self(self), swig_disown_flag(disown) {
+      Director(CAML_VALUE self, bool disown = false) : swig_self(self), swig_disown_flag(disown), swig_up( false ) {
         register_global_root(&swig_self);
       }
 
@@ -76,27 +100,28 @@ namespace Swig {
 
       /* return a pointer to the wrapped ocaml object */
       CAML_VALUE swig_get_self() const { 
-        return callback(*caml_named_value("caml_director_get_self"),swig_self); 
+	  return swig_self;
       }
 
       /* get the swig_up flag to determine if the method call should be routed
        * to the c++ base class or through the wrapped ocaml object
        */
 #ifdef __PTHREAD__
-      bool swig_get_up() const { 
+      bool swig_get_up( bool clear = true ) const { 
         if (Swig::Director::swig_mutex_active) {
           if (pthread_equal(Swig::Director::swig_mutex_thread, pthread_self())) {
             bool up = swig_up;
-            swig_clear_up();
+            if( clear ) swig_clear_up();
             return up;
           }
         }
         return false;
       }
+
 #else 
-      bool swig_get_up() const { 
+      bool swig_get_up( bool clear = true ) const { 
         bool up = swig_up;
-        swig_up = false;
+        if( clear ) swig_up = false;
         return up;
       }
 #endif
@@ -109,11 +134,11 @@ namespace Swig {
         pthread_mutex_lock(&Swig::Director::swig_mutex_up);
         Swig::Director::swig_mutex_thread = pthread_self();
         Swig::Director::swig_mutex_active = true;
-        Swig::Director::swig_up = true; 
+        swig_up = true; 
       }
 #else 
       void swig_set_up() const { 
-        Swig::Director::swig_up = true; 
+        swig_up = true; 
       }
 #endif
 
@@ -127,8 +152,6 @@ namespace Swig {
       }
   };
 
-  bool Swig::Director::swig_up = false;
-
 #ifdef __PTHREAD__
   MUTEX_INIT(Swig::Director::swig_mutex_up);
   pthread_t Swig::Director::swig_mutex_thread;
@@ -138,49 +161,3 @@ namespace Swig {
 }
 
 #endif /* __cplusplus */
-
-%}
-
-%insert(mli) %{
-    val new_derived_object: 
-        (c_obj -> c_obj) ->
-        (c_obj -> string -> c_obj -> c_obj) ->
-        c_obj -> c_obj
-%}
-
-%insert(ml) %{
-let invoke obj = match obj with C_obj o -> o | _ -> raise (NotObject obj)
-let _ = Callback.register "swig_runmethod" invoke
-
-let fnhelper fin f arg =
-  let args = match arg with C_list l -> l | C_void -> [] | _ -> [ arg ] in
-    match f args with
-	[] -> C_void
-      | [ x ] -> (if fin then Gc.finalise 
-		    (fun x -> ignore ((invoke x) "~" C_void)) x) ; x
-      | lst -> C_list lst
-
-let addr_of obj = (invoke obj) "&" C_void
-let _ = Callback.register "caml_obj_ptr" addr_of
-
-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_director_core (C_obj new_class,ob_ref)) :: argl))
-          | a -> (C_list [ C_director_core 
-                           (C_obj new_class,ob_ref)  ; a ])) in
-    ob_ref := Some obj ;
-      obj
-  end
-%}
diff --git a/Lib/ocaml/ocaml.i b/Lib/ocaml/ocaml.i
index 3d77eec20..84659ddb0 100644
--- a/Lib/ocaml/ocaml.i
+++ b/Lib/ocaml/ocaml.i
@@ -32,4 +32,3 @@
 %include "typecheck.i"
 %include "exception.i"
 %include "preamble.swg"
-%include "director.swg"
diff --git a/Lib/ocaml/ocaml.swg b/Lib/ocaml/ocaml.swg
index 70c15b526..9d42f9018 100644
--- a/Lib/ocaml/ocaml.swg
+++ b/Lib/ocaml/ocaml.swg
@@ -162,6 +162,7 @@ extern "C" {
 	    fprintf( stderr, "]\n" );
 	    v = SWIG_Field(v,1);
 	}
+	CAMLreturn0;
     }
 
     SWIGSTATIC CAML_VALUE caml_list_nth( CAML_VALUE lst, int n ) {
@@ -341,7 +342,7 @@ extern "C" {
 	CAMLparam0();
 	SWIG_CAMLlocal1(fv);
 	fv = caml_swig_alloc(1,C_float);
-	SWIG_Store_field(fv,0,copy_double(f));
+	SWIG_Store_field(fv,0,copy_double((double)f));
 	CAMLreturn(fv);
     }
 
@@ -511,6 +512,15 @@ extern "C" {
 	return (char *)caml_ptr_val( v, 0 );
     }
 
+    SWIGSTATIC int caml_string_len( CAML_VALUE v ) {
+	switch( SWIG_Tag_val(v) ) {
+	case C_string:
+	    return string_length(SWIG_Field(v,0));
+	default:
+	    return strlen((char *)caml_ptr_val(v,0));
+	}
+    }
+
     SWIGSTATIC int caml_bool_check( CAML_VALUE v ) {
 	CAMLparam1(v);
 	
diff --git a/Lib/ocaml/ocamldec.swg b/Lib/ocaml/ocamldec.swg
index 205afd234..6b6a3c4d8 100644
--- a/Lib/ocaml/ocamldec.swg
+++ b/Lib/ocaml/ocamldec.swg
@@ -140,6 +140,7 @@ CAMLextern int64 Int64_val(caml_value_t v);
     static void *caml_ptr_val( CAML_VALUE v, swig_type_info *descriptor );
 
     static char *caml_string_val( CAML_VALUE v );
+    static int caml_string_len( CAML_VALUE v );
 
 #ifdef __cplusplus
 }
diff --git a/Lib/ocaml/preamble.swg b/Lib/ocaml/preamble.swg
index 508371c51..9fedfcd72 100644
--- a/Lib/ocaml/preamble.swg
+++ b/Lib/ocaml/preamble.swg
@@ -6,8 +6,7 @@ exception BadMethodName of c_obj * string * string
 exception NotObject of c_obj
 exception NotEnumType of c_obj
 exception LabelNotFromThisEnum of c_obj
-
-val invoke : c_obj -> (string -> c_obj -> c_obj)
+exception InvalidDirectorCall of c_obj
 %}
 
 %insert(ml) %{
@@ -18,4 +17,5 @@ exception BadMethodName of c_obj * string * string
 exception NotObject of c_obj
 exception NotEnumType of c_obj
 exception LabelNotFromThisEnum of c_obj
+exception InvalidDirectorCall of c_obj
 %}
\ No newline at end of file
diff --git a/Lib/ocaml/std_string.i b/Lib/ocaml/std_string.i
index 3f6647f36..cca4ecfd0 100644
--- a/Lib/ocaml/std_string.i
+++ b/Lib/ocaml/std_string.i
@@ -81,14 +81,16 @@ namespace std {
     /* Overloading check */
     %typemap(in) string {
         if (caml_ptr_check($input))
-            $1 = std::string((char *)caml_ptr_val($input,0));
+            $1 = std::string((char *)caml_ptr_val($input,0),
+			     caml_string_len($input));
         else
             SWIG_exception(SWIG_TypeError, "string expected");
     }
 
     %typemap(in) const string & (std::string temp) {
         if (caml_ptr_check($input)) {
-            temp = std::string((char *)caml_ptr_val($input,0));
+            temp = std::string((char *)caml_ptr_val($input,0),
+			       caml_string_len($input));
             $1 = &temp;
         } else {
             SWIG_exception(SWIG_TypeError, "string expected");
@@ -97,7 +99,8 @@ namespace std {
 
     %typemap(in) string & (std::string temp) {
         if (caml_ptr_check($input)) {
-            temp = std::string((char *)caml_ptr_val($input,0));
+            temp = std::string((char *)caml_ptr_val($input,0),
+			       caml_string_len($input));
             $1 = &temp;
         } else {
             SWIG_exception(SWIG_TypeError, "string expected");
@@ -106,7 +109,8 @@ namespace std {
 
     %typemap(in) string * (std::string *temp) {
         if (caml_ptr_check($input)) {
-            temp = new std::string((char *)caml_ptr_val($input,0));
+            temp = new std::string((char *)caml_ptr_val($input,0),
+				   caml_string_len($input));
             $1 = temp;
         } else {
             SWIG_exception(SWIG_TypeError, "string expected");
@@ -122,6 +126,11 @@ namespace std {
 							 (*$1).size()));
     }
 
+    %typemap(directorout) string {
+	$result = std::string((char *)caml_ptr_val($input,0),
+			      caml_string_len($input));
+    }
+
     %typemap(out) string {
         $result = caml_val_string_len($1.c_str(),$1.size());
     }
diff --git a/Lib/ocaml/swig.ml b/Lib/ocaml/swig.ml
index 60917c57e..a9044d1b7 100644
--- a/Lib/ocaml/swig.ml
+++ b/Lib/ocaml/swig.ml
@@ -23,16 +23,22 @@ type 'a c_obj_t =
   | C_enum of 'a
   | C_director_core of 'a c_obj_t * 'a c_obj_t option ref
 
-type empty_enum = [ `Int of int ]
+type empty_enum = [ `SWIGFake | `Int of int ]
 
 exception BadArgs of string
 exception BadMethodName of string * string
 exception NotObject of empty_enum c_obj_t
 exception NotEnumType of empty_enum c_obj_t
 exception LabelNotFromThisEnum of empty_enum c_obj_t
+exception InvalidDirectorCall of empty_enum c_obj_t
 
-let invoke obj = match obj with C_obj o -> o | _ -> raise (NotObject (Obj.magic obj))
+let rec invoke obj = 
+  match obj with 
+      C_obj o -> o 
+    | C_director_core (o,r) -> invoke o
+    | _ -> raise (NotObject (Obj.magic obj))
 let _ = Callback.register "swig_runmethod" invoke
+
 let fnhelper fin f arg =
   let args = match arg with C_list l -> l | C_void -> [] | _ -> [ arg ] in
     match f args with
@@ -95,14 +101,12 @@ let disown_object obj =
       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 = 
+let addr_of obj = 
   match obj with
-      C_obj o -> obj
-    | 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
+      C_obj _ -> (invoke obj) "&" C_void
+    | C_director_core (self,r) -> (invoke self) "&" C_void
+    | C_ptr _ -> obj
+    | _ -> raise (Failure "Not a pointer.")
 let _ = Callback.register "caml_obj_ptr" addr_of
 
 let convert_c_obj a = Obj.magic a
@@ -122,3 +126,23 @@ let make_uint i = C_uint (Int32.of_int i)
 let make_int32 i = C_int32 (Int32.of_int i)
 let make_int64 i = C_int64 (Int64.of_int i)
 
+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 ob_ref = ref None in
+    let class_fun class_f ob_r =
+      (fun meth args -> class_f (get_object ob_r) meth args) in
+    let new_class = class_fun x_class ob_ref in
+    let dircore = C_director_core (C_obj new_class,ob_ref) in
+    let obj =
+    cfun (match args with
+            C_list argl -> (C_list ((dircore :: argl)))
+	  | C_void -> (C_list [ dircore ])
+          | a -> (C_list [ dircore ; a ])) in
+    ob_ref := Some obj ;
+      obj
+  end
diff --git a/Lib/ocaml/swig.mli b/Lib/ocaml/swig.mli
index e7198b73b..9501ee971 100644
--- a/Lib/ocaml/swig.mli
+++ b/Lib/ocaml/swig.mli
@@ -20,8 +20,13 @@ type 'a c_obj_t =
   | C_enum of 'a
   | C_director_core of 'a c_obj_t * 'a c_obj_t option ref
 
+type empty_enum = [ `SWIGFake | `Int of int ]
+
+exception InvalidDirectorCall of empty_enum c_obj_t
+
 val invoke : 'a c_obj_t -> (string -> 'a c_obj_t -> 'a c_obj_t)
 val convert_c_obj : 'a c_obj_t -> 'b c_obj_t
+val fnhelper : bool -> ('a c_obj_t list -> 'a c_obj_t list) -> 'a c_obj_t -> 'a c_obj_t
 
 val get_int : 'a c_obj_t -> int
 val get_float : 'a c_obj_t -> float
@@ -44,3 +49,8 @@ val make_uint : int -> 'a c_obj_t
 val make_int32 : int -> 'a c_obj_t
 val make_int64 : int -> 'a c_obj_t
 
+val new_derived_object: 
+  ('a c_obj_t -> 'a c_obj_t) ->
+  ('a c_obj_t -> string -> 'a c_obj_t -> 'a c_obj_t) ->
+  'a c_obj_t -> 'a c_obj_t
+  
diff --git a/Source/Modules/ocaml.cxx b/Source/Modules/ocaml.cxx
index 34ed94b65..d8684db81 100755
--- a/Source/Modules/ocaml.cxx
+++ b/Source/Modules/ocaml.cxx
@@ -258,9 +258,10 @@ public:
 		"let enum_to_int x v =\n"
 		"  match v with C_enum y -> (\n"
 		"  match (x : c_enum_type) with\n"
-		"   `unknown -> (match (y : c_enum_tag) with\n"
-		"     `int (x : int) -> C_int x\n"
-		"   | _ -> (raise (LabelNotFromThisEnum v)))\n" );
+		"   `unknown -> "
+		"    (match (y : c_enum_tag) with\n"
+		"      `int (x : int) -> C_int x\n"
+		"    | _ -> raise (LabelNotFromThisEnum v))\n" );
 
 	Printf( f_int_to_enum,
 		"let int_to_enum x y =\n"
@@ -268,6 +269,11 @@ public:
 		"      `unknown -> C_enum (`int y)\n" );
 
 	Swig_banner (f_runtime);
+
+	if( directorsEnabled() ) {
+	    Printf( f_runtime, "#define SWIG_DIRECTORS\n");
+	    Swig_insert_file("director.swg", f_directors_h);
+	}
     
 	if (NoInclude) {
 	    Printf(f_runtime, "#define SWIG_NOINCLUDE\n");
@@ -276,7 +282,10 @@ public:
 	/* Produce the enum_to_int and int_to_enum functions */
     
 	Printf(f_enumtypes_type,"type c_enum_type = [ \n  `unknown\n" );
-	Printf(f_enumtypes_value,"type c_enum_tag = [ \n  `int of int\n" );
+	Printf(f_enumtypes_value,
+	       "type c_enum_tag = [\n"
+	       "  `SWIGFake\n"
+	       "| `int of int\n" );
     
 	String *mlfile = NewString("");
 	String *mlifile = NewString("");
@@ -436,8 +445,6 @@ public:
 	int numargs;
 	int numreq;
 	int newobj = Getattr(n,"feature:new") ? 1 : 0;
-	Node *classNode = Swig_methodclass(n);
-	int hasVirtual = (classNode && (Getattr(classNode, "hasVirtual") != 0));
 	String *nodeType = Getattr(n, "nodeType");
 	int constructor = !Cmp(nodeType, "constructor");
 	String *storage = Getattr(n,"storage");
@@ -659,10 +666,13 @@ public:
 
 	if (CPlusPlus && directorsEnabled()) {
 	    if (!is_smart_pointer()) {
-		if (/*directorbase &&*/ hasVirtual && !constructor && isVirtual) {
+		if (/*directorbase &&*/ !constructor && isVirtual) {
 		    Wrapper_add_local(f, "director", "Swig::Director *director = 0");
 		    Printf(f->code, "director = dynamic_cast<Swig::Director *>(arg1);\n");
-		    Printf(f->code, "if (director && (director->swig_get_self()==argv[0])) director->swig_set_up();\n");
+			   
+		    Printf(f->code, 
+			   "if (director && !director->swig_get_up(false))"
+			   "director->swig_set_up();\n");
 		}
 	    }
 	}
@@ -834,81 +844,75 @@ public:
 	// Build the name for scheme.
 	Printv(proc_name, iname, NIL);
 	
-	if ((SwigType_type(t) != T_USER) || (is_a_pointer(t))) {
-	    
-	    Printf (f->def, 
-		    "SWIGEXT CAML_VALUE %s(CAML_VALUE args) {\n", var_name);
-	    // Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL);
-	    
-	    Wrapper_add_local (f, "swig_result", "CAML_VALUE swig_result");
-	    
-	    if (!Getattr(n,"feature:immutable")) {
-		/* Check for a setting of the variable value */
-		Printf (f->code, "if (args != Val_int(0)) {\n");
-		if ((tm = Swig_typemap_lookup_new("varin",n,name,0))) {
-		    Replaceall(tm,"$source","args");
-		    Replaceall(tm,"$target",name);
-		    Replaceall(tm,"$input","args");
-		    Printv(f->code, tm, "\n",NIL);
-		} else if ((tm = Swig_typemap_lookup_new("in",n,name,0))) {
-		    Replaceall(tm,"$source","args");
-		    Replaceall(tm,"$target",name);
-		    Replaceall(tm,"$input","args");
-		    Printv(f->code, tm, "\n",NIL);
-		} else {
-		    throw_unhandled_ocaml_type_error (t, "varin/in");
-		}
-		Printf (f->code, "}\n");
-	    }
-	    
-	    // Now return the value of the variable (regardless
-	    // of evaluating or setting)
-	    
-	    if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
-		Replaceall(tm,"$source",name);
-		Replaceall(tm,"$target","swig_result");
-		Replaceall(tm,"$result","swig_result");
-		Printf (f->code, "%s\n", tm);
-	    } else if ((tm   = Swig_typemap_lookup_new("out",n,name,0))) {
-		Replaceall(tm,"$source",name);
-		Replaceall(tm,"$target","swig_result");
-		Replaceall(tm,"$result","swig_result");
-		Printf (f->code, "%s\n", tm);
-		
+	Printf (f->def, 
+		"SWIGEXT CAML_VALUE %s(CAML_VALUE args) {\n", var_name);
+	// Printv(f->def, "#define FUNC_NAME \"", proc_name, "\"", NIL);
+	
+	Wrapper_add_local (f, "swig_result", "CAML_VALUE swig_result");
+	
+	if (!Getattr(n,"feature:immutable")) {
+	    /* Check for a setting of the variable value */
+	    Printf (f->code, "if (args != Val_int(0)) {\n");
+	    if ((tm = Swig_typemap_lookup_new("varin",n,name,0))) {
+		Replaceall(tm,"$source","args");
+		Replaceall(tm,"$target",name);
+		Replaceall(tm,"$input","args");
+		Printv(f->code, tm, "\n",NIL);
+	    } else if ((tm = Swig_typemap_lookup_new("in",n,name,0))) {
+		Replaceall(tm,"$source","args");
+		Replaceall(tm,"$target",name);
+		Replaceall(tm,"$input","args");
+		Printv(f->code, tm, "\n",NIL);
 	    } else {
-		throw_unhandled_ocaml_type_error (t, "varout/out");
+		throw_unhandled_ocaml_type_error (t, "varin/in");
 	    }
-	    
-	    Printf (f->code, "\nreturn swig_result;\n");
 	    Printf (f->code, "}\n");
+	}
 	    
-	    Wrapper_print (f, f_wrappers);
-	    
-	    // Now add symbol to the Ocaml interpreter
+	// Now return the value of the variable (regardless
+	// of evaluating or setting)
+	
+	if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
+	    Replaceall(tm,"$source",name);
+	    Replaceall(tm,"$target","swig_result");
+	    Replaceall(tm,"$result","swig_result");
+	    Printf (f->code, "%s\n", tm);
+	} else if ((tm   = Swig_typemap_lookup_new("out",n,name,0))) {
+	    Replaceall(tm,"$source",name);
+	    Replaceall(tm,"$target","swig_result");
+	    Replaceall(tm,"$result","swig_result");
+	    Printf (f->code, "%s\n", tm);
 	    
-	    if( Getattr( n, "feature:immutable" ) ) {
-		Printf( f_mlbody, 
-			"external __%s : c_obj -> c_obj = \"%s\" \n"
-			"let _%s = __%s C_void\n",
-			mname, var_name, mname, mname );
-		Printf( f_mlibody, "val _%s : c_obj\n", iname );
-		if( const_enum ) {
-		    Printf( f_enum_to_int, 
-			    " | `%s -> _%s\n", 
-			    mname, mname );
-		    Printf( f_int_to_enum, 
-			    " if y = (get_int _%s) then `%s else\n",
-			    mname, mname );
-		}
-	    } else {
-		Printf( f_mlbody, "external _%s : c_obj -> c_obj = \"%s\"\n",
-			mname, var_name );
-		Printf( f_mlibody, "external _%s : c_obj -> c_obj = \"%s\"\n",
-			mname, var_name );
+	} else {
+	    throw_unhandled_ocaml_type_error (t, "varout/out");
+	}
+	
+	Printf (f->code, "\nreturn swig_result;\n");
+	Printf (f->code, "}\n");
+	
+	Wrapper_print (f, f_wrappers);
+	
+	// Now add symbol to the Ocaml interpreter
+	
+	if( Getattr( n, "feature:immutable" ) ) {
+	    Printf( f_mlbody, 
+		    "external __%s : c_obj -> c_obj = \"%s\" \n"
+		    "let _%s = __%s C_void\n",
+		    mname, var_name, mname, mname );
+	    Printf( f_mlibody, "val _%s : c_obj\n", iname );
+	    if( const_enum ) {
+		Printf( f_enum_to_int, 
+			" | `%s -> _%s\n", 
+			mname, mname );
+		Printf( f_int_to_enum, 
+			" if y = (get_int _%s) then `%s else\n",
+			mname, mname );
 	    }
 	} else {
-	    Swig_warning(WARN_TYPEMAP_VAR_UNDEF, input_file, line_number,
-			 "Unsupported variable type %s (ignored).\n", SwigType_str(t,0));
+	    Printf( f_mlbody, "external _%s : c_obj -> c_obj = \"%s\"\n",
+		    mname, var_name );
+	    Printf( f_mlibody, "external _%s : c_obj -> c_obj = \"%s\"\n",
+		    mname, var_name );
 	}
 
 	Delete(proc_name);
@@ -1417,6 +1421,8 @@ public:
     int classDirectorMethod(Node *n, Node *parent, String *super) {
 	int is_void = 0;
 	int is_pointer = 0;
+	String *storage;
+	String *value;
 	String *decl;
 	String *type;
 	String *name;
@@ -1429,11 +1435,20 @@ public:
 	String *return_type;
 	int status = SWIG_OK;
 	int idx;
+	bool pure_virtual = false;
 
+	storage = Getattr(n, "storage");
+	value = Getattr(n, "value");
 	classname = Getattr(parent, "sym:name");
 	type = Getattr(n, "type");
 	name = Getattr(n, "name");
 
+	if (Cmp(storage,"virtual") == 0) {
+	    if (Cmp(value,"0") == 0) {
+		pure_virtual = true;
+	    }
+	}
+
 	w = NewWrapper();
 	declaration = NewString("");
 	Wrapper_add_local(w,"swig_result",
@@ -1589,9 +1604,15 @@ public:
 	Printf(w->code,"args = Val_unit;\n");
 
 	/* direct call to superclass if _up is set */
-	Printf(w->code, "if (swig_get_up()) {\n");
-	Printf(w->code,   "CAMLreturn(%s);\n", Swig_method_call(super,l));
-	Printf(w->code, "}\n");
+	if( pure_virtual ) {
+	    Printf(w->code, "if (swig_get_up()) {\n");
+	    Printf(w->code, "  throw Swig::DirectorPureVirtualException();\n");
+	    Printf(w->code, "}\n");
+	} else {
+	    Printf(w->code, "if (swig_get_up()) {\n");
+	    Printf(w->code,   "CAMLreturn(%s);\n", Swig_method_call(super,l));
+	    Printf(w->code, "}\n");
+	}
     
 	/* wrap complex arguments to values */
 	Printv(w->code, wrap_args, NIL);
@@ -1604,8 +1625,8 @@ public:
 	       "swig_result = Val_unit;\n",0);
 	Printf(w->code, 
 	       "swig_result = "
-	       "callback2(callback(*caml_named_value(\"swig_runmethod\"),"
-	       "swig_get_self()),copy_string(\"%s\"),args);\n",
+	       "callback3(*caml_named_value(\"swig_runmethod\"),"
+	       "swig_get_self(),copy_string(\"%s\"),args);\n",
 	       Getattr(n,"name"));
 	/* exception handling */
 	tm = Swig_typemap_lookup_new("director:except", n, "result", 0);
@@ -1635,38 +1656,31 @@ public:
 
 	idx = 0;
 
-	/* marshal return value */
-	if (!is_void) {
-	    /* this seems really silly.  the node's type excludes 
-	     * qualifier/pointer/reference markers, which have to be retrieved 
-	     * from the decl field to construct return_type.  but the typemap
-	     * lookup routine uses the node's type, so we have to swap in and
-	     * out the correct type.  it's not just me, similar silliness also
-	     * occurs in Language::cDeclaration().
-	     */
-	    Setattr(n, "type", return_type);
-	    tm = Swig_typemap_lookup_new("directorout", n, "c_result", w);
-	    Setattr(n, "type", type);
-	    if (tm == 0) {
-		String *name = NewString("c_result");
-		tm = Swig_typemap_search("directorout", return_type, name, NULL);
-		Delete(name);
-	    }
-	    if (tm != 0) {
-		Replaceall(tm, "$input", "swig_result");
-		/* TODO check this */
-		if (Getattr(n,"wrap:disown")) {
-		    Replaceall(tm,"$disown","SWIG_POINTER_DISOWN");
-		} else {
-		    Replaceall(tm,"$disown","0");
-		}
-		Replaceall(tm, "$result", "c_result");
-		Printv(w->code, tm, "\n", NIL);
+	/* this seems really silly.  the node's type excludes 
+	 * qualifier/pointer/reference markers, which have to be retrieved 
+	 * from the decl field to construct return_type.  but the typemap
+	 * lookup routine uses the node's type, so we have to swap in and
+	 * out the correct type.  it's not just me, similar silliness also
+	 * occurs in Language::cDeclaration().
+	 */
+	Setattr(n, "type", return_type);
+	tm = Swig_typemap_lookup_new("directorout", n, "c_result", w);
+	Setattr(n, "type", type);
+	if (tm == 0) {
+	    String *name = NewString("c_result");
+	    tm = Swig_typemap_search("directorout", return_type, name, NULL);
+	    Delete(name);
+	}
+	if (tm != 0) {
+	    Replaceall(tm, "$input", "swig_result");
+	    /* TODO check this */
+	    if (Getattr(n,"wrap:disown")) {
+		Replaceall(tm,"$disown","SWIG_POINTER_DISOWN");
 	    } else {
-		Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number,
-			     "Unable to return type %s in director method %s::%s (skipping method).\n", SwigType_str(return_type, 0), classname, name);
-		status = SWIG_ERROR;
+		Replaceall(tm,"$disown","0");
 	    }
+	    Replaceall(tm, "$result", "c_result");
+	    Printv(w->code, tm, "\n", NIL);
 	}
 	  
 	/* marshal outputs */