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

initial steps to clean up perl5 class methods (primarily constructors).

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@10743 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Robert Stone 2008-08-08 03:10:55 +00:00
commit 2728e5a606
2 changed files with 52 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

67
Source/Modules/perl5.cxx
View file

@ -556,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;
@ -565,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")) {
@ -587,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);
@ -599,13 +613,28 @@ 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));
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);
}
Printf(f->code, "ax += %d;\n", num_implicits);
}
/* Write code to extract parameters. */
i = 0;
for (i = 0, p = l; i < num_arguments; i++) {
@ -795,6 +824,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");
@ -1041,13 +1074,14 @@ public:
Clear(temp);
Printf(temp, "%s(", iname);
/* Now go through and print parameters */
p = l;
i = 0;
/* 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) {
@ -1057,16 +1091,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);
@ -1490,6 +1516,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);
@ -1510,7 +1545,7 @@ public:
}
Printv(pcode,
tab4, "my $pkg = shift;\n",
tab4, "my $pkg = $_[0];\n",
tab4, "my $self = ", cmodule, "::", Swig_name_construct(symname), "(@_);\n", tab4, "bless $self, $pkg if defined($self);\n", "}\n\n", NIL);
have_constructor = 1;