diff --git a/Examples/test-suite/ocaml/Makefile.in b/Examples/test-suite/ocaml/Makefile.in index 6e1a9f17d..661540bc4 100644 --- a/Examples/test-suite/ocaml/Makefile.in +++ b/Examples/test-suite/ocaml/Makefile.in @@ -4,6 +4,7 @@ LANGUAGE = ocaml OCAMLC = @OCAMLC@ +OCAMLPP = -pp "camlp4o ./swigp4.cmo" VARIANT = _static SCRIPTSUFFIX = _runme.ml @@ -53,7 +54,7 @@ run_testcase = \ if [ $(srcdir) != . ]; then \ cp $(srcdir)/$(ml_runme) $(ml_runme); \ fi ; \ - $(COMPILETOOL) $(OCAMLC) -c $(ml_runme) && \ + $(COMPILETOOL) $(OCAMLC) $(OCAMLPP) -c $(ml_runme) && \ if [ -f $(top_srcdir)/Examples/test-suite/$*.list ]; then \ $(COMPILETOOL) $(OCAMLC) swig.cmo -custom -g -cc '$(CXX)' -o runme `cat $(top_srcdir)/Examples/test-suite/$(*).list | sed -e 's/\(.*\)/\1_wrap.o \1.cmo/g'`&& $(RUNTOOL) ./runme; \ else \ diff --git a/Examples/test-suite/ocaml/li_std_vector_runme.ml b/Examples/test-suite/ocaml/li_std_vector_runme.ml new file mode 100644 index 000000000..64e9ec9f2 --- /dev/null +++ b/Examples/test-suite/ocaml/li_std_vector_runme.ml @@ -0,0 +1,23 @@ +open Swig +open Li_std_vector + +let _ = + let iv = new_IntVector '() in + assert (iv -> "empty" () as bool); + assert ((iv -> "size" () as int) = 0); + ignore (iv -> "push_back" (123)); + assert ((iv -> "empty" () as bool) = false); + assert ((iv -> "size" () as int) = 1); + assert ((iv -> "[]" (0) as int) = 123); + ignore (iv -> "clear" ()); + assert (iv -> "empty" () as bool); + assert ((iv -> "size" () as int) = 0); +;; + +let _ = + let rv = new_RealVector '() in + ignore (rv -> "push_back" (100.)); + ignore (rv -> "push_back" (200.)); + assert ((rv -> "[]" (0) as float) = 100.); + assert ((rv -> "[]" (1) as float) = 200.); +;; diff --git a/Examples/test-suite/ocaml/struct_value_runme.ml b/Examples/test-suite/ocaml/struct_value_runme.ml new file mode 100644 index 000000000..73688bef3 --- /dev/null +++ b/Examples/test-suite/ocaml/struct_value_runme.ml @@ -0,0 +1,11 @@ +open Swig +open Struct_value + +let b = new_Bar (C_void) +let a = (invoke b) "[a]" (C_void) +let _ = (invoke a) "[x]" (C_int 3) +let _ = assert((invoke a) "[x]" (C_void) = C_int 3) + +let bb = (invoke b) "[b]" (C_void) +let _ = (invoke bb) "[x]" (C_int 3) +let _ = assert((invoke bb) "[x]" (C_void) = C_int 3) diff --git a/Lib/ocaml/class.swg b/Lib/ocaml/class.swg index 0ee304cab..eb369cd70 100644 --- a/Lib/ocaml/class.swg +++ b/Lib/ocaml/class.swg @@ -56,6 +56,7 @@ begin (fun mth arg -> invoke_inner raw_ptr mth arg) end +let _ = register_class_byname "$realname" create_$classname_from_ptr let _ = Callback.register "create_$normalized_from_ptr" create_$classname_from_ptr diff --git a/Lib/ocaml/swig.ml b/Lib/ocaml/swig.ml index d0658e78c..8ac301dc6 100644 --- a/Lib/ocaml/swig.ml +++ b/Lib/ocaml/swig.ml @@ -155,5 +155,5 @@ let _ = Callback.register "swig_set_type_info" set_type_info let class_master_list = Hashtbl.create 20 let register_class_byname nm co = Hashtbl.replace class_master_list nm (Obj.magic co) -let create_class nm arg = +let create_class nm = try (Obj.magic (Hashtbl.find class_master_list nm)) with _ -> raise (NoSuchClass nm) diff --git a/Source/Modules/ocaml.cxx b/Source/Modules/ocaml.cxx index a73219abc..09d3ba980 100644 --- a/Source/Modules/ocaml.cxx +++ b/Source/Modules/ocaml.cxx @@ -417,6 +417,29 @@ public: return SwigType_isarray(SwigType_typedef_resolve_all(t)); } + virtual int membervariableHandler(Node *n) { + String *symname = Getattr(n, "sym:name"); + Language::membervariableHandler(n); + + String *mname = Swig_name_member(NSPACE_TODO, classname, symname); + String *getname = Swig_name_get(NSPACE_TODO, mname); + String *mangled_getname = mangleNameForCaml(getname); + Delete(getname); + + if (!GetFlag(n, "feature:immutable")) { + String *setname = Swig_name_set(NSPACE_TODO, mname); + String *mangled_setname = mangleNameForCaml(setname); + Delete(setname); + Printf(f_class_ctors, " \"[%s]\", (fun args -> " "if args = (C_list [ raw_ptr ]) then _%s args else _%s args) ;\n", symname, mangled_getname, mangled_setname); + Delete(mangled_setname); + } else { + Printf(f_class_ctors, " \"[%s]\", (fun args -> " "if args = (C_list [ raw_ptr ]) then _%s args else C_void) ;\n", symname, mangled_getname); + } + Delete(mangled_getname); + Delete(mname); + return SWIG_OK; + } + /* ------------------------------------------------------------ * functionWrapper() * Create a function declaration and register it with the interpreter. @@ -477,26 +500,12 @@ public: Delete(mangled_name_nounder); } else if (classmode && in_destructor) { Printf(f_class_ctors, " \"~\", %s ;\n", mangled_name); - } else if (classmode && !in_constructor && !in_destructor && !static_member_function) { + } else if (classmode && !in_constructor && !in_destructor && !static_member_function && + !Getattr(n, "membervariableHandler:sym:name")) { String *opname = Copy(Getattr(n, "memberfunctionHandler:sym:name")); Replaceall(opname, "operator ", ""); - - if (strstr(Char(mangled_name), "__get__")) { - String *set_name = Copy(mangled_name); - if (!GetFlag(n, "feature:immutable")) { - Replaceall(set_name, "__get__", "__set__"); - Printf(f_class_ctors, " \"%s\", (fun args -> " "if args = (C_list [ raw_ptr ]) then %s args else %s args) ;\n", opname, mangled_name, set_name); - Delete(set_name); - } else { - Printf(f_class_ctors, " \"%s\", (fun args -> " "if args = (C_list [ raw_ptr ]) then %s args else C_void) ;\n", opname, mangled_name); - } - } else if (strstr(Char(mangled_name), "__set__")) { - ; /* Nothing ... handled by the case above */ - } else { - Printf(f_class_ctors, " \"%s\", %s ;\n", opname, mangled_name); - } - + Printf(f_class_ctors, " \"%s\", %s ;\n", opname, mangled_name); Delete(opname); } @@ -1102,11 +1111,12 @@ public: int classHandler(Node *n) { String *name = Getattr(n, "name"); + classname = Getattr(n, "sym:name"); if (!name) return SWIG_OK; - String *mangled_sym_name = mangleNameForCaml(name); + String *mangled_name = mangleNameForCaml(name); String *this_class_def = NewString(f_classtemplate); String *name_normalized = normalizeTemplatedClassName(name); String *old_class_ctors = f_class_ctors; @@ -1115,7 +1125,6 @@ public: bool sizeof_feature = generate_sizeof && isSimpleType(name); - classname = mangled_sym_name; classmode = true; int rv = Language::classHandler(n); classmode = false; @@ -1123,15 +1132,15 @@ public: if (sizeof_feature) { Printf(f_wrappers, "SWIGEXT CAML_VALUE _wrap_%s_sizeof( CAML_VALUE args ) {\n" - " CAMLparam1(args);\n" " CAMLreturn(Val_int(sizeof(%s)));\n" "}\n", mangled_sym_name, name_normalized); + " CAMLparam1(args);\n" " CAMLreturn(Val_int(sizeof(%s)));\n" "}\n", mangled_name, name_normalized); - Printf(f_mlbody, "external __%s_sizeof : unit -> int = " "\"_wrap_%s_sizeof\"\n", classname, mangled_sym_name); + Printf(f_mlbody, "external __%s_sizeof : unit -> int = " "\"_wrap_%s_sizeof\"\n", mangled_name, mangled_name); } /* Insert sizeof operator for concrete classes */ if (sizeof_feature) { - Printv(f_class_ctors, "\"sizeof\" , (fun args -> C_int (__", classname, "_sizeof ())) ;\n", NIL); + Printv(f_class_ctors, "\"sizeof\" , (fun args -> C_int (__", mangled_name, "_sizeof ())) ;\n", NIL); } /* Handle up-casts in a nice way */ List *baselist = Getattr(n, "bases"); @@ -1150,7 +1159,7 @@ public: } } - Replaceall(this_class_def, "$classname", classname); + Replaceall(this_class_def, "$classname", mangled_name); Replaceall(this_class_def, "$normalized", name_normalized); Replaceall(this_class_def, "$realname", name); Replaceall(this_class_def, "$baselist", base_classes); @@ -1163,7 +1172,7 @@ public: Multiwrite(this_class_def); - Setattr(n, "ocaml:ctor", classname); + Setattr(n, "ocaml:ctor", mangled_name); return rv; }