jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
swig/Source/Modules/perl5.cxx
Olly Betts 55377bdc08 Add DOH Exit() and SetExitHandler() 
Exit() is a wrapper for exit() by default, but SetExitHandler() allows
specifying a function to call instead.

This means that failures within DOH (e.g. Malloc() failing due to lack
of memory) will now perform cleanup such as removing output files.

This commit also cleans up exit statuses so SWIG should now reliably
exit with status 0 if the run was successful and status 1 if there was
an error (or a warning and -Werror was in effect).

Previously in some situations SWIG would try to exit with the status set
to the number of errors encountered, but that's problematic - for
example if there were 256 errors this would result in exit status 0 on
most platforms.  Also some error statuses have special meanings e.g.
those defined by <sysexits.h>.

Also SWIG/Javascript tried to exit with status -1 in a few places (which
typically results in exit status 255).
2022-03-06 12:33:54 +13:00

2502 lines
81 KiB
C++
Raw Blame History

/* ----------------------------------------------------------------------------
* This file is part of SWIG, which is licensed as a whole under version 3
* (or any later version) of the GNU General Public License. Some additional
* terms also apply to certain portions of SWIG. The full details of the SWIG
* license and copyrights can be found in the LICENSE and COPYRIGHT files
* included with the SWIG source code as distributed by the SWIG developers
* and at http://www.swig.org/legal.html.
*
* perl5.cxx
*
* Perl5 language module for SWIG.
* ------------------------------------------------------------------------- */
#include "swigmod.h"
#include "cparse.h"
#include <ctype.h>
static const char *usage = "\
Perl 5 Options (available with -perl5)\n\
-compat - Compatibility mode\n\
-const - Wrap constants as constants and not variables (implies -proxy)\n\
-nopm - Do not generate the .pm file\n\
-noproxy - Don't create proxy classes\n\
-proxy - Create proxy classes\n\
-static - Omit code related to dynamic loading\n\
\n";
static int compat = 0;
static int no_pmfile = 0;
static int export_all = 0;
/*
* pmfile
* set by the -pm flag, overrides the name of the .pm file
*/
static String *pmfile = 0;
/*
* module
* set by the %module directive, e.g. "Xerces". It will determine
* the name of the .pm file, and the dynamic library, and the name
* used by any module wanting to %import the module.
*/
static String *module = 0;
/*
* namespace_module
* the fully namespace qualified name of the module. It will be used
* to set the package namespace in the .pm file, as well as the name
* of the initialization methods in the glue library. This will be
* the same as module, above, unless the %module directive is given
* the 'package' option, e.g. %module(package="Foo::Bar") "baz"
*/
static String *namespace_module = 0;
/*
* cmodule
* the namespace of the internal glue code, set to the value of
* module with a 'c' appended
*/
static String *cmodule = 0;
/*
* dest_package
* an optional namespace to put all classes into. Specified by using
* the %module(package="Foo::Bar") "baz" syntax
*/
static String *dest_package = 0;
static String *command_tab = 0;
static String *constant_tab = 0;
static String *variable_tab = 0;
static File *f_begin = 0;
static File *f_runtime = 0;
static File *f_runtime_h = 0;
static File *f_header = 0;
static File *f_wrappers = 0;
static File *f_directors = 0;
static File *f_directors_h = 0;
static File *f_init = 0;
static File *f_pm = 0;
static String *pm; /* Package initialization code */
static String *magic; /* Magic variable wrappers */
static int staticoption = 0;
// controlling verbose output
static int verbose = 0;
/* The following variables are used to manage Perl5 classes */
static int blessed = 1; /* Enable object oriented features */
static int do_constants = 0; /* Constant wrapping */
static List *classlist = 0; /* List of classes */
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 */
static int member_func = 0; /* Set to 1 when wrapping a member function */
static String *func_stubs = 0; /* Function stubs */
static String *const_stubs = 0; /* Constant stubs */
static int num_consts = 0; /* Number of constants */
static String *var_stubs = 0; /* Variable stubs */
static String *exported = 0; /* Exported symbols */
static String *pragma_include = 0;
static String *additional_perl_code = 0; /* Additional Perl code from %perlcode %{ ... %} */
static Hash *operators = 0;
static int have_operators = 0;
class PERL5:public Language {
public:
PERL5():Language () {
Clear(argc_template_string);
Printv(argc_template_string, "items", NIL);
Clear(argv_template_string);
Printv(argv_template_string, "ST(%d)", NIL);
director_language = 1;
}
/* Test to see if a type corresponds to something wrapped with a shadow class */
Node *is_shadow(SwigType *t) {
Node *n;
n = classLookup(t);
/* Printf(stdout,"'%s' --> '%p'\n", t, n); */
if (n) {
if (!Getattr(n, "perl5:proxy")) {
setclassname(n);
}
return Getattr(n, "perl5:proxy");
}
return 0;
}
/* ------------------------------------------------------------
* main()
* ------------------------------------------------------------ */
virtual void main(int argc, char *argv[]) {
int i = 1;
SWIG_library_directory("perl5");
for (i = 1; i < argc; i++) {
if (argv[i]) {
if (strcmp(argv[i], "-package") == 0) {
Printv(stderr,
"*** -package is no longer supported\n*** use the directive '%module A::B::C' in your interface file instead\n*** see the Perl section in the manual for details.\n", NIL);
Exit(EXIT_FAILURE);
} else if (strcmp(argv[i], "-interface") == 0) {
Printv(stderr,
"*** -interface is no longer supported\n*** use the directive '%module A::B::C' in your interface file instead\n*** see the Perl section in the manual for details.\n", NIL);
Exit(EXIT_FAILURE);
} else if (strcmp(argv[i], "-exportall") == 0) {
export_all = 1;
Swig_mark_arg(i);
} else if (strcmp(argv[i], "-static") == 0) {
staticoption = 1;
Swig_mark_arg(i);
} else if ((strcmp(argv[i], "-shadow") == 0) || ((strcmp(argv[i], "-proxy") == 0))) {
blessed = 1;
Swig_mark_arg(i);
} else if ((strcmp(argv[i], "-noproxy") == 0)) {
blessed = 0;
Swig_mark_arg(i);
} else if (strcmp(argv[i], "-const") == 0) {
do_constants = 1;
blessed = 1;
Swig_mark_arg(i);
} else if (strcmp(argv[i], "-nopm") == 0) {
no_pmfile = 1;
Swig_mark_arg(i);
} else if (strcmp(argv[i], "-pm") == 0) {
Swig_mark_arg(i);
i++;
pmfile = NewString(argv[i]);
Swig_mark_arg(i);
} else if (strcmp(argv[i],"-v") == 0) {
Swig_mark_arg(i);
verbose++;
} else if (strcmp(argv[i], "-compat") == 0) {
compat = 1;
Swig_mark_arg(i);
} else if (strcmp(argv[i], "-help") == 0) {
fputs(usage, stdout);
} else if (strcmp(argv[i], "-cppcast") == 0) {
Printf(stderr, "Deprecated command line option: %s. This option is now always on.\n", argv[i]);
Swig_mark_arg(i);
} else if (strcmp(argv[i], "-nocppcast") == 0) {
Printf(stderr, "Deprecated command line option: %s. This option is no longer supported.\n", argv[i]);
Swig_mark_arg(i);
Exit(EXIT_FAILURE);
}
}
}
Preprocessor_define("SWIGPERL 1", 0);
// SWIGPERL5 is deprecated, and no longer documented.
Preprocessor_define("SWIGPERL5 1", 0);
SWIG_typemap_lang("perl5");
SWIG_config_file("perl5.swg");
allow_overloading();
}
/* ------------------------------------------------------------
* top()
* ------------------------------------------------------------ */
virtual int top(Node *n) {
/* check if directors are enabled for this module. note: this
* is a "master" switch, without which no director code will be
* emitted. %feature("director") statements are also required
* to enable directors for individual classes or methods.
*
* use %module(directors="1") modulename at the start of the
* interface file to enable director generation.
*
* TODO: directors are disallowed in conjunction with many command
* line options. Some of them are probably safe, but it will take
* some effort to validate each one.
*/
{
Node *mod = Getattr(n, "module");
if (mod) {
Node *options = Getattr(mod, "options");
if (options) {
int dirprot = 0;
if (Getattr(options, "dirprot"))
dirprot = 1;
if (Getattr(options, "nodirprot"))
dirprot = 0;
if (Getattr(options, "directors")) {
int allow = 1;
if (export_all) {
Printv(stderr, "*** directors are not supported with -exportall\n", NIL);
allow = 0;
}
if (staticoption) {
Printv(stderr, "*** directors are not supported with -static\n", NIL);
allow = 0;
}
if (!blessed) {
Printv(stderr, "*** directors are not supported with -noproxy\n", NIL);
allow = 0;
}
if (no_pmfile) {
Printv(stderr, "*** directors are not supported with -nopm\n", NIL);
allow = 0;
}
if (compat) {
Printv(stderr, "*** directors are not supported with -compat\n", NIL);
allow = 0;
}
if (allow) {
allow_directors();
if (dirprot)
allow_dirprot();
}
}
}
}
}
/* Initialize all of the output files */
String *outfile = Getattr(n, "outfile");
String *outfile_h = Getattr(n, "outfile_h");
f_begin = NewFile(outfile, "w", SWIG_output_files());
if (!f_begin) {
FileErrorDisplay(outfile);
Exit(EXIT_FAILURE);
}
f_runtime = NewString("");
f_init = NewString("");
f_header = NewString("");
f_wrappers = NewString("");
f_directors_h = NewString("");
f_directors = NewString("");
if (directorsEnabled()) {
f_runtime_h = NewFile(outfile_h, "w", SWIG_output_files());
if (!f_runtime_h) {
FileErrorDisplay(outfile_h);
Exit(EXIT_FAILURE);
}
}
/* Register file targets with the SWIG file handler */
Swig_register_filebyname("header", f_header);
Swig_register_filebyname("wrapper", f_wrappers);
Swig_register_filebyname("begin", f_begin);
Swig_register_filebyname("runtime", f_runtime);
Swig_register_filebyname("init", f_init);
Swig_register_filebyname("director", f_directors);
Swig_register_filebyname("director_h", f_directors_h);
classlist = NewList();
pm = NewString("");
func_stubs = NewString("");
var_stubs = NewString("");
const_stubs = NewString("");
exported = NewString("");
magic = NewString("");
pragma_include = NewString("");
additional_perl_code = NewString("");
command_tab = NewString("static swig_command_info swig_commands[] = {\n");
constant_tab = NewString("static swig_constant_info swig_constants[] = {\n");
variable_tab = NewString("static swig_variable_info swig_variables[] = {\n");
Swig_banner(f_begin);
Printf(f_runtime, "\n\n#ifndef SWIGPERL\n#define SWIGPERL\n#endif\n\n");
if (directorsEnabled()) {
Printf(f_runtime, "#define SWIG_DIRECTORS\n");
}
Printf(f_runtime, "#define SWIG_CASTRANK_MODE\n");
Printf(f_runtime, "\n");
// Is the imported module in another package? (IOW, does it use the
// %module(package="name") option and it's different than the package
// of this module.)
Node *mod = Getattr(n, "module");
Node *options = Getattr(mod, "options");
module = Copy(Getattr(n,"name"));
String *underscore_module = Copy(module);
Replaceall(underscore_module,":","_");
if (verbose > 0) {
fprintf(stdout, "top: using namespace_module: %s\n", Char(namespace_module));
}
if (directorsEnabled()) {
Swig_banner(f_directors_h);
Printf(f_directors_h, "\n");
Printf(f_directors_h, "#ifndef SWIG_%s_WRAP_H_\n", underscore_module);
Printf(f_directors_h, "#define SWIG_%s_WRAP_H_\n\n", underscore_module);
if (dirprot_mode()) {
Printf(f_directors_h, "#include <map>\n");
Printf(f_directors_h, "#include <string>\n\n");
}
Printf(f_directors, "\n\n");
Printf(f_directors, "/* ---------------------------------------------------\n");
Printf(f_directors, " * C++ director class methods\n");
Printf(f_directors, " * --------------------------------------------------- */\n\n");
if (outfile_h) {
String *filename = Swig_file_filename(outfile_h);
Printf(magic, "#include \"%s\"\n\n", filename);
Delete(filename);
}
}
if (verbose > 0) {
fprintf(stdout, "top: using module: %s\n", Char(module));
}
dest_package = options ? Getattr(options, "package") : 0;
if (dest_package) {
namespace_module = Copy(dest_package);
if (verbose > 0) {
fprintf(stdout, "top: Found package: %s\n",Char(dest_package));
}
} else {
namespace_module = Copy(module);
if (verbose > 0) {
fprintf(stdout, "top: No package found\n");
}
}
/* If we're in blessed mode, change the package name to "packagec" */
if (blessed) {
cmodule = NewStringf("%sc",namespace_module);
} else {
cmodule = NewString(namespace_module);
}
/* Create a .pm file
* Need to strip off any prefixes that might be found in
* the module name */
if (no_pmfile) {
f_pm = NewString(0);
} else {
if (!pmfile) {
char *m = Char(module) + Len(module);
while (m != Char(module)) {
if (*m == ':') {
m++;
break;
}
m--;
}
pmfile = NewStringf("%s.pm", m);
}
String *filen = NewStringf("%s%s", SWIG_output_directory(), pmfile);
if ((f_pm = NewFile(filen, "w", SWIG_output_files())) == 0) {
FileErrorDisplay(filen);
Exit(EXIT_FAILURE);
}
Delete(filen);
filen = NULL;
Swig_register_filebyname("pm", f_pm);
Swig_register_filebyname("perl", f_pm);
}
{
String *boot_name = NewStringf("boot_%s", underscore_module);
Printf(f_header,"#define SWIG_init %s\n\n", boot_name);
Printf(f_header,"#define SWIG_name \"%s::%s\"\n", cmodule, boot_name);
Printf(f_header,"#define SWIG_prefix \"%s::\"\n", cmodule);
Delete(boot_name);
}
Swig_banner_target_lang(f_pm, "#");
Printf(f_pm, "\n");
Printf(f_pm, "package %s;\n", module);
/*
* If the package option has been given we are placing our
* symbols into some other packages namespace, so we do not
* mess with @ISA or require for that package
*/
if (dest_package) {
Printf(f_pm,"use base qw(DynaLoader);\n");
} else {
Printf(f_pm,"use base qw(Exporter);\n");
if (!staticoption) {
Printf(f_pm,"use base qw(DynaLoader);\n");
}
}
/* Start creating magic code */
Printv(magic,
"#ifdef __cplusplus\nextern \"C\" {\n#endif\n\n",
"#define MAGIC_CLASS\n",
"SWIGCLASS_STATIC int swig_magic_readonly(pTHX_ SV *SWIGUNUSEDPARM(sv), MAGIC *SWIGUNUSEDPARM(mg)) {\n",
tab4, "MAGIC_PPERL\n", tab4, "croak(\"Value is read-only.\");\n", tab4, "return 0;\n", "}\n", NIL);
Printf(f_wrappers, "#ifdef __cplusplus\nextern \"C\" {\n#endif\n");
/* emit wrappers */
Language::top(n);
if (directorsEnabled()) {
// Insert director runtime into the f_runtime file (make it occur before %header section)
Swig_insert_file("director_common.swg", f_runtime);
Swig_insert_file("director.swg", f_runtime);
}
String *base = NewString("");
/* Dump out variable wrappers */
Printv(magic, "\n#ifdef __cplusplus\n}\n#endif\n", NIL);
Printf(f_header, "%s\n", magic);
String *type_table = NewString("");
/* Patch the type table to reflect the names used by shadow classes */
if (blessed) {
Iterator cls;
for (cls = First(classlist); cls.item; cls = Next(cls)) {
String *pname = Getattr(cls.item, "perl5:proxy");
if (pname) {
SwigType *type = Getattr(cls.item, "classtypeobj");
if (!type)
continue; /* If unnamed class, no type will be found */
type = Copy(type);
SwigType_add_pointer(type);
String *mangled = SwigType_manglestr(type);
SwigType_remember_mangleddata(mangled, NewStringf("\"%s\"", pname));
Delete(type);
Delete(mangled);
}
}
}
SwigType_emit_type_table(f_runtime, type_table);
Printf(f_wrappers, "%s", type_table);
Delete(type_table);
Printf(constant_tab, "{0,0,0,0,0,0}\n};\n");
Printv(f_wrappers, constant_tab, NIL);
Printf(f_wrappers, "#ifdef __cplusplus\n}\n#endif\n");
Printf(f_init, "\t ST(0) = &PL_sv_yes;\n");
Printf(f_init, "\t XSRETURN(1);\n");
Printf(f_init, "}\n");
/* Finish off tables */
Printf(variable_tab, "{0,0,0,0}\n};\n");
Printv(f_wrappers, variable_tab, NIL);
Printf(command_tab, "{0,0}\n};\n");
Printv(f_wrappers, command_tab, NIL);
Printf(f_pm, "package %s;\n", cmodule);
if (!staticoption) {
Printf(f_pm,"bootstrap %s;\n", module);
} else {
Printf(f_pm,"package %s;\n", cmodule);
Printf(f_pm,"boot_%s();\n", underscore_module);
}
Printf(f_pm, "package %s;\n", module);
/*
* If the package option has been given we are placing our
* symbols into some other packages namespace, so we do not
* mess with @EXPORT
*/
if (!dest_package) {
Printf(f_pm,"@EXPORT = qw(%s);\n", exported);
}
Printf(f_pm, "%s", pragma_include);
if (blessed) {
/*
* These methods will be duplicated if package
* has been specified, so we do not output them
*/
if (!dest_package) {
Printv(base, "\n# ---------- BASE METHODS -------------\n\n", "package ", namespace_module, ";\n\n", NIL);
/* Write out the TIE method */
Printv(base, "sub TIEHASH {\n", tab4, "my ($classname,$obj) = @_;\n", tab4, "return bless $obj, $classname;\n", "}\n\n", NIL);
/* Output a CLEAR method. This is just a place-holder, but by providing it we
* can make declarations such as
* %$u = ( x => 2, y=>3, z =>4 );
*
* Where x,y,z are the members of some C/C++ object. */
Printf(base, "sub CLEAR { }\n\n");
/* Output default firstkey/nextkey methods */
Printf(base, "sub FIRSTKEY { }\n\n");
Printf(base, "sub NEXTKEY { }\n\n");
/* Output a FETCH method. This is actually common to all classes */
Printv(base,
"sub FETCH {\n",
tab4, "my ($self,$field) = @_;\n", tab4, "my $member_func = \"swig_${field}_get\";\n", tab4, "$self->$member_func();\n", "}\n\n", NIL);
/* Output a STORE method. This is also common to all classes (might move to base class) */
Printv(base,
"sub STORE {\n",
tab4, "my ($self,$field,$newval) = @_;\n",
tab4, "my $member_func = \"swig_${field}_set\";\n", tab4, "$self->$member_func($newval);\n", "}\n\n", NIL);
/* Output a 'this' method */
Printv(base, "sub this {\n", tab4, "my $ptr = shift;\n", tab4, "return tied(%$ptr);\n", "}\n\n", NIL);
Printf(f_pm, "%s", base);
}
/* Emit function stubs for stand-alone functions */
Printf(f_pm, "\n# ------- FUNCTION WRAPPERS --------\n\n");
Printf(f_pm, "package %s;\n\n", namespace_module);
Printf(f_pm, "%s", func_stubs);
/* Emit package code for different classes */
Printf(f_pm, "%s", pm);
if (num_consts > 0) {
/* Emit constant stubs */
Printf(f_pm, "\n# ------- CONSTANT STUBS -------\n\n");
Printf(f_pm, "package %s;\n\n", namespace_module);
Printf(f_pm, "%s", const_stubs);
}
/* Emit variable stubs */
Printf(f_pm, "\n# ------- VARIABLE STUBS --------\n\n");
Printf(f_pm, "package %s;\n\n", namespace_module);
Printf(f_pm, "%s", var_stubs);
}
/* Add additional Perl code at the end */
Printf(f_pm, "%s", additional_perl_code);
Printf(f_pm, "1;\n");
Delete(f_pm);
Delete(base);
Delete(dest_package);
Delete(underscore_module);
/* Close all of the files */
Dump(f_runtime, f_begin);
Dump(f_header, f_begin);
if (directorsEnabled()) {
Dump(f_directors_h, f_runtime_h);
Printf(f_runtime_h, "\n");
Printf(f_runtime_h, "#endif\n");
Dump(f_directors, f_begin);
}
Dump(f_wrappers, f_begin);
Wrapper_pretty_print(f_init, f_begin);
Delete(f_header);
Delete(f_wrappers);
Delete(f_init);
Delete(f_directors);
Delete(f_directors_h);
Delete(f_runtime);
Delete(f_begin);
return SWIG_OK;
}
/* ------------------------------------------------------------
* importDirective(Node *n)
* ------------------------------------------------------------ */
virtual int importDirective(Node *n) {
if (blessed) {
String *modname = Getattr(n, "module");
if (modname) {
Printf(f_pm, "require %s;\n", modname);
}
}
return Language::importDirective(n);
}
/* ------------------------------------------------------------
* functionWrapper()
* ------------------------------------------------------------ */
virtual int functionWrapper(Node *n) {
String *name = Getattr(n, "name");
String *iname = Getattr(n, "sym:name");
SwigType *d = Getattr(n, "type");
ParmList *l = Getattr(n, "parms");
String *overname = 0;
int director_method = 0;
Parm *p;
int i;
Wrapper *f;
char source[256], temp[256];
String *tm;
String *cleanup, *outarg;
int num_saved = 0;
int num_arguments, num_required;
int varargs = 0;
if (Getattr(n, "sym:overloaded")) {
overname = Getattr(n, "sym:overname");
} else {
if (!addSymbol(iname, n))
return SWIG_ERROR;
}
f = NewWrapper();
cleanup = NewString("");
outarg = NewString("");
String *wname = Swig_name_wrapper(iname);
if (overname) {
Append(wname, overname);
}
Setattr(n, "wrap:name", wname);
Printv(f->def, "XS(", wname, ") {\n", "{\n", /* scope to destroy C++ objects before croaking */
NIL);
emit_parameter_variables(l, f);
emit_attach_parmmaps(l, f);
Setattr(n, "wrap:parms", l);
num_arguments = emit_num_arguments(l);
num_required = emit_num_required(l);
varargs = emit_isvarargs(l);
Wrapper_add_local(f, "argvi", "int argvi = 0");
/* Check the number of arguments */
if (!varargs) {
Printf(f->code, " if ((items < %d) || (items > %d)) {\n", num_required, num_arguments);
} else {
Printf(f->code, " if (items < %d) {\n", num_required);
}
Printf(f->code, " SWIG_croak(\"Usage: %s\");\n", usage_func(Char(iname), d, l));
Printf(f->code, "}\n");
/* Write code to extract parameters. */
for (i = 0, p = l; i < num_arguments; i++) {
/* Skip ignored arguments */
while (checkAttribute(p, "tmap:in:numinputs", "0")) {
p = Getattr(p, "tmap:in:next");
}
SwigType *pt = Getattr(p, "type");
/* Produce string representation of source and target arguments */
sprintf(source, "ST(%d)", i);
if (i >= num_required) {
Printf(f->code, " if (items > %d) {\n", i);
}
if ((tm = Getattr(p, "tmap:in"))) {
Replaceall(tm, "$input", source);
Setattr(p, "emit:input", source); /* Save input location */
if (Getattr(p, "wrap:disown") || (Getattr(p, "tmap:in:disown"))) {
Replaceall(tm, "$disown", "SWIG_POINTER_DISOWN");
} else {
Replaceall(tm, "$disown", "0");
}
Printf(f->code, "%s\n", tm);
p = Getattr(p, "tmap:in:next");
} else {
Swig_warning(WARN_TYPEMAP_IN_UNDEF, input_file, line_number, "Unable to use type %s as a function argument.\n", SwigType_str(pt, 0));
p = nextSibling(p);
}
if (i >= num_required) {
Printf(f->code, " }\n");
}
}
if (varargs) {
if (p && (tm = Getattr(p, "tmap:in"))) {
sprintf(source, "ST(%d)", i);
Replaceall(tm, "$input", source);
Setattr(p, "emit:input", source);
Printf(f->code, "if (items >= %d) {\n", i);
Printv(f->code, tm, "\n", NIL);
Printf(f->code, "}\n");
}
}
/* Insert constraint checking code */
for (p = l; p;) {
if ((tm = Getattr(p, "tmap:check"))) {
Printv(f->code, tm, "\n", NIL);
p = Getattr(p, "tmap:check:next");
} else {
p = nextSibling(p);
}
}
/* Insert cleanup code */
for (i = 0, p = l; p; i++) {
if ((tm = Getattr(p, "tmap:freearg"))) {
Replaceall(tm, "$arg", Getattr(p, "emit:input"));
Replaceall(tm, "$input", Getattr(p, "emit:input"));
Printv(cleanup, tm, "\n", NIL);
p = Getattr(p, "tmap:freearg:next");
} else {
p = nextSibling(p);
}
}
/* Insert argument output code */
num_saved = 0;
for (i = 0, p = l; p; i++) {
if ((tm = Getattr(p, "tmap:argout"))) {
SwigType *t = Getattr(p, "type");
Replaceall(tm, "$result", "ST(argvi)");
if (is_shadow(t)) {
Replaceall(tm, "$shadow", "SWIG_SHADOW");
} else {
Replaceall(tm, "$shadow", "0");
}
String *in = Getattr(p, "emit:input");
if (in) {
sprintf(temp, "_saved[%d]", num_saved);
Replaceall(tm, "$arg", temp);
Replaceall(tm, "$input", temp);
Printf(f->code, "_saved[%d] = %s;\n", num_saved, in);
num_saved++;
}
Printv(outarg, tm, "\n", NIL);
p = Getattr(p, "tmap:argout:next");
} else {
p = nextSibling(p);
}
}
/* If there were any saved arguments, emit a local variable for them */
if (num_saved) {
sprintf(temp, "_saved[%d]", num_saved);
Wrapper_add_localv(f, "_saved", "SV *", temp, NIL);
}
director_method = is_member_director(n) && !is_smart_pointer() && 0 != Cmp(nodeType(n), "destructor");
if (director_method) {
Wrapper_add_local(f, "director", "Swig::Director *director = 0");
Append(f->code, "director = SWIG_DIRECTOR_CAST(arg1);\n");
if (dirprot_mode() && !is_public(n)) {
Printf(f->code, "if (!director || !(director->swig_get_inner(\"%s\"))) {\n", name);
Printf(f->code, "SWIG_exception_fail(SWIG_RuntimeError, \"accessing protected member %s\");\n", name);
Append(f->code, "}\n");
}
Wrapper_add_local(f, "upcall", "bool upcall = false");
Printf(f->code, "upcall = director && SvSTASH(SvRV(ST(0))) == gv_stashpv(director->swig_get_class(), 0);\n");
}
/* Emit the function call */
if (director_method) {
Append(f->code, "try {\n");
}
/* Now write code to make the function call */
Swig_director_emit_dynamic_cast(n, f);
String *actioncode = emit_action(n);
if (director_method) {
Append(actioncode, "} catch (Swig::DirectorException& swig_err) {\n");
Append(actioncode, " sv_setsv(ERRSV, swig_err.getNative());\n");
Append(actioncode, " SWIG_fail;\n");
Append(actioncode, "}\n");
}
if ((tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode))) {
SwigType *t = Getattr(n, "type");
Replaceall(tm, "$result", "ST(argvi)");
if (is_shadow(t)) {
Replaceall(tm, "$shadow", "SWIG_SHADOW");
} else {
Replaceall(tm, "$shadow", "0");
}
if (GetFlag(n, "feature:new")) {
Replaceall(tm, "$owner", "SWIG_OWNER");
} else {
Replaceall(tm, "$owner", "0");
}
Printf(f->code, "%s\n", tm);
} else {
Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number, "Unable to use return type %s in function %s.\n", SwigType_str(d, 0), name);
}
emit_return_variable(n, d, f);
/* If there were any output args, take care of them. */
Printv(f->code, outarg, NIL);
/* If there was any cleanup, do that. */
Printv(f->code, cleanup, NIL);
if (GetFlag(n, "feature:new")) {
if ((tm = Swig_typemap_lookup("newfree", n, Swig_cresult_name(), 0))) {
Printf(f->code, "%s\n", tm);
}
}
if ((tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0))) {
Printf(f->code, "%s\n", tm);
}
if (director_method) {
if ((tm = Swig_typemap_lookup("directorfree", n, Swig_cresult_name(), 0))) {
Replaceall(tm, "$input", Swig_cresult_name());
Replaceall(tm, "$result", "ST(argvi)");
Printf(f->code, "%s\n", tm);
Delete(tm);
}
}
Printv(f->code, "XSRETURN(argvi);\n", "fail:\n", cleanup, "SWIG_croak_null();\n" "}\n" "}\n", NIL);
/* Add the dXSARGS last */
Wrapper_add_local(f, "dXSARGS", "dXSARGS");
/* Substitute the cleanup code */
Replaceall(f->code, "$cleanup", cleanup);
Replaceall(f->code, "$symname", iname);
/* Dump the wrapper function */
Wrapper_print(f, f_wrappers);
/* Now register the function */
if (!Getattr(n, "sym:overloaded")) {
Printf(command_tab, "{\"%s::%s\", %s},\n", cmodule, iname, wname);
} else if (!Getattr(n, "sym:nextSibling")) {
/* Generate overloaded dispatch function */
int maxargs;
String *dispatch = Swig_overload_dispatch_cast(n, "PUSHMARK(MARK); SWIG_CALLXS(%s); return;", &maxargs);
/* Generate a dispatch wrapper for all overloaded functions */
Wrapper *df = NewWrapper();
String *dname = Swig_name_wrapper(iname);
Printv(df->def, "XS(", dname, ") {\n", NIL);
Wrapper_add_local(df, "dXSARGS", "dXSARGS");
Printv(df->code, dispatch, "\n", NIL);
Printf(df->code, "croak(\"No matching function for overloaded '%s'\");\n", iname);
Printf(df->code, "XSRETURN(0);\n");
Printv(df->code, "}\n", NIL);
Wrapper_print(df, f_wrappers);
Printf(command_tab, "{\"%s::%s\", %s},\n", cmodule, iname, dname);
DelWrapper(df);
Delete(dispatch);
Delete(dname);
}
if (!Getattr(n, "sym:nextSibling")) {
if (export_all) {
Printf(exported, "%s ", iname);
}
/* --------------------------------------------------------------------
* Create a stub for this function, provided it's not a member function
* -------------------------------------------------------------------- */
if ((blessed) && (!member_func)) {
Printv(func_stubs, "*", iname, " = *", cmodule, "::", iname, ";\n", NIL);
}
}
Delete(cleanup);
Delete(outarg);
DelWrapper(f);
return SWIG_OK;
}
/* ------------------------------------------------------------
* variableWrapper()
* ------------------------------------------------------------ */
virtual int variableWrapper(Node *n) {
String *name = Getattr(n, "name");
String *iname = Getattr(n, "sym:name");
SwigType *t = Getattr(n, "type");
Wrapper *getf, *setf;
String *tm;
String *getname = Swig_name_get(NSPACE_TODO, iname);
String *setname = Swig_name_set(NSPACE_TODO, iname);
String *get_name = Swig_name_wrapper(getname);
String *set_name = Swig_name_wrapper(setname);
if (!addSymbol(iname, n))
return SWIG_ERROR;
getf = NewWrapper();
setf = NewWrapper();
/* Create a Perl function for setting the variable value */
if (!GetFlag(n, "feature:immutable")) {
Setattr(n, "wrap:name", set_name);
Printf(setf->def, "SWIGCLASS_STATIC int %s(pTHX_ SV* sv, MAGIC * SWIGUNUSEDPARM(mg)) {\n", set_name);
Printv(setf->code, tab4, "MAGIC_PPERL\n", NIL);
/* Check for a few typemaps */
tm = Swig_typemap_lookup("varin", n, name, 0);
if (tm) {
Replaceall(tm, "$input", "sv");
/* Printf(setf->code,"%s\n", tm); */
emit_action_code(n, setf->code, tm);
} else {
Swig_warning(WARN_TYPEMAP_VARIN_UNDEF, input_file, line_number, "Unable to set variable of type %s.\n", SwigType_str(t, 0));
DelWrapper(setf);
DelWrapper(getf);
return SWIG_NOWRAP;
}
Printf(setf->code, "fail:\n");
Printf(setf->code, " return 1;\n}\n");
Replaceall(setf->code, "$symname", iname);
Wrapper_print(setf, magic);
}
/* Now write a function to evaluate the variable */
Setattr(n, "wrap:name", get_name);
int addfail = 0;
Printf(getf->def, "SWIGCLASS_STATIC int %s(pTHX_ SV *sv, MAGIC *SWIGUNUSEDPARM(mg)) {\n", get_name);
Printv(getf->code, tab4, "MAGIC_PPERL\n", NIL);
if ((tm = Swig_typemap_lookup("varout", n, name, 0))) {
Replaceall(tm, "$result", "sv");
if (is_shadow(t)) {
Replaceall(tm, "$shadow", "SWIG_SHADOW");
} else {
Replaceall(tm, "$shadow", "0");
}
/* Printf(getf->code,"%s\n", tm); */
addfail = emit_action_code(n, getf->code, tm);
} else {
Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number, "Unable to read variable of type %s\n", SwigType_str(t, 0));
DelWrapper(setf);
DelWrapper(getf);
return SWIG_NOWRAP;
}
Printf(getf->code, " return 1;\n");
if (addfail) {
Append(getf->code, "fail:\n");
Append(getf->code, " return 0;\n");
}
Append(getf->code, "}\n");
Replaceall(getf->code, "$symname", iname);
Wrapper_print(getf, magic);
String *tt = Getattr(n, "tmap:varout:type");
if (tt) {
tt = NewStringf("&%s", tt);
} else {
tt = NewString("0");
}
/* Now add symbol to the PERL interpreter */
if (GetFlag(n, "feature:immutable")) {
Printv(variable_tab, tab4, "{ \"", cmodule, "::", iname, "\", MAGIC_CLASS swig_magic_readonly, MAGIC_CLASS ", get_name, ",", tt, " },\n", NIL);
} else {
Printv(variable_tab, tab4, "{ \"", cmodule, "::", iname, "\", MAGIC_CLASS ", set_name, ", MAGIC_CLASS ", get_name, ",", tt, " },\n", NIL);
}
/* If we're blessed, try to figure out what to do with the variable
1. If it's a Perl object of some sort, create a tied-hash
around it.
2. Otherwise, just hack Perl's symbol table */
if (blessed) {
if (is_shadow(t)) {
Printv(var_stubs,
"\nmy %__", iname, "_hash;\n",
"tie %__", iname, "_hash,\"", is_shadow(t), "\", $",
cmodule, "::", iname, ";\n", "$", iname, "= \\%__", iname, "_hash;\n", "bless $", iname, ", ", is_shadow(t), ";\n", NIL);
} else {
Printv(var_stubs, "*", iname, " = *", cmodule, "::", iname, ";\n", NIL);
}
}
if (export_all)
Printf(exported, "$%s ", iname);
Delete(tt);
DelWrapper(setf);
DelWrapper(getf);
Delete(getname);
Delete(setname);
Delete(set_name);
Delete(get_name);
return SWIG_OK;
}
/* ------------------------------------------------------------
* constantWrapper()
* ------------------------------------------------------------ */
virtual int constantWrapper(Node *n) {
String *name = Getattr(n, "name");
String *iname = Getattr(n, "sym:name");
SwigType *type = Getattr(n, "type");
String *rawval = Getattr(n, "rawval");
String *value = rawval ? rawval : Getattr(n, "value");
String *tm;
if (!addSymbol(iname, n))
return SWIG_ERROR;
/* Special hook for member pointer */
if (SwigType_type(type) == T_MPOINTER) {
String *wname = Swig_name_wrapper(iname);
Printf(f_wrappers, "static %s = %s;\n", SwigType_str(type, wname), value);
value = Char(wname);
}
if ((tm = Swig_typemap_lookup("consttab", n, name, 0))) {
Replaceall(tm, "$value", value);
if (is_shadow(type)) {
Replaceall(tm, "$shadow", "SWIG_SHADOW");
} else {
Replaceall(tm, "$shadow", "0");
}
Printf(constant_tab, "%s,\n", tm);
} else if ((tm = Swig_typemap_lookup("constcode", n, name, 0))) {
Replaceall(tm, "$value", value);
if (is_shadow(type)) {
Replaceall(tm, "$shadow", "SWIG_SHADOW");
} else {
Replaceall(tm, "$shadow", "0");
}
Printf(f_init, "%s\n", tm);
} else {
Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number, "Unsupported constant value.\n");
return SWIG_NOWRAP;
}
if (blessed) {
if (is_shadow(type)) {
Printv(var_stubs,
"\nmy %__", iname, "_hash;\n",
"tie %__", iname, "_hash,\"", is_shadow(type), "\", $",
cmodule, "::", iname, ";\n", "$", iname, "= \\%__", iname, "_hash;\n", "bless $", iname, ", ", is_shadow(type), ";\n", NIL);
} else if (do_constants) {
Printv(const_stubs, "sub ", name, " () { $", cmodule, "::", name, " }\n", NIL);
num_consts++;
} else {
Printv(var_stubs, "*", iname, " = *", cmodule, "::", iname, ";\n", NIL);
}
}
if (export_all) {
if (do_constants && !is_shadow(type)) {
Printf(exported, "%s ", name);
} else {
Printf(exported, "$%s ", iname);
}
}
return SWIG_OK;
}
/* ------------------------------------------------------------
* usage_func()
* ------------------------------------------------------------ */
char *usage_func(char *iname, SwigType *, ParmList *l) {
static String *temp = 0;
Parm *p;
int i;
if (!temp)
temp = NewString("");
Clear(temp);
Printf(temp, "%s(", iname);
/* Now go through and print 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 parameter has been named, use that. Otherwise, just print a type */
if (SwigType_type(pt) != T_VOID) {
if (Len(pn) > 0) {
Printf(temp, "%s", pn);
} else {
Printf(temp, "%s", SwigType_str(pt, 0));
}
}
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);
}
}
Printf(temp, ");");
return Char(temp);
}
/* ------------------------------------------------------------
* nativeWrapper()
* ------------------------------------------------------------ */
virtual int nativeWrapper(Node *n) {
String *name = Getattr(n, "sym:name");
String *funcname = Getattr(n, "wrap:name");
if (!addSymbol(funcname, n))
return SWIG_ERROR;
Printf(command_tab, "{\"%s::%s\", %s},\n", cmodule, name, funcname);
if (export_all)
Printf(exported, "%s ", name);
if (blessed) {
Printv(func_stubs, "*", name, " = *", cmodule, "::", name, ";\n", NIL);
}
return SWIG_OK;
}
/* ----------------------------------------------------------------------------
* OBJECT-ORIENTED FEATURES
*
* These extensions provide a more object-oriented interface to C++
* classes and structures. The code here is based on extensions
* provided by David Fletcher and Gary Holt.
*
* I have generalized these extensions to make them more general purpose
* and to resolve object-ownership problems.
*
* The approach here is very similar to the Python module :
* 1. All of the original methods are placed into a single
* package like before except that a 'c' is appended to the
* package name.
*
* 2. All methods and function calls are wrapped with a new
* perl function. While possibly inefficient this allows
* us to catch complex function arguments (which are hard to
* track otherwise).
*
* 3. Classes are represented as tied-hashes in a manner similar
* to Gary Holt's extension. This allows us to access
* member data.
*
* 4. Stand-alone (global) C functions are modified to take
* tied hashes as arguments for complex datatypes (if
* appropriate).
*
* 5. Global variables involving a class/struct is encapsulated
* in a tied hash.
*
* ------------------------------------------------------------------------- */
void setclassname(Node *n) {
String *symname = Getattr(n, "sym:name");
String *fullname;
String *actualpackage;
Node *clsmodule = Getattr(n, "module");
if (!clsmodule) {
/* imported module does not define a module name. Oh well */
return;
}
/* Do some work on the class name */
if (verbose > 0) {
String *modulename = Getattr(clsmodule, "name");
fprintf(stdout, "setclassname: Found sym:name: %s\n", Char(symname));
fprintf(stdout, "setclassname: Found module: %s\n", Char(modulename));
fprintf(stdout, "setclassname: No package found\n");
}
if (dest_package) {
fullname = NewStringf("%s::%s", namespace_module, symname);
} else {
actualpackage = Getattr(clsmodule,"name");
if (verbose > 0) {
fprintf(stdout, "setclassname: Found actualpackage: %s\n", Char(actualpackage));
}
if ((!compat) && (!Strchr(symname,':'))) {
fullname = NewStringf("%s::%s",actualpackage,symname);
} else {
fullname = NewString(symname);
}
}
if (verbose > 0) {
fprintf(stdout, "setclassname: setting proxy: %s\n", Char(fullname));
}
Setattr(n, "perl5:proxy", fullname);
}
/* ------------------------------------------------------------
* classDeclaration()
* ------------------------------------------------------------ */
virtual int classDeclaration(Node *n) {
/* Do some work on the class name */
if (!Getattr(n, "feature:onlychildren")) {
if (blessed) {
setclassname(n);
Append(classlist, n);
}
}
return Language::classDeclaration(n);
}
/* ------------------------------------------------------------
* classHandler()
* ------------------------------------------------------------ */
virtual int classHandler(Node *n) {
if (blessed) {
have_constructor = 0;
have_operators = 0;
have_destructor = 0;
have_data_members = 0;
operators = NewHash();
class_name = Getattr(n, "sym:name");
if (!addSymbol(class_name, n))
return SWIG_ERROR;
/* Use the fully qualified name of the Perl class */
if (!compat) {
fullclassname = NewStringf("%s::%s", namespace_module, class_name);
} else {
fullclassname = NewString(class_name);
}
real_classname = Getattr(n, "name");
pcode = NewString("");
// blessedmembers = NewString("");
}
/* Emit all of the members */
Language::classHandler(n);
/* Finish the rest of the class */
if (blessed) {
/* Generate a client-data entry */
SwigType *ct = NewStringf("p.%s", real_classname);
Printv(f_init, "SWIG_TypeClientData(SWIGTYPE", SwigType_manglestr(ct), ", (void*) \"", fullclassname, "\");\n", NIL);
SwigType_remember(ct);
Delete(ct);
Printv(pm, "\n############# Class : ", fullclassname, " ##############\n", "\npackage ", fullclassname, ";\n", NIL);
if (have_operators) {
Printf(pm, "use overload\n");
Iterator ki;
for (ki = First(operators); ki.key; ki = Next(ki)) {
char *name = Char(ki.key);
// fprintf(stderr,"found name: <%s>\n", name);
if (strstr(name, "__eq__")) {
Printv(pm, tab4, "\"==\" => sub { $_[0]->__eq__($_[1])},\n",NIL);
} else if (strstr(name, "__ne__")) {
Printv(pm, tab4, "\"!=\" => sub { $_[0]->__ne__($_[1])},\n",NIL);
// there are no tests for this in operator_overload_runme.pl
// it is likely to be broken
// } else if (strstr(name, "__assign__")) {
// Printv(pm, tab4, "\"=\" => sub { $_[0]->__assign__($_[1])},\n",NIL);
} else if (strstr(name, "__str__")) {
Printv(pm, tab4, "'\"\"' => sub { $_[0]->__str__()},\n",NIL);
} else if (strstr(name, "__plusplus__")) {
Printv(pm, tab4, "\"++\" => sub { $_[0]->__plusplus__()},\n",NIL);
} else if (strstr(name, "__minmin__")) {
Printv(pm, tab4, "\"--\" => sub { $_[0]->__minmin__()},\n",NIL);
} else if (strstr(name, "__add__")) {
Printv(pm, tab4, "\"+\" => sub { $_[0]->__add__($_[1])},\n",NIL);
} else if (strstr(name, "__sub__")) {
Printv(pm, tab4, "\"-\" => sub { if( not $_[2] ) { $_[0]->__sub__($_[1]) }\n",NIL);
Printv(pm, tab8, "elsif( $_[0]->can('__rsub__') ) { $_[0]->__rsub__($_[1]) }\n",NIL);
Printv(pm, tab8, "else { die(\"reverse subtraction not supported\") }\n",NIL);
Printv(pm, tab8, "},\n",NIL);
} else if (strstr(name, "__mul__")) {
Printv(pm, tab4, "\"*\" => sub { $_[0]->__mul__($_[1])},\n",NIL);
} else if (strstr(name, "__div__")) {
Printv(pm, tab4, "\"/\" => sub { $_[0]->__div__($_[1])},\n",NIL);
} else if (strstr(name, "__mod__")) {
Printv(pm, tab4, "\"%\" => sub { $_[0]->__mod__($_[1])},\n",NIL);
// there are no tests for this in operator_overload_runme.pl
// it is likely to be broken
// } else if (strstr(name, "__and__")) {
// Printv(pm, tab4, "\"&\" => sub { $_[0]->__and__($_[1])},\n",NIL);
// there are no tests for this in operator_overload_runme.pl
// it is likely to be broken
// } else if (strstr(name, "__or__")) {
// Printv(pm, tab4, "\"|\" => sub { $_[0]->__or__($_[1])},\n",NIL);
} else if (strstr(name, "__gt__")) {
Printv(pm, tab4, "\">\" => sub { $_[0]->__gt__($_[1])},\n",NIL);
} else if (strstr(name, "__ge__")) {
Printv(pm, tab4, "\">=\" => sub { $_[0]->__ge__($_[1])},\n",NIL);
} else if (strstr(name, "__not__")) {
Printv(pm, tab4, "\"!\" => sub { $_[0]->__not__()},\n",NIL);
} else if (strstr(name, "__lt__")) {
Printv(pm, tab4, "\"<\" => sub { $_[0]->__lt__($_[1])},\n",NIL);
} else if (strstr(name, "__le__")) {
Printv(pm, tab4, "\"<=\" => sub { $_[0]->__le__($_[1])},\n",NIL);
} else if (strstr(name, "__pluseq__")) {
Printv(pm, tab4, "\"+=\" => sub { $_[0]->__pluseq__($_[1])},\n",NIL);
} else if (strstr(name, "__mineq__")) {
Printv(pm, tab4, "\"-=\" => sub { $_[0]->__mineq__($_[1])},\n",NIL);
} else if (strstr(name, "__neg__")) {
Printv(pm, tab4, "\"neg\" => sub { $_[0]->__neg__()},\n",NIL);
} else {
fprintf(stderr,"Unknown operator: %s\n", name);
}
}
Printv(pm, tab4,
"\"=\" => sub { my $class = ref($_[0]); $class->new($_[0]) },\n", NIL);
Printv(pm, tab4, "\"fallback\" => 1;\n", NIL);
}
// make use strict happy
Printv(pm, "use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);\n", NIL);
/* If we are inheriting from a base class, set that up */
Printv(pm, "@ISA = qw(", NIL);
/* Handle inheritance */
List *baselist = Getattr(n, "bases");
if (baselist && Len(baselist)) {
Iterator b;
b = First(baselist);
while (b.item) {
String *bname = Getattr(b.item, "perl5:proxy");
if (!bname) {
b = Next(b);
continue;
}
Printv(pm, " ", bname, NIL);
b = Next(b);
}
}
/* Module comes last */
if (!compat || Cmp(namespace_module, fullclassname)) {
Printv(pm, " ", namespace_module, NIL);
}
Printf(pm, " );\n");
/* Dump out a hash table containing the pointers that we own */
Printf(pm, "%%OWNER = ();\n");
if (have_data_members || have_destructor)
Printf(pm, "%%ITERATORS = ();\n");
/* Dump out the package methods */
Printv(pm, pcode, NIL);
Delete(pcode);
/* Output methods for managing ownership */
String *director_disown;
if (Getattr(n, "perl5:directordisown")) {
director_disown = NewStringf("%s%s($self);\n", tab4, Getattr(n, "perl5:directordisown"));
} else {
director_disown = NewString("");
}
Printv(pm,
"sub DISOWN {\n",
tab4, "my $self = shift;\n",
director_disown,
tab4, "my $ptr = tied(%$self);\n",
tab4, "delete $OWNER{$ptr};\n",
"}\n\n", "sub ACQUIRE {\n", tab4, "my $self = shift;\n", tab4, "my $ptr = tied(%$self);\n", tab4, "$OWNER{$ptr} = 1;\n", "}\n\n", NIL);
Delete(director_disown);
/* Only output the following methods if a class has member data */
Delete(operators);
operators = 0;
if (Swig_directorclass(n)) {
/* director classes need a way to recover subclass instance attributes */
Node *get_attr = NewHash();
String *mrename;
String *symname = Getattr(n, "sym:name");
mrename = Swig_name_disown(NSPACE_TODO, symname);
Replaceall(mrename, "disown", "swig_get_attr");
String *type = NewString(getClassType());
String *name = NewString("self");
SwigType_add_pointer(type);
Parm *p = NewParm(type, name, n);
Delete(name);
Delete(type);
type = NewString("SV");
SwigType_add_pointer(type);
String *action = NewString("");
Printv(action, "{\n", " Swig::Director *director = SWIG_DIRECTOR_CAST(arg1);\n",
" result = sv_newmortal();\n" " if (director) sv_setsv(result, director->swig_get_self());\n", "}\n", NIL);
Setfile(get_attr, Getfile(n));
Setline(get_attr, Getline(n));
Setattr(get_attr, "wrap:action", action);
Setattr(get_attr, "name", mrename);
Setattr(get_attr, "sym:name", mrename);
Setattr(get_attr, "type", type);
Setattr(get_attr, "parms", p);
Delete(action);
Delete(type);
Delete(p);
member_func = 1;
functionWrapper(get_attr);
member_func = 0;
Delete(get_attr);
Printv(pm, "sub FETCH {\n", tab4, "my ($self,$field) = @_;\n", tab4, "my $member_func = \"swig_${field}_get\";\n", tab4,
"if (not $self->can($member_func)) {\n", tab8, "my $h = ", cmodule, "::", mrename, "($self);\n", tab8, "return $h->{$field} if $h;\n",
tab4, "}\n", tab4, "return $self->$member_func;\n", "}\n", "\n", "sub STORE {\n", tab4, "my ($self,$field,$newval) = @_;\n", tab4,
"my $member_func = \"swig_${field}_set\";\n", tab4, "if (not $self->can($member_func)) {\n", tab8, "my $h = ", cmodule, "::", mrename,
"($self);\n", tab8, "return $h->{$field} = $newval if $h;\n", tab4, "}\n", tab4, "return $self->$member_func($newval);\n", "}\n", NIL);
Delete(mrename);
}
}
return SWIG_OK;
}
/* ------------------------------------------------------------
* memberfunctionHandler()
* ------------------------------------------------------------ */
virtual int memberfunctionHandler(Node *n) {
String *symname = Getattr(n, "sym:name");
member_func = 1;
Language::memberfunctionHandler(n);
member_func = 0;
if ((blessed) && (!Getattr(n, "sym:nextSibling"))) {
if (Strstr(symname, "__eq__")) {
DohSetInt(operators, "__eq__", 1);
have_operators = 1;
} else if (Strstr(symname, "__ne__")) {
DohSetInt(operators, "__ne__", 1);
have_operators = 1;
} else if (Strstr(symname, "__assign__")) {
DohSetInt(operators, "__assign__", 1);
have_operators = 1;
} else if (Strstr(symname, "__str__")) {
DohSetInt(operators, "__str__", 1);
have_operators = 1;
} else if (Strstr(symname, "__add__")) {
DohSetInt(operators, "__add__", 1);
have_operators = 1;
} else if (Strstr(symname, "__sub__")) {
DohSetInt(operators, "__sub__", 1);
have_operators = 1;
} else if (Strstr(symname, "__mul__")) {
DohSetInt(operators, "__mul__", 1);
have_operators = 1;
} else if (Strstr(symname, "__div__")) {
DohSetInt(operators, "__div__", 1);
have_operators = 1;
} else if (Strstr(symname, "__mod__")) {
DohSetInt(operators, "__mod__", 1);
have_operators = 1;
} else if (Strstr(symname, "__and__")) {
DohSetInt(operators, "__and__", 1);
have_operators = 1;
} else if (Strstr(symname, "__or__")) {
DohSetInt(operators, "__or__", 1);
have_operators = 1;
} else if (Strstr(symname, "__not__")) {
DohSetInt(operators, "__not__", 1);
have_operators = 1;
} else if (Strstr(symname, "__gt__")) {
DohSetInt(operators, "__gt__", 1);
have_operators = 1;
} else if (Strstr(symname, "__ge__")) {
DohSetInt(operators, "__ge__", 1);
have_operators = 1;
} else if (Strstr(symname, "__lt__")) {
DohSetInt(operators, "__lt__", 1);
have_operators = 1;
} else if (Strstr(symname, "__le__")) {
DohSetInt(operators, "__le__", 1);
have_operators = 1;
} else if (Strstr(symname, "__neg__")) {
DohSetInt(operators, "__neg__", 1);
have_operators = 1;
} else if (Strstr(symname, "__plusplus__")) {
DohSetInt(operators, "__plusplus__", 1);
have_operators = 1;
} else if (Strstr(symname, "__minmin__")) {
DohSetInt(operators, "__minmin__", 1);
have_operators = 1;
} else if (Strstr(symname, "__mineq__")) {
DohSetInt(operators, "__mineq__", 1);
have_operators = 1;
} else if (Strstr(symname, "__pluseq__")) {
DohSetInt(operators, "__pluseq__", 1);
have_operators = 1;
}
if (Getattr(n, "feature:shadow")) {
String *plcode = perlcode(Getattr(n, "feature:shadow"), 0);
String *plaction = NewStringf("%s::%s", cmodule, Swig_name_member(NSPACE_TODO, class_name, symname));
Replaceall(plcode, "$action", plaction);
Delete(plaction);
Printv(pcode, plcode, NIL);
} else {
Printv(pcode, "*", symname, " = *", cmodule, "::", Swig_name_member(NSPACE_TODO, class_name, symname), ";\n", NIL);
}
}
return SWIG_OK;
}
/* ------------------------------------------------------------
* membervariableHandler()
*
* Adds an instance member.
* ----------------------------------------------------------------------------- */
virtual int membervariableHandler(Node *n) {
String *symname = Getattr(n, "sym:name");
/* SwigType *t = Getattr(n,"type"); */
/* Emit a pair of get/set functions for the variable */
member_func = 1;
Language::membervariableHandler(n);
member_func = 0;
if (blessed) {
Printv(pcode, "*swig_", symname, "_get = *", cmodule, "::", Swig_name_get(NSPACE_TODO, Swig_name_member(NSPACE_TODO, class_name, symname)), ";\n", NIL);
Printv(pcode, "*swig_", symname, "_set = *", cmodule, "::", Swig_name_set(NSPACE_TODO, Swig_name_member(NSPACE_TODO, class_name, symname)), ";\n", NIL);
/* Now we need to generate a little Perl code for this */
/* if (is_shadow(t)) {
*//* This is a Perl object that we have already seen. Add an
entry to the members list *//*
Printv(blessedmembers,
tab4, symname, " => '", is_shadow(t), "',\n",
NIL);
}
*/
}
have_data_members++;
return SWIG_OK;
}
/* ------------------------------------------------------------
* constructorDeclaration()
*
* Emits a blessed constructor for our class. In addition to our construct
* we manage a Perl hash table containing all of the pointers created by
* the constructor. This prevents us from accidentally trying to free
* something that wasn't necessarily allocated by malloc or new
* ------------------------------------------------------------ */
virtual int constructorHandler(Node *n) {
String *symname = Getattr(n, "sym:name");
member_func = 1;
Swig_save("perl5:constructorHandler", n, "parms", NIL);
if (Swig_directorclass(n)) {
Parm *parms = Getattr(n, "parms");
Parm *self;
String *name = NewString("self");
String *type = NewString("SV");
SwigType_add_pointer(type);
self = NewParm(type, name, n);
Delete(type);
Delete(name);
Setattr(self, "lname", "O");
if (parms)
set_nextSibling(self, parms);
Setattr(n, "parms", self);
Setattr(n, "wrap:self", "1");
Setattr(n, "hidden", "1");
Delete(self);
}
String *saved_nc = none_comparison;
none_comparison = NewStringf("strcmp(SvPV_nolen(ST(0)), \"%s::%s\") != 0", module, class_name);
String *saved_director_prot_ctor_code = director_prot_ctor_code;
director_prot_ctor_code = NewStringf("if ($comparison) { /* subclassed */\n" " $director_new\n" "} else {\n"
"SWIG_exception_fail(SWIG_RuntimeError, \"accessing abstract class or protected constructor\");\n" "}\n");
Language::constructorHandler(n);
Delete(none_comparison);
none_comparison = saved_nc;
Delete(director_prot_ctor_code);
director_prot_ctor_code = saved_director_prot_ctor_code;
Swig_restore(n);
if ((blessed) && (!Getattr(n, "sym:nextSibling"))) {
if (Getattr(n, "feature:shadow")) {
String *plcode = perlcode(Getattr(n, "feature:shadow"), 0);
String *plaction = NewStringf("%s::%s", module, Swig_name_member(NSPACE_TODO, class_name, symname));
Replaceall(plcode, "$action", plaction);
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(NSPACE_TODO, symname), " {\n", NIL);
}
const char *pkg = getCurrentClass() && Swig_directorclass(getCurrentClass())? "$_[0]" : "shift";
Printv(pcode,
tab4, "my $pkg = ", pkg, ";\n",
tab4, "my $self = ", cmodule, "::", Swig_name_construct(NSPACE_TODO, symname), "(@_);\n", tab4, "bless $self, $pkg if defined($self);\n", "}\n\n", NIL);
have_constructor = 1;
}
}
member_func = 0;
return SWIG_OK;
}
/* ------------------------------------------------------------
* destructorHandler()
* ------------------------------------------------------------ */
virtual int destructorHandler(Node *n) {
String *symname = Getattr(n, "sym:name");
member_func = 1;
Language::destructorHandler(n);
if (blessed) {
if (Getattr(n, "feature:shadow")) {
String *plcode = perlcode(Getattr(n, "feature:shadow"), 0);
String *plaction = NewStringf("%s::%s", module, Swig_name_member(NSPACE_TODO, class_name, symname));
Replaceall(plcode, "$action", plaction);
Delete(plaction);
Printv(pcode, plcode, NIL);
} else {
Printv(pcode,
"sub DESTROY {\n",
tab4, "return unless $_[0]->isa('HASH');\n",
tab4, "my $self = tied(%{$_[0]});\n",
tab4, "return unless defined $self;\n",
tab4, "delete $ITERATORS{$self};\n",
tab4, "if (exists $OWNER{$self}) {\n",
tab8, cmodule, "::", Swig_name_destroy(NSPACE_TODO, symname), "($self);\n", tab8, "delete $OWNER{$self};\n", tab4, "}\n}\n\n", NIL);
have_destructor = 1;
}
}
member_func = 0;
return SWIG_OK;
}
/* ------------------------------------------------------------
* staticmemberfunctionHandler()
* ------------------------------------------------------------ */
virtual int staticmemberfunctionHandler(Node *n) {
member_func = 1;
Language::staticmemberfunctionHandler(n);
member_func = 0;
if ((blessed) && (!Getattr(n, "sym:nextSibling"))) {
String *symname = Getattr(n, "sym:name");
Printv(pcode, "*", symname, " = *", cmodule, "::", Swig_name_member(NSPACE_TODO, class_name, symname), ";\n", NIL);
}
return SWIG_OK;
}
/* ------------------------------------------------------------
* staticmembervariableHandler()
* ------------------------------------------------------------ */
virtual int staticmembervariableHandler(Node *n) {
Language::staticmembervariableHandler(n);
if (blessed) {
String *symname = Getattr(n, "sym:name");
Printv(pcode, "*", symname, " = *", cmodule, "::", Swig_name_member(NSPACE_TODO, class_name, symname), ";\n", NIL);
}
return SWIG_OK;
}
/* ------------------------------------------------------------
* memberconstantHandler()
* ------------------------------------------------------------ */
virtual int memberconstantHandler(Node *n) {
String *symname = Getattr(n, "sym:name");
int oldblessed = blessed;
/* Create a normal constant */
blessed = 0;
Language::memberconstantHandler(n);
blessed = oldblessed;
if (blessed) {
Printv(pcode, "*", symname, " = *", cmodule, "::", Swig_name_member(NSPACE_TODO, class_name, symname), ";\n", NIL);
}
return SWIG_OK;
}
/* ------------------------------------------------------------
* pragma()
*
* Pragma directive.
*
* %pragma(perl5) code="String" # Includes a string in the .pm file
* %pragma(perl5) include="file.pl" # Includes a file in the .pm file
* ------------------------------------------------------------ */
virtual int pragmaDirective(Node *n) {
String *lang;
String *code;
String *value;
if (!ImportMode) {
lang = Getattr(n, "lang");
code = Getattr(n, "name");
value = Getattr(n, "value");
if (Strcmp(lang, "perl5") == 0) {
if (Strcmp(code, "code") == 0) {
/* Dump the value string into the .pm file */
if (value) {
Printf(pragma_include, "%s\n", value);
}
} else if (Strcmp(code, "include") == 0) {
/* Include a file into the .pm file */
if (value) {
FILE *f = Swig_include_open(value);
if (!f) {
Swig_error(input_file, line_number, "Unable to locate file %s\n", value);
} else {
char buffer[4096];
while (fgets(buffer, 4095, f)) {
Printf(pragma_include, "%s", buffer);
}
fclose(f);
}
}
} else {
Swig_error(input_file, line_number, "Unrecognized pragma.\n");
}
}
}
return Language::pragmaDirective(n);
}
/* ------------------------------------------------------------
* perlcode() - Output perlcode code into the shadow file
* ------------------------------------------------------------ */
String *perlcode(String *code, const String *indent) {
String *out = NewString("");
String *temp;
char *t;
if (!indent)
indent = "";
temp = NewString(code);
t = Char(temp);
if (*t == '{') {
Delitem(temp, 0);
Delitem(temp, DOH_END);
}
/* Split the input text into lines */
List *clist = SplitLines(temp);
Delete(temp);
int initial = 0;
String *s = 0;
Iterator si;
/* Get the initial indentation */
for (si = First(clist); si.item; si = Next(si)) {
s = si.item;
if (Len(s)) {
char *c = Char(s);
while (*c) {
if (!isspace(*c))
break;
initial++;
c++;
}
if (*c && !isspace(*c))
break;
else {
initial = 0;
}
}
}
while (si.item) {
s = si.item;
if (Len(s) > initial) {
char *c = Char(s);
c += initial;
Printv(out, indent, c, "\n", NIL);
} else {
Printv(out, "\n", NIL);
}
si = Next(si);
}
Delete(clist);
return out;
}
/* ------------------------------------------------------------
* insertDirective()
*
* Hook for %insert directive.
* ------------------------------------------------------------ */
virtual int insertDirective(Node *n) {
String *code = Getattr(n, "code");
String *section = Getattr(n, "section");
if ((!ImportMode) && (Cmp(section, "perl") == 0)) {
Printv(additional_perl_code, code, NIL);
} else {
Language::insertDirective(n);
}
return SWIG_OK;
}
String *runtimeCode() {
String *s = NewString("");
String *shead = Swig_include_sys("perlhead.swg");
if (!shead) {
Printf(stderr, "*** Unable to open 'perlhead.swg'\n");
} else {
Append(s, shead);
Delete(shead);
}
String *serrors = Swig_include_sys("perlerrors.swg");
if (!serrors) {
Printf(stderr, "*** Unable to open 'perlerrors.swg'\n");
} else {
Append(s, serrors);
Delete(serrors);
}
String *srun = Swig_include_sys("perlrun.swg");
if (!srun) {
Printf(stderr, "*** Unable to open 'perlrun.swg'\n");
} else {
Append(s, srun);
Delete(srun);
}
return s;
}
String *defaultExternalRuntimeFilename() {
return NewString("swigperlrun.h");
}
virtual int classDirectorInit(Node *n) {
String *declaration = Swig_director_declaration(n);
Printf(f_directors_h, "\n");
Printf(f_directors_h, "%s\n", declaration);
Printf(f_directors_h, "public:\n");
Delete(declaration);
return Language::classDirectorInit(n);
}
virtual int classDirectorEnd(Node *n) {
if (dirprot_mode()) {
/*
This implementation uses a std::map<std::string,int>.
It should be possible to rewrite it using a more elegant way,
like copying the Java approach for the 'override' array.
But for now, this seems to be the least intrusive way.
*/
Printf(f_directors_h, "\n");
Printf(f_directors_h, "/* Internal director utilities */\n");
Printf(f_directors_h, "public:\n");
Printf(f_directors_h, " bool swig_get_inner(const char *swig_protected_method_name) const {\n");
Printf(f_directors_h, " std::map<std::string, bool>::const_iterator iv = swig_inner.find(swig_protected_method_name);\n");
Printf(f_directors_h, " return (iv != swig_inner.end() ? iv->second : false);\n");
Printf(f_directors_h, " }\n");
Printf(f_directors_h, " void swig_set_inner(const char *swig_protected_method_name, bool swig_val) const {\n");
Printf(f_directors_h, " swig_inner[swig_protected_method_name] = swig_val;\n");
Printf(f_directors_h, " }\n");
Printf(f_directors_h, "private:\n");
Printf(f_directors_h, " mutable std::map<std::string, bool> swig_inner;\n");
}
Printf(f_directors_h, "};\n");
return Language::classDirectorEnd(n);
}
virtual int classDirectorConstructor(Node *n) {
Node *parent = Getattr(n, "parentNode");
String *sub = NewString("");
String *decl = Getattr(n, "decl");
String *supername = Swig_class_name(parent);
String *classname = NewString("");
Printf(classname, "SwigDirector_%s", supername);
/* insert self parameter */
Parm *p;
ParmList *superparms = Getattr(n, "parms");
ParmList *parms = CopyParmList(superparms);
String *type = NewString("SV");
SwigType_add_pointer(type);
p = NewParm(type, NewString("self"), n);
set_nextSibling(p, parms);
parms = p;
if (!Getattr(n, "defaultargs")) {
/* constructor */
{
Wrapper *w = NewWrapper();
String *call;
String *basetype = Getattr(parent, "classtype");
String *target = Swig_method_decl(0, decl, classname, parms, 0);
call = Swig_csuperclass_call(0, basetype, superparms);
Printf(w->def, "%s::%s: %s, Swig::Director(self) { \n", classname, target, call);
Printf(w->def, " SWIG_DIRECTOR_RGTR((%s *)this, this); \n", basetype);
Append(w->def, "}\n");
Delete(target);
Wrapper_print(w, f_directors);
Delete(call);
DelWrapper(w);
}
/* constructor header */
{
String *target = Swig_method_decl(0, decl, classname, parms, 1);
Printf(f_directors_h, " %s;\n", target);
Delete(target);
}
}
Delete(sub);
Delete(classname);
Delete(supername);
Delete(parms);
return Language::classDirectorConstructor(n);
}
virtual int classDirectorMethod(Node *n, Node *parent, String *super) {
int is_void = 0;
int is_pointer = 0;
String *decl = Getattr(n, "decl");
String *name = Getattr(n, "name");
String *classname = Getattr(parent, "sym:name");
String *c_classname = Getattr(parent, "name");
String *symname = Getattr(n, "sym:name");
String *declaration = NewString("");
ParmList *l = Getattr(n, "parms");
Wrapper *w = NewWrapper();
String *tm;
String *wrap_args = NewString("");
String *returntype = Getattr(n, "type");
String *value = Getattr(n, "value");
String *storage = Getattr(n, "storage");
bool pure_virtual = false;
int status = SWIG_OK;
int idx;
bool ignored_method = GetFlag(n, "feature:ignore") ? true : false;
if (Cmp(storage, "virtual") == 0) {
if (Cmp(value, "0") == 0) {
pure_virtual = true;
}
}
/* determine if the method returns a pointer */
is_pointer = SwigType_ispointer_return(decl);
is_void = (!Cmp(returntype, "void") && !is_pointer);
/* virtual method definition */
String *target;
String *pclassname = NewStringf("SwigDirector_%s", classname);
String *qualified_name = NewStringf("%s::%s", pclassname, name);
SwigType *rtype = Getattr(n, "conversion_operator") ? 0 : Getattr(n, "classDirectorMethods:type");
target = Swig_method_decl(rtype, decl, qualified_name, l, 0);
Printf(w->def, "%s", target);
Delete(qualified_name);
Delete(target);
/* header declaration */
target = Swig_method_decl(rtype, decl, name, l, 1);
Printf(declaration, " virtual %s", target);
Delete(target);
// Get any exception classes in the throws typemap
if (Getattr(n, "noexcept")) {
Append(w->def, " noexcept");
Append(declaration, " noexcept");
}
ParmList *throw_parm_list = 0;
if ((throw_parm_list = Getattr(n, "throws")) || Getattr(n, "throw")) {
Parm *p;
int gencomma = 0;
Append(w->def, " throw(");
Append(declaration, " throw(");
if (throw_parm_list)
Swig_typemap_attach_parms("throws", throw_parm_list, 0);
for (p = throw_parm_list; p; p = nextSibling(p)) {
if (Getattr(p, "tmap:throws")) {
if (gencomma++) {
Append(w->def, ", ");
Append(declaration, ", ");
}
String *str = SwigType_str(Getattr(p, "type"), 0);
Append(w->def, str);
Append(declaration, str);
Delete(str);
}
}
Append(w->def, ")");
Append(declaration, ")");
}
Append(w->def, " {");
Append(declaration, ";\n");
/* declare method return value
* if the return value is a reference or const reference, a specialized typemap must
* handle it, including declaration of c_result ($result).
*/
if (!is_void && (!ignored_method || pure_virtual)) {
if (!SwigType_isclass(returntype)) {
if (!(SwigType_ispointer(returntype) || SwigType_isreference(returntype))) {
String *construct_result = NewStringf("= SwigValueInit< %s >()", SwigType_lstr(returntype, 0));
Wrapper_add_localv(w, "c_result", SwigType_lstr(returntype, "c_result"), construct_result, NIL);
Delete(construct_result);
} else {
Wrapper_add_localv(w, "c_result", SwigType_lstr(returntype, "c_result"), "= 0", NIL);
}
} else {
String *cres = SwigType_lstr(returntype, "c_result");
Printf(w->code, "%s;\n", cres);
Delete(cres);
}
}
if (!is_void && !ignored_method) {
String *pres = NewStringf("SV *%s", Swig_cresult_name());
Wrapper_add_local(w, Swig_cresult_name(), pres);
Delete(pres);
}
if (ignored_method) {
if (!pure_virtual) {
if (!is_void)
Printf(w->code, "return ");
String *super_call = Swig_method_call(super, l);
Printf(w->code, "%s;\n", super_call);
Delete(super_call);
} else {
Printf(w->code, "Swig::DirectorPureVirtualException::raise(\"Attempted to invoke pure virtual method %s::%s\");\n", SwigType_namestr(c_classname),
SwigType_namestr(name));
}
} else {
/* attach typemaps to arguments (C/C++ -> Perl) */
String *parse_args = NewString("");
String *pstack = NewString("");
Swig_director_parms_fixup(l);
/* remove the wrapper 'w' since it was producing spurious temps */
Swig_typemap_attach_parms("in", l, 0);
Swig_typemap_attach_parms("directorin", l, w);
Swig_typemap_attach_parms("directorargout", l, w);
Wrapper_add_local(w, "SP", "dSP");
{
String *ptype = Copy(getClassType());
SwigType_add_pointer(ptype);
String *mangle = SwigType_manglestr(ptype);
Wrapper_add_local(w, "swigself", "SV *swigself");
Printf(w->code, "swigself = SWIG_NewPointerObj(SWIG_as_voidptr(this), SWIGTYPE%s, SWIG_SHADOW);\n", mangle);
Printf(w->code, "sv_bless(swigself, gv_stashpv(swig_get_class(), 0));\n");
Delete(mangle);
Delete(ptype);
Append(pstack, "XPUSHs(swigself);\n");
}
Parm *p;
char source[256];
int outputs = 0;
if (!is_void)
outputs++;
/* build argument list and type conversion string */
idx = 0;
p = l;
while (p) {
if (checkAttribute(p, "tmap:in:numinputs", "0")) {
p = Getattr(p, "tmap:in:next");
continue;
}
/* old style? caused segfaults without the p!=0 check
in the for() condition, and seems dangerous in the
while loop as well.
while (Getattr(p, "tmap:ignore")) {
p = Getattr(p, "tmap:ignore:next");
}
*/
if (Getattr(p, "tmap:directorargout") != 0)
outputs++;
String *pname = Getattr(p, "name");
String *ptype = Getattr(p, "type");
if ((tm = Getattr(p, "tmap:directorin")) != 0) {
sprintf(source, "obj%d", idx++);
String *input = NewString(source);
Setattr(p, "emit:directorinput", input);
Replaceall(tm, "$input", input);
Delete(input);
Replaceall(tm, "$owner", "0");
Replaceall(tm, "$shadow", "0");
/* Wrapper_add_localv(w, source, "SV *", source, "= 0", NIL); */
Printv(wrap_args, "SV *", source, ";\n", NIL);
Printv(wrap_args, tm, "\n", NIL);
Putc('O', parse_args);
Printv(pstack, "XPUSHs(", source, ");\n", NIL);
p = Getattr(p, "tmap:directorin:next");
continue;
} else if (Cmp(ptype, "void")) {
/* special handling for pointers to other C++ director classes.
* ideally this would be left to a typemap, but there is currently no
* way to selectively apply the dynamic_cast<> to classes that have
* directors. in other words, the type "SwigDirector_$1_lname" only exists
* for classes with directors. we avoid the problem here by checking
* module.wrap::directormap, but it's not clear how to get a typemap to
* do something similar. perhaps a new default typemap (in addition
* to SWIGTYPE) called DIRECTORTYPE?
*/
if (SwigType_ispointer(ptype) || SwigType_isreference(ptype)) {
Node *module = Getattr(parent, "module");
Node *target = Swig_directormap(module, ptype);
sprintf(source, "obj%d", idx++);
String *nonconst = 0;
/* strip pointer/reference --- should move to Swig/stype.c */
String *nptype = NewString(Char(ptype) + 2);
/* name as pointer */
String *ppname = Copy(pname);
if (SwigType_isreference(ptype)) {
Insert(ppname, 0, "&");
}
/* if necessary, cast away const since Perl doesn't support it! */
if (SwigType_isconst(nptype)) {
nonconst = NewStringf("nc_tmp_%s", pname);
String *nonconst_i = NewStringf("= const_cast< %s >(%s)", SwigType_lstr(ptype, 0), ppname);
Wrapper_add_localv(w, nonconst, SwigType_lstr(ptype, 0), nonconst, nonconst_i, NIL);
Delete(nonconst_i);
Swig_warning(WARN_LANG_DISCARD_CONST, input_file, line_number,
"Target language argument '%s' discards const in director method %s::%s.\n",
SwigType_str(ptype, pname), SwigType_namestr(c_classname), SwigType_namestr(name));
} else {
nonconst = Copy(ppname);
}
Delete(nptype);
Delete(ppname);
String *mangle = SwigType_manglestr(ptype);
if (target) {
String *director = NewStringf("director_%s", mangle);
Wrapper_add_localv(w, director, "Swig::Director *", director, "= 0", NIL);
Wrapper_add_localv(w, source, "SV *", source, "= 0", NIL);
Printf(wrap_args, "%s = SWIG_DIRECTOR_CAST(%s);\n", director, nonconst);
Printf(wrap_args, "if (!%s) {\n", director);
Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE%s, 0);\n", source, nonconst, mangle);
Append(wrap_args, "} else {\n");
Printf(wrap_args, "%s = %s->swig_get_self();\n", source, director);
Printf(wrap_args, "SvREFCNT_inc((SV *)%s);\n", source);
Append(wrap_args, "}\n");
Delete(director);
} else {
Wrapper_add_localv(w, source, "SV *", source, "= 0", NIL);
Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE%s, 0);\n", source, nonconst, mangle);
Printf(pstack, "XPUSHs(sv_2mortal(%s));\n", source);
}
Putc('O', parse_args);
Delete(mangle);
Delete(nonconst);
} else {
Swig_warning(WARN_TYPEMAP_DIRECTORIN_UNDEF, input_file, line_number,
"Unable to use type %s as a function argument in director method %s::%s (skipping method).\n", SwigType_str(ptype, 0),
SwigType_namestr(c_classname), SwigType_namestr(name));
status = SWIG_NOWRAP;
break;
}
}
p = nextSibling(p);
}
/* add the method name as a PyString */
String *pyname = Getattr(n, "sym:name");
/* wrap complex arguments to PyObjects */
Printv(w->code, wrap_args, NIL);
/* pass the method call on to the Python object */
if (dirprot_mode() && !is_public(n)) {
Printf(w->code, "swig_set_inner(\"%s\", true);\n", name);
}
Append(w->code, "ENTER;\n");
Append(w->code, "SAVETMPS;\n");
Append(w->code, "PUSHMARK(SP);\n");
Append(w->code, pstack);
Delete(pstack);
Append(w->code, "PUTBACK;\n");
Printf(w->code, "call_method(\"%s\", G_EVAL | G_SCALAR);\n", pyname);
if (dirprot_mode() && !is_public(n))
Printf(w->code, "swig_set_inner(\"%s\", false);\n", name);
/* exception handling */
tm = Swig_typemap_lookup("director:except", n, Swig_cresult_name(), 0);
if (!tm) {
tm = Getattr(n, "feature:director:except");
if (tm)
tm = Copy(tm);
}
Append(w->code, "if (SvTRUE(ERRSV)) {\n");
Append(w->code, " PUTBACK;\n FREETMPS;\n LEAVE;\n");
if ((tm) && Len(tm) && (Strcmp(tm, "1") != 0)) {
Replaceall(tm, "$error", "ERRSV");
Printv(w->code, Str(tm), "\n", NIL);
} else {
Printf(w->code, " Swig::DirectorMethodException::raise(ERRSV);\n");
}
Append(w->code, "}\n");
Delete(tm);
/*
* Python method may return a simple object, or a tuple.
* for in/out arguments, we have to extract the appropriate PyObjects from the tuple,
* then marshal everything back to C/C++ (return value and output arguments).
*
*/
/* marshal return value and other outputs (if any) from PyObject to C/C++ type */
String *cleanup = NewString("");
String *outarg = NewString("");
if (outputs > 1) {
Wrapper_add_local(w, "output", "SV *output");
Printf(w->code, "if (count != %d) {\n", outputs);
Printf(w->code, " Swig::DirectorTypeMismatchException::raise(\"Perl method %s.%sfailed to return a list.\");\n", classname, pyname);
Append(w->code, "}\n");
}
idx = 0;
/* marshal return value */
if (!is_void) {
Append(w->code, "SPAGAIN;\n");
Printf(w->code, "%s = POPs;\n", Swig_cresult_name());
tm = Swig_typemap_lookup("directorout", n, Swig_cresult_name(), w);
if (tm != 0) {
if (outputs > 1) {
Printf(w->code, "output = POPs;\n");
Replaceall(tm, "$input", "output");
} else {
Replaceall(tm, "$input", Swig_cresult_name());
}
char temp[24];
sprintf(temp, "%d", idx);
Replaceall(tm, "$argnum", temp);
/* 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);
Delete(tm);
} else {
Swig_warning(WARN_TYPEMAP_DIRECTOROUT_UNDEF, input_file, line_number,
"Unable to use return type %s in director method %s::%s (skipping method).\n", SwigType_str(returntype, 0),
SwigType_namestr(c_classname), SwigType_namestr(name));
status = SWIG_ERROR;
}
}
/* marshal outputs */
for (p = l; p;) {
if ((tm = Getattr(p, "tmap:directorargout")) != 0) {
if (outputs > 1) {
Printf(w->code, "output = POPs;\n");
Replaceall(tm, "$result", "output");
} else {
Replaceall(tm, "$result", Swig_cresult_name());
}
Replaceall(tm, "$input", Getattr(p, "emit:directorinput"));
Printv(w->code, tm, "\n", NIL);
p = Getattr(p, "tmap:directorargout:next");
} else {
p = nextSibling(p);
}
}
Delete(parse_args);
Delete(cleanup);
Delete(outarg);
}
if (!ignored_method) {
Append(w->code, "PUTBACK;\n");
Append(w->code, "FREETMPS;\n");
Append(w->code, "LEAVE;\n");
}
if (!is_void) {
if (!(ignored_method && !pure_virtual)) {
String *rettype = SwigType_str(returntype, 0);
if (!SwigType_isreference(returntype)) {
Printf(w->code, "return (%s) c_result;\n", rettype);
} else {
Printf(w->code, "return (%s) *c_result;\n", rettype);
}
Delete(rettype);
}
}
Append(w->code, "}\n");
// We expose protected methods via an extra public inline method which makes a straight call to the wrapped class' method
String *inline_extra_method = NewString("");
if (dirprot_mode() && !is_public(n) && !pure_virtual) {
Printv(inline_extra_method, declaration, NIL);
String *extra_method_name = NewStringf("%sSwigPublic", name);
Replaceall(inline_extra_method, name, extra_method_name);
Replaceall(inline_extra_method, ";\n", " {\n ");
if (!is_void)
Printf(inline_extra_method, "return ");
String *methodcall = Swig_method_call(super, l);
Printv(inline_extra_method, methodcall, ";\n }\n", NIL);
Delete(methodcall);
Delete(extra_method_name);
}
/* emit the director method */
if (status == SWIG_OK) {
if (!Getattr(n, "defaultargs")) {
Replaceall(w->code, "$symname", symname);
Wrapper_print(w, f_directors);
Printv(f_directors_h, declaration, NIL);
Printv(f_directors_h, inline_extra_method, NIL);
}
}
/* clean up */
Delete(wrap_args);
Delete(pclassname);
DelWrapper(w);
return status;
}
int classDirectorDisown(Node *n) {
int rv;
member_func = 1;
rv = Language::classDirectorDisown(n);
member_func = 0;
if (rv == SWIG_OK && Swig_directorclass(n)) {
String *symname = Getattr(n, "sym:name");
String *disown = Swig_name_disown(NSPACE_TODO, symname);
Setattr(n, "perl5:directordisown", NewStringf("%s::%s", cmodule, disown));
}
return rv;
}
int classDirectorDestructor(Node *n) {
/* TODO: it would be nice if this didn't have to copy the body of Language::classDirectorDestructor() */
String *DirectorClassName = directorClassName(getCurrentClass());
String *body = NewString("\n");
String *ptype = Copy(getClassType());
SwigType_add_pointer(ptype);
String *mangle = SwigType_manglestr(ptype);
Printv(body, tab4, "dSP;\n", tab4, "SV *self = SWIG_NewPointerObj(SWIG_as_voidptr(this), SWIGTYPE", mangle, ", SWIG_SHADOW);\n", tab4, "\n", tab4,
"sv_bless(self, gv_stashpv(swig_get_class(), 0));\n", tab4, "ENTER;\n", tab4, "SAVETMPS;\n", tab4, "PUSHMARK(SP);\n", tab4,
"XPUSHs(self);\n", tab4, "XPUSHs(&PL_sv_yes);\n", tab4, "PUTBACK;\n", tab4, "call_method(\"DESTROY\", G_EVAL | G_VOID);\n", tab4,
"FREETMPS;\n", tab4, "LEAVE;\n", NIL);
Delete(mangle);
Delete(ptype);
if (Getattr(n, "noexcept")) {
Printf(f_directors_h, " virtual ~%s() noexcept;\n", DirectorClassName);
Printf(f_directors, "%s::~%s() noexcept {%s}\n\n", DirectorClassName, DirectorClassName, body);
} else if (Getattr(n, "throw")) {
Printf(f_directors_h, " virtual ~%s() throw();\n", DirectorClassName);
Printf(f_directors, "%s::~%s() throw() {%s}\n\n", DirectorClassName, DirectorClassName, body);
} else {
Printf(f_directors_h, " virtual ~%s();\n", DirectorClassName);
Printf(f_directors, "%s::~%s() {%s}\n\n", DirectorClassName, DirectorClassName, body);
}
return SWIG_OK;
}
};
/* -----------------------------------------------------------------------------
* swig_perl5() - Instantiate module
* ----------------------------------------------------------------------------- */
static Language *new_swig_perl5() {
return new PERL5();
}
extern "C" Language *swig_perl5(void) {
return new_swig_perl5();
}
Reference in a new issue View git blame Copy permalink