From 7b97de43ba87f8b29c4861c2769cbeab95c002e7 Mon Sep 17 00:00:00 2001 From: Jan Jezabek Date: Mon, 18 Aug 2008 18:51:22 +0000 Subject: Merged revisions 10726-10727,10738,10743,10747,10749 via svnmerge from https://swig.svn.sourceforge.net/svnroot/swig/trunk ........ r10726 | wuzzeb | 2008-08-02 10:28:02 +0200 (Sat, 02 Aug 2008) | 1 line Commit patch 2019314 ........ r10727 | wuzzeb | 2008-08-02 10:49:43 +0200 (Sat, 02 Aug 2008) | 1 line add assert.h to fix chicken build of external runtime (ext_test testsuite) ........ r10738 | talby | 2008-08-07 08:28:13 +0200 (Thu, 07 Aug 2008) | 2 lines hoist globals to local scope where trival. ........ r10743 | talby | 2008-08-08 05:10:55 +0200 (Fri, 08 Aug 2008) | 2 lines initial steps to clean up perl5 class methods (primarily constructors). ........ r10747 | talby | 2008-08-09 06:08:26 +0200 (Sat, 09 Aug 2008) | 2 lines moves perl space constructor fixups into wrapper code. ........ r10749 | talby | 2008-08-10 01:57:55 +0200 (Sun, 10 Aug 2008) | 2 lines usage_func() fix + CHANGES.current entry to explain my past few commits. ........ git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/branches/gsoc2008-jezabek@10793 626c5289-ae23-0410-ae9c-e8d60b6d4f22 --- CHANGES.current | 8 +++ Examples/test-suite/perl5/imports_runme.pl | 2 +- Lib/allegrocl/allegrocl.swg | 72 +++++++++++-------- Lib/chicken/chicken.swg | 1 + Lib/chicken/chickenrun.swg | 1 + Source/Modules/allegrocl.cxx | 9 ++- Source/Modules/perl5.cxx | 108 ++++++++++++++++++++--------- 7 files changed, 136 insertions(+), 65 deletions(-) diff --git a/CHANGES.current b/CHANGES.current index eb8d81e29..7d1b70ca7 100644 --- a/CHANGES.current +++ b/CHANGES.current @@ -1,6 +1,14 @@ Version 1.3.37 (in progress) ============================= +2008-08-09: talby + [Perl5] Unify Perl and C portions of constructor wrappers. + +2008-08-02: wuzzeb + [Chicken,Allegro] Commit Patch 2019314 + Fixes a build error in chicken, and several build errors and other errors + in Allegro CL + 2008-07-19: wsfulton Fix building of Tcl examples/test-suite on Mac OSX reported by Gideon Simpson. diff --git a/Examples/test-suite/perl5/imports_runme.pl b/Examples/test-suite/perl5/imports_runme.pl index fd730fedf..13ca08a1c 100644 --- a/Examples/test-suite/perl5/imports_runme.pl +++ b/Examples/test-suite/perl5/imports_runme.pl @@ -1,5 +1,5 @@ use imports_b; use imports_a; -$x = imports_bc::new_B(); +$x = imports_b::B->new(); imports_ac::A_hello($x); diff --git a/Lib/allegrocl/allegrocl.swg b/Lib/allegrocl/allegrocl.swg index 0ae8ed76c..8132e4628 100644 --- a/Lib/allegrocl/allegrocl.swg +++ b/Lib/allegrocl/allegrocl.swg @@ -296,15 +296,30 @@ $body)" sym)))) (cl::defun full-name (id type arity class) - (cl::case type - (:getter (cl::format nil "~@[~A_~]~A" class id)) - (:constructor (cl::format nil "new_~A~@[~A~]" id arity)) - (:destructor (cl::format nil "delete_~A" id)) - (:type (cl::format nil "ff_~A" id)) - (:slot id) - (:ff-operator (cl::format nil "ffi_~A" id)) - (otherwise (cl::format nil "~@[~A_~]~A~@[~A~]" - class id arity)))) + ; We need some kind of a hack here to handle template classes + ; and other synonym types right. We need the original name. + (let*( (sym (read-symbol-from-string + (if (eq *swig-identifier-converter* 'identifier-convert-lispify) + (string-lispify id) + id))) + (sym-class (find-class sym nil)) + (id (cond ( (not sym-class) + id ) + ( (and sym-class + (not (eq (class-name sym-class) + sym))) + (class-name sym-class) ) + ( t + id ))) ) + (cl::case type + (:getter (cl::format nil "~@[~A_~]~A" class id)) + (:constructor (cl::format nil "new_~A~@[~A~]" id arity)) + (:destructor (cl::format nil "delete_~A" id)) + (:type (cl::format nil "ff_~A" id)) + (:slot id) + (:ff-operator (cl::format nil "ffi_~A" id)) + (otherwise (cl::format nil "~@[~A_~]~A~@[~A~]" + class id arity))))) (cl::defun identifier-convert-null (id &key type class arity) (cl::if (cl::eq type :setter) @@ -312,40 +327,37 @@ $body)" id :type :getter :class class :arity arity)) (read-symbol-from-string (full-name id type arity class)))) -(cl::defun identifier-convert-lispify (cname &key type class arity) - (cl::assert (cl::stringp cname)) - (cl::when (cl::eq type :setter) - (cl::return-from identifier-convert-lispify - `(cl::setf ,(identifier-convert-lispify - cname :type :getter :class class :arity arity)))) - (cl::setq cname (full-name cname type arity class)) - (cl::if (cl::eq type :constant) - (cl::setf cname (cl::format nil "*~A*" cname))) - (cl::setf cname (excl::replace-regexp cname "_" "-")) - (cl::let ((lastcase :other) - newcase char res) +(cl::defun string-lispify (str) + (cl::let ( (cname (excl::replace-regexp str "_" "-")) + (lastcase :other) + newcase char res ) (cl::dotimes (n (cl::length cname)) (cl::setf char (cl::schar cname n)) (excl::if* (cl::alpha-char-p char) then (cl::setf newcase (cl::if (cl::upper-case-p char) :upper :lower)) - - (cl::when (cl::or (cl::and (cl::eq lastcase :upper) - (cl::eq newcase :lower)) - (cl::and (cl::eq lastcase :lower) - (cl::eq newcase :upper))) + (cl::when (cl::and (cl::eq lastcase :lower) + (cl::eq newcase :upper)) ;; case change... add a dash (cl::push #\- res) (cl::setf newcase :other)) - (cl::push (cl::char-downcase char) res) - (cl::setf lastcase newcase) - else (cl::push char res) (cl::setf lastcase :other))) - (read-symbol-from-string (cl::coerce (cl::nreverse res) 'string)))) + (cl::coerce (cl::nreverse res) 'string))) + +(cl::defun identifier-convert-lispify (cname &key type class arity) + (cl::assert (cl::stringp cname)) + (cl::when (cl::eq type :setter) + (cl::return-from identifier-convert-lispify + `(cl::setf ,(identifier-convert-lispify + cname :type :getter :class class :arity arity)))) + (cl::setq cname (full-name cname type arity class)) + (cl::if (cl::eq type :constant) + (cl::setf cname (cl::format nil "*~A*" cname))) + (read-symbol-from-string (string-lispify cname))) (cl::defun id-convert-and-export (name &rest kwargs) (cl::multiple-value-bind (symbol package) diff --git a/Lib/chicken/chicken.swg b/Lib/chicken/chicken.swg index d8b71874e..a8d1b5a57 100644 --- a/Lib/chicken/chicken.swg +++ b/Lib/chicken/chicken.swg @@ -10,6 +10,7 @@ /* chicken.h has to appear first. */ %insert(runtime) %{ +#include #include %} diff --git a/Lib/chicken/chickenrun.swg b/Lib/chicken/chickenrun.swg index bd7242407..8703ea65a 100644 --- a/Lib/chicken/chickenrun.swg +++ b/Lib/chicken/chickenrun.swg @@ -7,6 +7,7 @@ * ----------------------------------------------------------------------------- */ #include +#include #include #include #include diff --git a/Source/Modules/allegrocl.cxx b/Source/Modules/allegrocl.cxx index c1d271c57..217c89b1f 100644 --- a/Source/Modules/allegrocl.cxx +++ b/Source/Modules/allegrocl.cxx @@ -1084,7 +1084,8 @@ void emit_synonym(Node *synonym) { of_ltype = lookup_defined_foreign_ltype(of_name); // Printf(f_clhead,";; from emit-synonym\n"); - Printf(f_clhead, "(swig-def-synonym-type %s\n %s\n %s)\n", syn_ltype, of_ltype, syn_type); + if( of_ltype ) + Printf(f_clhead, "(swig-def-synonym-type %s\n %s\n %s)\n", syn_ltype, of_ltype, syn_type); Delete(synonym_ns); Delete(of_ns_list); @@ -1521,6 +1522,8 @@ void ALLEGROCL::main(int argc, char *argv[]) { } + Preprocessor_define("SWIGALLEGROCL 1", 0); + allow_overloading(); } @@ -1531,7 +1534,7 @@ int ALLEGROCL::top(Node *n) { swig_package = unique_swig_package ? NewStringf("swig.%s", module_name) : NewString("swig"); - Printf(cl_filename, "%s%s.cl", SWIG_output_directory(), Swig_file_basename(Getattr(n,"infile"))); + Printf(cl_filename, "%s%s.cl", SWIG_output_directory(), module_name); f_cl = NewFile(cl_filename, "w"); if (!f_cl) { @@ -2628,7 +2631,7 @@ int ALLEGROCL::functionWrapper(Node *n) { String *actioncode = emit_action(n); String *tm = Swig_typemap_lookup_out("out", n, "result", f, actioncode); - if (tm) { + if (!is_void_return && tm) { Replaceall(tm, "$result", "lresult"); Printf(f->code, "%s\n", tm); Printf(f->code, " return lresult;\n"); diff --git a/Source/Modules/perl5.cxx b/Source/Modules/perl5.cxx index 6e706fc8d..2e714efe5 100644 --- a/Source/Modules/perl5.cxx +++ b/Source/Modules/perl5.cxx @@ -100,8 +100,6 @@ static int have_constructor = 0; static int have_destructor = 0; static int have_data_members = 0; static String *class_name = 0; /* Name of the class (what Perl thinks it is) */ -static String *real_classname = 0; /* Real name of C/C++ class */ -static String *fullclassname = 0; static String *pcode = 0; /* Perl code associated with each class */ /* static String *blessedmembers = 0; *//* Member data associated with each class */ @@ -558,6 +556,7 @@ public: String *iname = Getattr(n, "sym:name"); SwigType *d = Getattr(n, "type"); ParmList *l = Getattr(n, "parms"); + ParmList *outer = Getattr(n, "perl5:implicits"); String *overname = 0; Parm *p; @@ -567,7 +566,7 @@ public: String *tm; String *cleanup, *outarg; int num_saved = 0; - int num_arguments, num_required; + int num_arguments, num_required, num_implicits; int varargs = 0; if (Getattr(n, "sym:overloaded")) { @@ -589,6 +588,19 @@ public: Printv(f->def, "XS(", wname, ") {\n", "{\n", /* scope to destroy C++ objects before croaking */ NIL); + num_implicits = 0; + if (outer) { + Parm *tmp = outer; + Parm *tail; + while(tmp) { + tail = tmp; + num_implicits++; + tmp = nextSibling(tmp); + } + /* link the outer with inner parms */ + set_nextSibling(tail, l); + } + emit_parameter_variables(l, f); emit_attach_parmmaps(l, f); Setattr(n, "wrap:parms", l); @@ -601,13 +613,29 @@ public: /* Check the number of arguments */ if (!varargs) { - Printf(f->code, " if ((items < %d) || (items > %d)) {\n", num_required, num_arguments); + Printf(f->code, " if ((items < %d) || (items > %d)) {\n", + num_required + num_implicits, num_arguments + num_implicits); } else { - Printf(f->code, " if (items < %d) {\n", num_required); + Printf(f->code, " if (items < %d) {\n", + num_required + num_implicits); } - Printf(f->code, " SWIG_croak(\"Usage: %s\");\n", usage_func(Char(iname), d, l)); + Printf(f->code, " SWIG_croak(\"Usage: %s\");\n", usage_func(Char(iname), d, outer, l)); Printf(f->code, "}\n"); + if (num_implicits) { + /* TODO: support implicits of types other than SVs */ + Parm *p = outer; + for(i = 0; i < num_implicits; i++) { + String *pname = Getattr(p, "name"); + String *pinit = SwigType_str(Getattr(p, "type"), pname); + Wrapper_add_local(f, pname, pinit); + Delete(pinit); + Printf(f->code, "%s = ST(%d);\n", pname, i++); + p = nextSibling(p); + } + if (l) + Printf(f->code, "ax += %d;\n", num_implicits); + } /* Write code to extract parameters. */ i = 0; for (i = 0, p = l; i < num_arguments; i++) { @@ -720,6 +748,9 @@ public: Wrapper_add_localv(f, "_saved", "SV *", temp, NIL); } + if (num_implicits && l) + Printf(f->code, "ax -= %d;\n", num_implicits); + /* Now write code to make the function call */ Swig_director_emit_dynamic_cast(n, f); @@ -766,6 +797,11 @@ public: Printf(f->code, "%s\n", tm); } + if (blessed && Equal(nodeType(n), "constructor")) { + Append(f->code, + "if (SvOK(ST(0))) sv_bless(ST(0), gv_stashsv(proto, 0));\n"); + } + Printv(f->code, "XSRETURN(argvi);\n", "fail:\n", cleanup, "SWIG_croak_null();\n" "}\n" "}\n", NIL); /* Add the dXSARGS last */ @@ -797,6 +833,10 @@ public: Printv(df->def, "XS(", dname, ") {\n", NIL); Wrapper_add_local(df, "dXSARGS", "dXSARGS"); + if (num_implicits) { + Printf(df->code, "ax += %d;\n", num_implicits); + Printf(df->code, "items -= %d;\n", num_implicits); + } Printv(df->code, dispatch, "\n", NIL); Printf(df->code, "croak(\"No matching function for overloaded '%s'\");\n", iname); Printf(df->code, "XSRETURN(0);\n"); @@ -1033,7 +1073,7 @@ public: /* ------------------------------------------------------------ * usage_func() * ------------------------------------------------------------ */ - char *usage_func(char *iname, SwigType *, ParmList *l) { + char *usage_func(char *iname, SwigType *, ParmList *il, ParmList *l) { static String *temp = 0; Parm *p; int i; @@ -1043,13 +1083,17 @@ public: Clear(temp); Printf(temp, "%s(", iname); - /* Now go through and print parameters */ - p = l; i = 0; + /* Print implicit parameters */ + for(p = il; p; p = nextSibling(p)) + Printv(temp, (i > 0 ? "," : ""), Getattr(p, "name"), NIL); + /* Now go through and print normal parameters */ + p = l; while (p != 0) { SwigType *pt = Getattr(p, "type"); String *pn = Getattr(p, "name"); if (!checkAttribute(p,"tmap:in:numinputs","0")) { + if (i > 0) Append(temp, ","); /* If parameter has been named, use that. Otherwise, just print a type */ if (SwigType_type(pt) != T_VOID) { if (Len(pn) > 0) { @@ -1059,16 +1103,8 @@ public: } } i++; - p = nextSibling(p); - if (p) - if (!checkAttribute(p,"tmap:in:numinputs","0")) - Putc(',', temp); - } else { - p = nextSibling(p); - if (p) - if ((i > 0) && (!checkAttribute(p,"tmap:in:numinputs","0"))) - Putc(',', temp); } + p = nextSibling(p); } Printf(temp, ");"); return Char(temp); @@ -1186,6 +1222,8 @@ public: * ------------------------------------------------------------ */ virtual int classHandler(Node *n) { + String *name = 0; /* Real name of C/C++ class */ + String *fullclassname = 0; if (blessed) { have_constructor = 0; @@ -1205,7 +1243,7 @@ public: } else { fullclassname = NewString(class_name); } - real_classname = Getattr(n, "name"); + name = Getattr(n, "name"); pcode = NewString(""); // blessedmembers = NewString(""); } @@ -1217,7 +1255,7 @@ public: /* Finish the rest of the class */ if (blessed) { /* Generate a client-data entry */ - SwigType *ct = NewStringf("p.%s", real_classname); + SwigType *ct = NewStringf("p.%s", name); Printv(f_init, "SWIG_TypeClientData(SWIGTYPE", SwigType_manglestr(ct), ", (void*) \"", fullclassname, "\");\n", NIL); SwigType_remember(ct); Delete(ct); @@ -1490,6 +1528,15 @@ public: String *symname = Getattr(n, "sym:name"); + { + String *type = NewString("SV"); + SwigType_add_pointer(type); + Parm *p = NewParm(type, "proto"); + Delete(type); + Setattr(n, "perl5:implicits", p); + Delete(p); + } + member_func = 1; Language::constructorHandler(n); @@ -1501,17 +1548,16 @@ public: Delete(plaction); Printv(pcode, plcode, NIL); } else { - if ((Cmp(symname, class_name) == 0)) { - /* Emit a blessed constructor */ - Printf(pcode, "sub new {\n"); - } else { - /* Constructor doesn't match classname so we'll just use the normal name */ - Printv(pcode, "sub ", Swig_name_construct(symname), " () {\n", NIL); - } - - Printv(pcode, - tab4, "my $pkg = shift;\n", - tab4, "my $self = ", cmodule, "::", Swig_name_construct(symname), "(@_);\n", tab4, "bless $self, $pkg if defined($self);\n", "}\n\n", NIL); + /* Emit a blessed constructor */ + String *cname = Swig_name_construct(symname); + char *pname; + /* override Class->Class to be Class->new */ + if (Cmp(symname, class_name) == 0) + pname = "new"; + else + pname = Char(cname); + Printf(pcode, "*%s = *%s::%s;\n", pname, cmodule, cname); + Delete(cname); have_constructor = 1; } -- cgit v1.2.1