Menu
▾
▴
[Swig-cvs] SF.net SVN: swig:[10793] branches/gsoc2008-jezabek
|
From: <je...@us...> - 2008-08-18 18:51:35
|
Revision: 10793
http://swig.svn.sourceforge.net/swig/?rev=10793&view=rev
Author: jezabek
Date: 2008-08-18 18:51:22 +0000 (Mon, 18 Aug 2008)
Log Message:
-----------
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.
........
Modified Paths:
--------------
branches/gsoc2008-jezabek/CHANGES.current
branches/gsoc2008-jezabek/Examples/test-suite/perl5/imports_runme.pl
branches/gsoc2008-jezabek/Lib/allegrocl/allegrocl.swg
branches/gsoc2008-jezabek/Lib/chicken/chicken.swg
branches/gsoc2008-jezabek/Lib/chicken/chickenrun.swg
branches/gsoc2008-jezabek/Source/Modules/allegrocl.cxx
branches/gsoc2008-jezabek/Source/Modules/perl5.cxx
Property Changed:
----------------
branches/gsoc2008-jezabek/
Property changes on: branches/gsoc2008-jezabek
___________________________________________________________________
Modified: svnmerge-integrated
- /trunk:1-10714
+ /trunk:1-10790
Modified: branches/gsoc2008-jezabek/CHANGES.current
===================================================================
--- branches/gsoc2008-jezabek/CHANGES.current 2008-08-18 18:49:13 UTC (rev 10792)
+++ branches/gsoc2008-jezabek/CHANGES.current 2008-08-18 18:51:22 UTC (rev 10793)
@@ -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.
Modified: branches/gsoc2008-jezabek/Examples/test-suite/perl5/imports_runme.pl
===================================================================
--- branches/gsoc2008-jezabek/Examples/test-suite/perl5/imports_runme.pl 2008-08-18 18:49:13 UTC (rev 10792)
+++ branches/gsoc2008-jezabek/Examples/test-suite/perl5/imports_runme.pl 2008-08-18 18:51:22 UTC (rev 10793)
@@ -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);
Modified: branches/gsoc2008-jezabek/Lib/allegrocl/allegrocl.swg
===================================================================
--- branches/gsoc2008-jezabek/Lib/allegrocl/allegrocl.swg 2008-08-18 18:49:13 UTC (rev 10792)
+++ branches/gsoc2008-jezabek/Lib/allegrocl/allegrocl.swg 2008-08-18 18:51:22 UTC (rev 10793)
@@ -296,15 +296,30 @@
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 @@
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)
Modified: branches/gsoc2008-jezabek/Lib/chicken/chicken.swg
===================================================================
--- branches/gsoc2008-jezabek/Lib/chicken/chicken.swg 2008-08-18 18:49:13 UTC (rev 10792)
+++ branches/gsoc2008-jezabek/Lib/chicken/chicken.swg 2008-08-18 18:51:22 UTC (rev 10793)
@@ -10,6 +10,7 @@
/* chicken.h has to appear first. */
%insert(runtime) %{
+#include <assert.h>
#include <chicken.h>
%}
Modified: branches/gsoc2008-jezabek/Lib/chicken/chickenrun.swg
===================================================================
--- branches/gsoc2008-jezabek/Lib/chicken/chickenrun.swg 2008-08-18 18:49:13 UTC (rev 10792)
+++ branches/gsoc2008-jezabek/Lib/chicken/chickenrun.swg 2008-08-18 18:51:22 UTC (rev 10793)
@@ -7,6 +7,7 @@
* ----------------------------------------------------------------------------- */
#include <chicken.h>
+#include <assert.h>
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
Modified: branches/gsoc2008-jezabek/Source/Modules/allegrocl.cxx
===================================================================
--- branches/gsoc2008-jezabek/Source/Modules/allegrocl.cxx 2008-08-18 18:49:13 UTC (rev 10792)
+++ branches/gsoc2008-jezabek/Source/Modules/allegrocl.cxx 2008-08-18 18:51:22 UTC (rev 10793)
@@ -1084,7 +1084,8 @@
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 @@
}
+ Preprocessor_define("SWIGALLEGROCL 1", 0);
+
allow_overloading();
}
@@ -1531,7 +1534,7 @@
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 @@
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");
Modified: branches/gsoc2008-jezabek/Source/Modules/perl5.cxx
===================================================================
--- branches/gsoc2008-jezabek/Source/Modules/perl5.cxx 2008-08-18 18:49:13 UTC (rev 10792)
+++ branches/gsoc2008-jezabek/Source/Modules/perl5.cxx 2008-08-18 18:51:22 UTC (rev 10793)
@@ -100,8 +100,6 @@
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 @@
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 @@
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 @@
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 @@
/* 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 @@
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 @@
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 @@
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 @@
/* ------------------------------------------------------------
* 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 @@
Clear(temp);
Printf(temp, "%s(", iname);
- /* Now go through and print parameters */
+ 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;
- i = 0;
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 @@
}
}
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 @@
* ------------------------------------------------------------ */
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 @@
} else {
fullclassname = NewString(class_name);
}
- real_classname = Getattr(n, "name");
+ name = Getattr(n, "name");
pcode = NewString("");
// blessedmembers = NewString("");
}
@@ -1217,7 +1255,7 @@
/* 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 @@
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,18 +1548,17 @@
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);
- }
+ /* 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);
- 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);
-
have_constructor = 1;
}
}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|