jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

shapes example: slight correction to depth map.

Browse source 
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@5477 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Art Yerkes 2003-12-04 06:15:07 +00:00
commit fbb9c8481d
15 changed files with 261 additions and 214 deletions
Download patch file Download diff file Expand all files Collapse all files

7
SWIG/Examples/Makefile.in
View file

@ -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" \

2
SWIG/Examples/ocaml/shapes/example.c
View file

@ -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;

1
SWIG/Examples/ocaml/strings_test/runme.ml
View file

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

2
SWIG/Examples/test-suite/ocaml/makedebugtop
View file

@ -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++

0
SWIG/Examples/test-suite/ocaml/results
View file

39
SWIG/Lib/ocaml/class.swg
View file

@ -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"

101
SWIG/Lib/ocaml/director.swg
View file

@ -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
%}

1
SWIG/Lib/ocaml/ocaml.i
View file

@ -32,4 +32,3 @@
%include "typecheck.i"
%include "exception.i"
%include "preamble.swg"
%include "director.swg"

12
SWIG/Lib/ocaml/ocaml.swg
View file

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

1
SWIG/Lib/ocaml/ocamldec.swg
View file

@ -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
}

4
SWIG/Lib/ocaml/preamble.swg
View file

@ -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
%}

17
SWIG/Lib/ocaml/std_string.i
View file

@ -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());
}

42
SWIG/Lib/ocaml/swig.ml
View file

@ -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

10
SWIG/Lib/ocaml/swig.mli
View file

@ -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

236
SWIG/Source/Modules/ocaml.cxx
View file

@ -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 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);
// 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 {
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 */