1 /* ----------------------------------------------------------------------------
2 * This file is part of SWIG, which is licensed as a whole under version 3
3 * (or any later version) of the GNU General Public License. Some additional
4 * terms also apply to certain portions of SWIG. The full details of the SWIG
5 * license and copyrights can be found in the LICENSE and COPYRIGHT files
6 * included with the SWIG source code as distributed by the SWIG developers
7 * and at http://www.swig.org/legal.html.
8 *
9 * perl5.cxx
10 *
11 * Perl5 language module for SWIG.
12 * ------------------------------------------------------------------------- */
13
14 #include "swigmod.h"
15 #include "cparse.h"
16 #include <ctype.h>
17
18 static const char *usage = "\
19 Perl 5 Options (available with -perl5)\n\
20 -compat - Compatibility mode\n\
21 -const - Wrap constants as constants and not variables (implies -proxy)\n\
22 -nopm - Do not generate the .pm file\n\
23 -noproxy - Don't create proxy classes\n\
24 -proxy - Create proxy classes\n\
25 -static - Omit code related to dynamic loading\n\
26 \n";
27
28 static int compat = 0;
29
30 static int no_pmfile = 0;
31
32 static int export_all = 0;
33
34 /*
35 * pmfile
36 * set by the -pm flag, overrides the name of the .pm file
37 */
38 static String *pmfile = 0;
39
40 /*
41 * module
42 * set by the %module directive, e.g. "Xerces". It will determine
43 * the name of the .pm file, and the dynamic library, and the name
44 * used by any module wanting to %import the module.
45 */
46 static String *module = 0;
47
48 /*
49 * namespace_module
50 * the fully namespace qualified name of the module. It will be used
51 * to set the package namespace in the .pm file, as well as the name
52 * of the initialization methods in the glue library. This will be
53 * the same as module, above, unless the %module directive is given
54 * the 'package' option, e.g. %module(package="Foo::Bar") "baz"
55 */
56 static String *namespace_module = 0;
57
58 /*
59 * cmodule
60 * the namespace of the internal glue code, set to the value of
61 * module with a 'c' appended
62 */
63 static String *cmodule = 0;
64
65 /*
66 * dest_package
67 * an optional namespace to put all classes into. Specified by using
68 * the %module(package="Foo::Bar") "baz" syntax
69 */
70 static String *dest_package = 0;
71
72 static String *command_tab = 0;
73 static String *constant_tab = 0;
74 static String *variable_tab = 0;
75
76 static File *f_begin = 0;
77 static File *f_runtime = 0;
78 static File *f_runtime_h = 0;
79 static File *f_header = 0;
80 static File *f_wrappers = 0;
81 static File *f_directors = 0;
82 static File *f_directors_h = 0;
83 static File *f_init = 0;
84 static File *f_pm = 0;
85 static String *pm; /* Package initialization code */
86 static String *magic; /* Magic variable wrappers */
87
88 static int staticoption = 0;
89
90 // controlling verbose output
91 static int verbose = 0;
92
93 /* The following variables are used to manage Perl5 classes */
94
95 static int blessed = 1; /* Enable object oriented features */
96 static int do_constants = 0; /* Constant wrapping */
97 static List *classlist = 0; /* List of classes */
98 static int have_constructor = 0;
99 static int have_destructor = 0;
100 static int have_data_members = 0;
101 static String *class_name = 0; /* Name of the class (what Perl thinks it is) */
102 static String *real_classname = 0; /* Real name of C/C++ class */
103 static String *fullclassname = 0;
104
105 static String *pcode = 0; /* Perl code associated with each class */
106 /* static String *blessedmembers = 0; *//* Member data associated with each class */
107 static int member_func = 0; /* Set to 1 when wrapping a member function */
108 static String *func_stubs = 0; /* Function stubs */
109 static String *const_stubs = 0; /* Constant stubs */
110 static int num_consts = 0; /* Number of constants */
111 static String *var_stubs = 0; /* Variable stubs */
112 static String *exported = 0; /* Exported symbols */
113 static String *pragma_include = 0;
114 static String *additional_perl_code = 0; /* Additional Perl code from %perlcode %{ ... %} */
115 static Hash *operators = 0;
116 static int have_operators = 0;
117
118 class PERL5:public Language {
119 public:
120
PERL5()121 PERL5():Language () {
122 Clear(argc_template_string);
123 Printv(argc_template_string, "items", NIL);
124 Clear(argv_template_string);
125 Printv(argv_template_string, "ST(%d)", NIL);
126 director_language = 1;
127 }
128
129 /* Test to see if a type corresponds to something wrapped with a shadow class */
is_shadow(SwigType * t)130 Node *is_shadow(SwigType *t) {
131 Node *n;
132 n = classLookup(t);
133 /* Printf(stdout,"'%s' --> '%p'\n", t, n); */
134 if (n) {
135 if (!Getattr(n, "perl5:proxy")) {
136 setclassname(n);
137 }
138 return Getattr(n, "perl5:proxy");
139 }
140 return 0;
141 }
142
143 /* ------------------------------------------------------------
144 * main()
145 * ------------------------------------------------------------ */
146
main(int argc,char * argv[])147 virtual void main(int argc, char *argv[]) {
148 int i = 1;
149
150 SWIG_library_directory("perl5");
151
152 for (i = 1; i < argc; i++) {
153 if (argv[i]) {
154 if (strcmp(argv[i], "-package") == 0) {
155 Printv(stderr,
156 "*** -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);
157 SWIG_exit(EXIT_FAILURE);
158 } else if (strcmp(argv[i], "-interface") == 0) {
159 Printv(stderr,
160 "*** -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);
161 SWIG_exit(EXIT_FAILURE);
162 } else if (strcmp(argv[i], "-exportall") == 0) {
163 export_all = 1;
164 Swig_mark_arg(i);
165 } else if (strcmp(argv[i], "-static") == 0) {
166 staticoption = 1;
167 Swig_mark_arg(i);
168 } else if ((strcmp(argv[i], "-shadow") == 0) || ((strcmp(argv[i], "-proxy") == 0))) {
169 blessed = 1;
170 Swig_mark_arg(i);
171 } else if ((strcmp(argv[i], "-noproxy") == 0)) {
172 blessed = 0;
173 Swig_mark_arg(i);
174 } else if (strcmp(argv[i], "-const") == 0) {
175 do_constants = 1;
176 blessed = 1;
177 Swig_mark_arg(i);
178 } else if (strcmp(argv[i], "-nopm") == 0) {
179 no_pmfile = 1;
180 Swig_mark_arg(i);
181 } else if (strcmp(argv[i], "-pm") == 0) {
182 Swig_mark_arg(i);
183 i++;
184 pmfile = NewString(argv[i]);
185 Swig_mark_arg(i);
186 } else if (strcmp(argv[i],"-v") == 0) {
187 Swig_mark_arg(i);
188 verbose++;
189 } else if (strcmp(argv[i], "-compat") == 0) {
190 compat = 1;
191 Swig_mark_arg(i);
192 } else if (strcmp(argv[i], "-help") == 0) {
193 fputs(usage, stdout);
194 } else if (strcmp(argv[i], "-cppcast") == 0) {
195 Printf(stderr, "Deprecated command line option: %s. This option is now always on.\n", argv[i]);
196 Swig_mark_arg(i);
197 } else if (strcmp(argv[i], "-nocppcast") == 0) {
198 Printf(stderr, "Deprecated command line option: %s. This option is no longer supported.\n", argv[i]);
199 Swig_mark_arg(i);
200 SWIG_exit(EXIT_FAILURE);
201 }
202 }
203 }
204
205 Preprocessor_define("SWIGPERL 1", 0);
206 // SWIGPERL5 is deprecated, and no longer documented.
207 Preprocessor_define("SWIGPERL5 1", 0);
208 SWIG_typemap_lang("perl5");
209 SWIG_config_file("perl5.swg");
210 allow_overloading();
211 }
212
213 /* ------------------------------------------------------------
214 * top()
215 * ------------------------------------------------------------ */
216
top(Node * n)217 virtual int top(Node *n) {
218 /* check if directors are enabled for this module. note: this
219 * is a "master" switch, without which no director code will be
220 * emitted. %feature("director") statements are also required
221 * to enable directors for individual classes or methods.
222 *
223 * use %module(directors="1") modulename at the start of the
224 * interface file to enable director generation.
225 *
226 * TODO: directors are disallowed in conjunction with many command
227 * line options. Some of them are probably safe, but it will take
228 * some effort to validate each one.
229 */
230 {
231 Node *mod = Getattr(n, "module");
232 if (mod) {
233 Node *options = Getattr(mod, "options");
234 if (options) {
235 int dirprot = 0;
236 if (Getattr(options, "dirprot"))
237 dirprot = 1;
238 if (Getattr(options, "nodirprot"))
239 dirprot = 0;
240 if (Getattr(options, "directors")) {
241 int allow = 1;
242 if (export_all) {
243 Printv(stderr, "*** directors are not supported with -exportall\n", NIL);
244 allow = 0;
245 }
246 if (staticoption) {
247 Printv(stderr, "*** directors are not supported with -static\n", NIL);
248 allow = 0;
249 }
250 if (!blessed) {
251 Printv(stderr, "*** directors are not supported with -noproxy\n", NIL);
252 allow = 0;
253 }
254 if (no_pmfile) {
255 Printv(stderr, "*** directors are not supported with -nopm\n", NIL);
256 allow = 0;
257 }
258 if (compat) {
259 Printv(stderr, "*** directors are not supported with -compat\n", NIL);
260 allow = 0;
261 }
262 if (allow) {
263 allow_directors();
264 if (dirprot)
265 allow_dirprot();
266 }
267 }
268 }
269 }
270 }
271
272 /* Initialize all of the output files */
273 String *outfile = Getattr(n, "outfile");
274 String *outfile_h = Getattr(n, "outfile_h");
275
276 f_begin = NewFile(outfile, "w", SWIG_output_files());
277 if (!f_begin) {
278 FileErrorDisplay(outfile);
279 SWIG_exit(EXIT_FAILURE);
280 }
281 f_runtime = NewString("");
282 f_init = NewString("");
283 f_header = NewString("");
284 f_wrappers = NewString("");
285 f_directors_h = NewString("");
286 f_directors = NewString("");
287
288 if (directorsEnabled()) {
289 f_runtime_h = NewFile(outfile_h, "w", SWIG_output_files());
290 if (!f_runtime_h) {
291 FileErrorDisplay(outfile_h);
292 SWIG_exit(EXIT_FAILURE);
293 }
294 }
295
296 /* Register file targets with the SWIG file handler */
297 Swig_register_filebyname("header", f_header);
298 Swig_register_filebyname("wrapper", f_wrappers);
299 Swig_register_filebyname("begin", f_begin);
300 Swig_register_filebyname("runtime", f_runtime);
301 Swig_register_filebyname("init", f_init);
302 Swig_register_filebyname("director", f_directors);
303 Swig_register_filebyname("director_h", f_directors_h);
304
305 classlist = NewList();
306
307 pm = NewString("");
308 func_stubs = NewString("");
309 var_stubs = NewString("");
310 const_stubs = NewString("");
311 exported = NewString("");
312 magic = NewString("");
313 pragma_include = NewString("");
314 additional_perl_code = NewString("");
315
316 command_tab = NewString("static swig_command_info swig_commands[] = {\n");
317 constant_tab = NewString("static swig_constant_info swig_constants[] = {\n");
318 variable_tab = NewString("static swig_variable_info swig_variables[] = {\n");
319
320 Swig_banner(f_begin);
321
322 Printf(f_runtime, "\n\n#ifndef SWIGPERL\n#define SWIGPERL\n#endif\n\n");
323
324 if (directorsEnabled()) {
325 Printf(f_runtime, "#define SWIG_DIRECTORS\n");
326 }
327 Printf(f_runtime, "#define SWIG_CASTRANK_MODE\n");
328 Printf(f_runtime, "\n");
329
330 // Is the imported module in another package? (IOW, does it use the
331 // %module(package="name") option and it's different than the package
332 // of this module.)
333 Node *mod = Getattr(n, "module");
334 Node *options = Getattr(mod, "options");
335 module = Copy(Getattr(n,"name"));
336
337 String *underscore_module = Copy(module);
338 Replaceall(underscore_module,":","_");
339
340 if (verbose > 0) {
341 fprintf(stdout, "top: using namespace_module: %s\n", Char(namespace_module));
342 }
343
344 if (directorsEnabled()) {
345 Swig_banner(f_directors_h);
346 Printf(f_directors_h, "\n");
347 Printf(f_directors_h, "#ifndef SWIG_%s_WRAP_H_\n", underscore_module);
348 Printf(f_directors_h, "#define SWIG_%s_WRAP_H_\n\n", underscore_module);
349 if (dirprot_mode()) {
350 Printf(f_directors_h, "#include <map>\n");
351 Printf(f_directors_h, "#include <string>\n\n");
352 }
353
354 Printf(f_directors, "\n\n");
355 Printf(f_directors, "/* ---------------------------------------------------\n");
356 Printf(f_directors, " * C++ director class methods\n");
357 Printf(f_directors, " * --------------------------------------------------- */\n\n");
358 if (outfile_h) {
359 String *filename = Swig_file_filename(outfile_h);
360 Printf(magic, "#include \"%s\"\n\n", filename);
361 Delete(filename);
362 }
363 }
364
365 if (verbose > 0) {
366 fprintf(stdout, "top: using module: %s\n", Char(module));
367 }
368
369 dest_package = options ? Getattr(options, "package") : 0;
370 if (dest_package) {
371 namespace_module = Copy(dest_package);
372 if (verbose > 0) {
373 fprintf(stdout, "top: Found package: %s\n",Char(dest_package));
374 }
375 } else {
376 namespace_module = Copy(module);
377 if (verbose > 0) {
378 fprintf(stdout, "top: No package found\n");
379 }
380 }
381 /* If we're in blessed mode, change the package name to "packagec" */
382
383 if (blessed) {
384 cmodule = NewStringf("%sc",namespace_module);
385 } else {
386 cmodule = NewString(namespace_module);
387 }
388
389 /* Create a .pm file
390 * Need to strip off any prefixes that might be found in
391 * the module name */
392
393 if (no_pmfile) {
394 f_pm = NewString(0);
395 } else {
396 if (!pmfile) {
397 char *m = Char(module) + Len(module);
398 while (m != Char(module)) {
399 if (*m == ':') {
400 m++;
401 break;
402 }
403 m--;
404 }
405 pmfile = NewStringf("%s.pm", m);
406 }
407 String *filen = NewStringf("%s%s", SWIG_output_directory(), pmfile);
408 if ((f_pm = NewFile(filen, "w", SWIG_output_files())) == 0) {
409 FileErrorDisplay(filen);
410 SWIG_exit(EXIT_FAILURE);
411 }
412 Delete(filen);
413 filen = NULL;
414 Swig_register_filebyname("pm", f_pm);
415 Swig_register_filebyname("perl", f_pm);
416 }
417 {
418 String *boot_name = NewStringf("boot_%s", underscore_module);
419 Printf(f_header,"#define SWIG_init %s\n\n", boot_name);
420 Printf(f_header,"#define SWIG_name \"%s::%s\"\n", cmodule, boot_name);
421 Printf(f_header,"#define SWIG_prefix \"%s::\"\n", cmodule);
422 Delete(boot_name);
423 }
424
425 Swig_banner_target_lang(f_pm, "#");
426 Printf(f_pm, "\n");
427
428 Printf(f_pm, "package %s;\n", module);
429
430 /*
431 * If the package option has been given we are placing our
432 * symbols into some other packages namespace, so we do not
433 * mess with @ISA or require for that package
434 */
435 if (dest_package) {
436 Printf(f_pm,"use base qw(DynaLoader);\n");
437 } else {
438 Printf(f_pm,"use base qw(Exporter);\n");
439 if (!staticoption) {
440 Printf(f_pm,"use base qw(DynaLoader);\n");
441 }
442 }
443
444 /* Start creating magic code */
445
446 Printv(magic,
447 "#ifdef __cplusplus\nextern \"C\" {\n#endif\n\n",
448 "#ifdef PERL_OBJECT\n",
449 "#define MAGIC_CLASS _wrap_", underscore_module, "_var::\n",
450 "class _wrap_", underscore_module, "_var : public CPerlObj {\n",
451 "public:\n",
452 "#else\n",
453 "#define MAGIC_CLASS\n",
454 "#endif\n",
455 "SWIGCLASS_STATIC int swig_magic_readonly(pTHX_ SV *SWIGUNUSEDPARM(sv), MAGIC *SWIGUNUSEDPARM(mg)) {\n",
456 tab4, "MAGIC_PPERL\n", tab4, "croak(\"Value is read-only.\");\n", tab4, "return 0;\n", "}\n", NIL);
457
458 Printf(f_wrappers, "#ifdef __cplusplus\nextern \"C\" {\n#endif\n");
459
460 /* emit wrappers */
461 Language::top(n);
462
463 if (directorsEnabled()) {
464 // Insert director runtime into the f_runtime file (make it occur before %header section)
465 Swig_insert_file("director_common.swg", f_runtime);
466 Swig_insert_file("director.swg", f_runtime);
467 }
468
469 String *base = NewString("");
470
471 /* Dump out variable wrappers */
472
473 Printv(magic, "\n\n#ifdef PERL_OBJECT\n", "};\n", "#endif\n", NIL);
474 Printv(magic, "\n#ifdef __cplusplus\n}\n#endif\n", NIL);
475
476 Printf(f_header, "%s\n", magic);
477
478 String *type_table = NewString("");
479
480 /* Patch the type table to reflect the names used by shadow classes */
481 if (blessed) {
482 Iterator cls;
483 for (cls = First(classlist); cls.item; cls = Next(cls)) {
484 String *pname = Getattr(cls.item, "perl5:proxy");
485 if (pname) {
486 SwigType *type = Getattr(cls.item, "classtypeobj");
487 if (!type)
488 continue; /* If unnamed class, no type will be found */
489 type = Copy(type);
490
491 SwigType_add_pointer(type);
492 String *mangled = SwigType_manglestr(type);
493 SwigType_remember_mangleddata(mangled, NewStringf("\"%s\"", pname));
494 Delete(type);
495 Delete(mangled);
496 }
497 }
498 }
499 SwigType_emit_type_table(f_runtime, type_table);
500
501 Printf(f_wrappers, "%s", type_table);
502 Delete(type_table);
503
504 Printf(constant_tab, "{0,0,0,0,0,0}\n};\n");
505 Printv(f_wrappers, constant_tab, NIL);
506
507 Printf(f_wrappers, "#ifdef __cplusplus\n}\n#endif\n");
508
509 Printf(f_init, "\t ST(0) = &PL_sv_yes;\n");
510 Printf(f_init, "\t XSRETURN(1);\n");
511 Printf(f_init, "}\n");
512
513 /* Finish off tables */
514 Printf(variable_tab, "{0,0,0,0}\n};\n");
515 Printv(f_wrappers, variable_tab, NIL);
516
517 Printf(command_tab, "{0,0}\n};\n");
518 Printv(f_wrappers, command_tab, NIL);
519
520
521 Printf(f_pm, "package %s;\n", cmodule);
522
523 if (!staticoption) {
524 Printf(f_pm,"bootstrap %s;\n", module);
525 } else {
526 Printf(f_pm,"package %s;\n", cmodule);
527 Printf(f_pm,"boot_%s();\n", underscore_module);
528 }
529
530 Printf(f_pm, "package %s;\n", module);
531 /*
532 * If the package option has been given we are placing our
533 * symbols into some other packages namespace, so we do not
534 * mess with @EXPORT
535 */
536 if (!dest_package) {
537 Printf(f_pm,"@EXPORT = qw(%s);\n", exported);
538 }
539
540 Printf(f_pm, "%s", pragma_include);
541
542 if (blessed) {
543
544 /*
545 * These methods will be duplicated if package
546 * has been specified, so we do not output them
547 */
548 if (!dest_package) {
549 Printv(base, "\n# ---------- BASE METHODS -------------\n\n", "package ", namespace_module, ";\n\n", NIL);
550
551 /* Write out the TIE method */
552
553 Printv(base, "sub TIEHASH {\n", tab4, "my ($classname,$obj) = @_;\n", tab4, "return bless $obj, $classname;\n", "}\n\n", NIL);
554
555 /* Output a CLEAR method. This is just a place-holder, but by providing it we
556 * can make declarations such as
557 * %$u = ( x => 2, y=>3, z =>4 );
558 *
559 * Where x,y,z are the members of some C/C++ object. */
560
561 Printf(base, "sub CLEAR { }\n\n");
562
563 /* Output default firstkey/nextkey methods */
564
565 Printf(base, "sub FIRSTKEY { }\n\n");
566 Printf(base, "sub NEXTKEY { }\n\n");
567
568 /* Output a FETCH method. This is actually common to all classes */
569 Printv(base,
570 "sub FETCH {\n",
571 tab4, "my ($self,$field) = @_;\n", tab4, "my $member_func = \"swig_${field}_get\";\n", tab4, "$self->$member_func();\n", "}\n\n", NIL);
572
573 /* Output a STORE method. This is also common to all classes (might move to base class) */
574
575 Printv(base,
576 "sub STORE {\n",
577 tab4, "my ($self,$field,$newval) = @_;\n",
578 tab4, "my $member_func = \"swig_${field}_set\";\n", tab4, "$self->$member_func($newval);\n", "}\n\n", NIL);
579
580 /* Output a 'this' method */
581
582 Printv(base, "sub this {\n", tab4, "my $ptr = shift;\n", tab4, "return tied(%$ptr);\n", "}\n\n", NIL);
583
584 Printf(f_pm, "%s", base);
585 }
586
587 /* Emit function stubs for stand-alone functions */
588 Printf(f_pm, "\n# ------- FUNCTION WRAPPERS --------\n\n");
589 Printf(f_pm, "package %s;\n\n", namespace_module);
590 Printf(f_pm, "%s", func_stubs);
591
592 /* Emit package code for different classes */
593 Printf(f_pm, "%s", pm);
594
595 if (num_consts > 0) {
596 /* Emit constant stubs */
597 Printf(f_pm, "\n# ------- CONSTANT STUBS -------\n\n");
598 Printf(f_pm, "package %s;\n\n", namespace_module);
599 Printf(f_pm, "%s", const_stubs);
600 }
601
602 /* Emit variable stubs */
603
604 Printf(f_pm, "\n# ------- VARIABLE STUBS --------\n\n");
605 Printf(f_pm, "package %s;\n\n", namespace_module);
606 Printf(f_pm, "%s", var_stubs);
607 }
608
609 /* Add additional Perl code at the end */
610 Printf(f_pm, "%s", additional_perl_code);
611
612 Printf(f_pm, "1;\n");
613 Delete(f_pm);
614 Delete(base);
615 Delete(dest_package);
616 Delete(underscore_module);
617
618 /* Close all of the files */
619 Dump(f_runtime, f_begin);
620 Dump(f_header, f_begin);
621
622 if (directorsEnabled()) {
623 Dump(f_directors_h, f_runtime_h);
624 Printf(f_runtime_h, "\n");
625 Printf(f_runtime_h, "#endif\n");
626 Dump(f_directors, f_begin);
627 }
628
629 Dump(f_wrappers, f_begin);
630 Wrapper_pretty_print(f_init, f_begin);
631 Delete(f_header);
632 Delete(f_wrappers);
633 Delete(f_init);
634 Delete(f_directors);
635 Delete(f_directors_h);
636 Delete(f_runtime);
637 Delete(f_begin);
638 return SWIG_OK;
639 }
640
641 /* ------------------------------------------------------------
642 * importDirective(Node *n)
643 * ------------------------------------------------------------ */
644
importDirective(Node * n)645 virtual int importDirective(Node *n) {
646 if (blessed) {
647 String *modname = Getattr(n, "module");
648 if (modname) {
649 Printf(f_pm, "require %s;\n", modname);
650 }
651 }
652 return Language::importDirective(n);
653 }
654
655 /* ------------------------------------------------------------
656 * functionWrapper()
657 * ------------------------------------------------------------ */
658
functionWrapper(Node * n)659 virtual int functionWrapper(Node *n) {
660 String *name = Getattr(n, "name");
661 String *iname = Getattr(n, "sym:name");
662 SwigType *d = Getattr(n, "type");
663 ParmList *l = Getattr(n, "parms");
664 String *overname = 0;
665 int director_method = 0;
666
667 Parm *p;
668 int i;
669 Wrapper *f;
670 char source[256], temp[256];
671 String *tm;
672 String *cleanup, *outarg;
673 int num_saved = 0;
674 int num_arguments, num_required;
675 int varargs = 0;
676
677 if (Getattr(n, "sym:overloaded")) {
678 overname = Getattr(n, "sym:overname");
679 } else {
680 if (!addSymbol(iname, n))
681 return SWIG_ERROR;
682 }
683
684 f = NewWrapper();
685 cleanup = NewString("");
686 outarg = NewString("");
687
688 String *wname = Swig_name_wrapper(iname);
689 if (overname) {
690 Append(wname, overname);
691 }
692 Setattr(n, "wrap:name", wname);
693 Printv(f->def, "XS(", wname, ") {\n", "{\n", /* scope to destroy C++ objects before croaking */
694 NIL);
695
696 emit_parameter_variables(l, f);
697 emit_attach_parmmaps(l, f);
698 Setattr(n, "wrap:parms", l);
699
700 num_arguments = emit_num_arguments(l);
701 num_required = emit_num_required(l);
702 varargs = emit_isvarargs(l);
703
704 Wrapper_add_local(f, "argvi", "int argvi = 0");
705
706 /* Check the number of arguments */
707 if (!varargs) {
708 Printf(f->code, " if ((items < %d) || (items > %d)) {\n", num_required, num_arguments);
709 } else {
710 Printf(f->code, " if (items < %d) {\n", num_required);
711 }
712 Printf(f->code, " SWIG_croak(\"Usage: %s\");\n", usage_func(Char(iname), d, l));
713 Printf(f->code, "}\n");
714
715 /* Write code to extract parameters. */
716 for (i = 0, p = l; i < num_arguments; i++) {
717
718 /* Skip ignored arguments */
719
720 while (checkAttribute(p, "tmap:in:numinputs", "0")) {
721 p = Getattr(p, "tmap:in:next");
722 }
723
724 SwigType *pt = Getattr(p, "type");
725
726 /* Produce string representation of source and target arguments */
727 sprintf(source, "ST(%d)", i);
728 String *target = Getattr(p, "lname");
729
730 if (i >= num_required) {
731 Printf(f->code, " if (items > %d) {\n", i);
732 }
733 if ((tm = Getattr(p, "tmap:in"))) {
734 Replaceall(tm, "$target", target);
735 Replaceall(tm, "$source", source);
736 Replaceall(tm, "$input", source);
737 Setattr(p, "emit:input", source); /* Save input location */
738
739 if (Getattr(p, "wrap:disown") || (Getattr(p, "tmap:in:disown"))) {
740 Replaceall(tm, "$disown", "SWIG_POINTER_DISOWN");
741 } else {
742 Replaceall(tm, "$disown", "0");
743 }
744
745 Printf(f->code, "%s\n", tm);
746 p = Getattr(p, "tmap:in:next");
747 } else {
748 Swig_warning(WARN_TYPEMAP_IN_UNDEF, input_file, line_number, "Unable to use type %s as a function argument.\n", SwigType_str(pt, 0));
749 p = nextSibling(p);
750 }
751 if (i >= num_required) {
752 Printf(f->code, " }\n");
753 }
754 }
755
756 if (varargs) {
757 if (p && (tm = Getattr(p, "tmap:in"))) {
758 sprintf(source, "ST(%d)", i);
759 Replaceall(tm, "$input", source);
760 Setattr(p, "emit:input", source);
761 Printf(f->code, "if (items >= %d) {\n", i);
762 Printv(f->code, tm, "\n", NIL);
763 Printf(f->code, "}\n");
764 }
765 }
766
767 /* Insert constraint checking code */
768 for (p = l; p;) {
769 if ((tm = Getattr(p, "tmap:check"))) {
770 Replaceall(tm, "$target", Getattr(p, "lname"));
771 Printv(f->code, tm, "\n", NIL);
772 p = Getattr(p, "tmap:check:next");
773 } else {
774 p = nextSibling(p);
775 }
776 }
777
778 /* Insert cleanup code */
779 for (i = 0, p = l; p; i++) {
780 if ((tm = Getattr(p, "tmap:freearg"))) {
781 Replaceall(tm, "$source", Getattr(p, "lname"));
782 Replaceall(tm, "$arg", Getattr(p, "emit:input"));
783 Replaceall(tm, "$input", Getattr(p, "emit:input"));
784 Printv(cleanup, tm, "\n", NIL);
785 p = Getattr(p, "tmap:freearg:next");
786 } else {
787 p = nextSibling(p);
788 }
789 }
790
791 /* Insert argument output code */
792 num_saved = 0;
793 for (i = 0, p = l; p; i++) {
794 if ((tm = Getattr(p, "tmap:argout"))) {
795 SwigType *t = Getattr(p, "type");
796 Replaceall(tm, "$source", Getattr(p, "lname"));
797 Replaceall(tm, "$target", "ST(argvi)");
798 Replaceall(tm, "$result", "ST(argvi)");
799 if (is_shadow(t)) {
800 Replaceall(tm, "$shadow", "SWIG_SHADOW");
801 } else {
802 Replaceall(tm, "$shadow", "0");
803 }
804
805 String *in = Getattr(p, "emit:input");
806 if (in) {
807 sprintf(temp, "_saved[%d]", num_saved);
808 Replaceall(tm, "$arg", temp);
809 Replaceall(tm, "$input", temp);
810 Printf(f->code, "_saved[%d] = %s;\n", num_saved, in);
811 num_saved++;
812 }
813 Printv(outarg, tm, "\n", NIL);
814 p = Getattr(p, "tmap:argout:next");
815 } else {
816 p = nextSibling(p);
817 }
818 }
819
820 /* If there were any saved arguments, emit a local variable for them */
821 if (num_saved) {
822 sprintf(temp, "_saved[%d]", num_saved);
823 Wrapper_add_localv(f, "_saved", "SV *", temp, NIL);
824 }
825
826 director_method = is_member_director(n) && !is_smart_pointer() && 0 != Cmp(nodeType(n), "destructor");
827 if (director_method) {
828 Wrapper_add_local(f, "director", "Swig::Director *director = 0");
829 Append(f->code, "director = SWIG_DIRECTOR_CAST(arg1);\n");
830 if (dirprot_mode() && !is_public(n)) {
831 Printf(f->code, "if (!director || !(director->swig_get_inner(\"%s\"))) {\n", name);
832 Printf(f->code, "SWIG_exception_fail(SWIG_RuntimeError, \"accessing protected member %s\");\n", name);
833 Append(f->code, "}\n");
834 }
835 Wrapper_add_local(f, "upcall", "bool upcall = false");
836 Printf(f->code, "upcall = director && SvSTASH(SvRV(ST(0))) == gv_stashpv(director->swig_get_class(), 0);\n");
837 }
838
839 /* Emit the function call */
840 if (director_method) {
841 Append(f->code, "try {\n");
842 }
843
844 /* Now write code to make the function call */
845
846 Swig_director_emit_dynamic_cast(n, f);
847 String *actioncode = emit_action(n);
848
849 if (director_method) {
850 Append(actioncode, "} catch (Swig::DirectorException& swig_err) {\n");
851 Append(actioncode, " sv_setsv(ERRSV, swig_err.getNative());\n");
852 Append(actioncode, " SWIG_fail;\n");
853 Append(actioncode, "}\n");
854 }
855
856 if ((tm = Swig_typemap_lookup_out("out", n, Swig_cresult_name(), f, actioncode))) {
857 SwigType *t = Getattr(n, "type");
858 Replaceall(tm, "$source", Swig_cresult_name());
859 Replaceall(tm, "$target", "ST(argvi)");
860 Replaceall(tm, "$result", "ST(argvi)");
861 if (is_shadow(t)) {
862 Replaceall(tm, "$shadow", "SWIG_SHADOW");
863 } else {
864 Replaceall(tm, "$shadow", "0");
865 }
866 if (GetFlag(n, "feature:new")) {
867 Replaceall(tm, "$owner", "SWIG_OWNER");
868 } else {
869 Replaceall(tm, "$owner", "0");
870 }
871 Printf(f->code, "%s\n", tm);
872 } else {
873 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);
874 }
875 emit_return_variable(n, d, f);
876
877 /* If there were any output args, take care of them. */
878
879 Printv(f->code, outarg, NIL);
880
881 /* If there was any cleanup, do that. */
882
883 Printv(f->code, cleanup, NIL);
884
885 if (GetFlag(n, "feature:new")) {
886 if ((tm = Swig_typemap_lookup("newfree", n, Swig_cresult_name(), 0))) {
887 Replaceall(tm, "$source", Swig_cresult_name());
888 Printf(f->code, "%s\n", tm);
889 }
890 }
891
892 if ((tm = Swig_typemap_lookup("ret", n, Swig_cresult_name(), 0))) {
893 Replaceall(tm, "$source", Swig_cresult_name());
894 Printf(f->code, "%s\n", tm);
895 }
896
897 if (director_method) {
898 if ((tm = Swig_typemap_lookup("directorfree", n, Swig_cresult_name(), 0))) {
899 Replaceall(tm, "$input", Swig_cresult_name());
900 Replaceall(tm, "$result", "ST(argvi)");
901 Printf(f->code, "%s\n", tm);
902 Delete(tm);
903 }
904 }
905
906 Printv(f->code, "XSRETURN(argvi);\n", "fail:\n", cleanup, "SWIG_croak_null();\n" "}\n" "}\n", NIL);
907
908 /* Add the dXSARGS last */
909
910 Wrapper_add_local(f, "dXSARGS", "dXSARGS");
911
912 /* Substitute the cleanup code */
913 Replaceall(f->code, "$cleanup", cleanup);
914 Replaceall(f->code, "$symname", iname);
915
916 /* Dump the wrapper function */
917
918 Wrapper_print(f, f_wrappers);
919
920 /* Now register the function */
921
922 if (!Getattr(n, "sym:overloaded")) {
923 Printf(command_tab, "{\"%s::%s\", %s},\n", cmodule, iname, wname);
924 } else if (!Getattr(n, "sym:nextSibling")) {
925 /* Generate overloaded dispatch function */
926 int maxargs;
927 String *dispatch = Swig_overload_dispatch_cast(n, "PUSHMARK(MARK); SWIG_CALLXS(%s); return;", &maxargs);
928
929 /* Generate a dispatch wrapper for all overloaded functions */
930
931 Wrapper *df = NewWrapper();
932 String *dname = Swig_name_wrapper(iname);
933
934 Printv(df->def, "XS(", dname, ") {\n", NIL);
935
936 Wrapper_add_local(df, "dXSARGS", "dXSARGS");
937 Printv(df->code, dispatch, "\n", NIL);
938 Printf(df->code, "croak(\"No matching function for overloaded '%s'\");\n", iname);
939 Printf(df->code, "XSRETURN(0);\n");
940 Printv(df->code, "}\n", NIL);
941 Wrapper_print(df, f_wrappers);
942 Printf(command_tab, "{\"%s::%s\", %s},\n", cmodule, iname, dname);
943 DelWrapper(df);
944 Delete(dispatch);
945 Delete(dname);
946 }
947 if (!Getattr(n, "sym:nextSibling")) {
948 if (export_all) {
949 Printf(exported, "%s ", iname);
950 }
951
952 /* --------------------------------------------------------------------
953 * Create a stub for this function, provided it's not a member function
954 * -------------------------------------------------------------------- */
955
956 if ((blessed) && (!member_func)) {
957 Printv(func_stubs, "*", iname, " = *", cmodule, "::", iname, ";\n", NIL);
958 }
959
960 }
961 Delete(cleanup);
962 Delete(outarg);
963 DelWrapper(f);
964 return SWIG_OK;
965 }
966
967 /* ------------------------------------------------------------
968 * variableWrapper()
969 * ------------------------------------------------------------ */
variableWrapper(Node * n)970 virtual int variableWrapper(Node *n) {
971 String *name = Getattr(n, "name");
972 String *iname = Getattr(n, "sym:name");
973 SwigType *t = Getattr(n, "type");
974 Wrapper *getf, *setf;
975 String *tm;
976 String *getname = Swig_name_get(NSPACE_TODO, iname);
977 String *setname = Swig_name_set(NSPACE_TODO, iname);
978
979 String *get_name = Swig_name_wrapper(getname);
980 String *set_name = Swig_name_wrapper(setname);
981
982 if (!addSymbol(iname, n))
983 return SWIG_ERROR;
984
985 getf = NewWrapper();
986 setf = NewWrapper();
987
988 /* Create a Perl function for setting the variable value */
989
990 if (!GetFlag(n, "feature:immutable")) {
991 Setattr(n, "wrap:name", set_name);
992 Printf(setf->def, "SWIGCLASS_STATIC int %s(pTHX_ SV* sv, MAGIC * SWIGUNUSEDPARM(mg)) {\n", set_name);
993 Printv(setf->code, tab4, "MAGIC_PPERL\n", NIL);
994
995 /* Check for a few typemaps */
996 tm = Swig_typemap_lookup("varin", n, name, 0);
997 if (tm) {
998 Replaceall(tm, "$source", "sv");
999 Replaceall(tm, "$target", name);
1000 Replaceall(tm, "$input", "sv");
1001 /* Printf(setf->code,"%s\n", tm); */
1002 emit_action_code(n, setf->code, tm);
1003 } else {
1004 Swig_warning(WARN_TYPEMAP_VARIN_UNDEF, input_file, line_number, "Unable to set variable of type %s.\n", SwigType_str(t, 0));
1005 DelWrapper(setf);
1006 DelWrapper(getf);
1007 return SWIG_NOWRAP;
1008 }
1009 Printf(setf->code, "fail:\n");
1010 Printf(setf->code, " return 1;\n}\n");
1011 Replaceall(setf->code, "$symname", iname);
1012 Wrapper_print(setf, magic);
1013 }
1014
1015 /* Now write a function to evaluate the variable */
1016 Setattr(n, "wrap:name", get_name);
1017 int addfail = 0;
1018 Printf(getf->def, "SWIGCLASS_STATIC int %s(pTHX_ SV *sv, MAGIC *SWIGUNUSEDPARM(mg)) {\n", get_name);
1019 Printv(getf->code, tab4, "MAGIC_PPERL\n", NIL);
1020
1021 if ((tm = Swig_typemap_lookup("varout", n, name, 0))) {
1022 Replaceall(tm, "$target", "sv");
1023 Replaceall(tm, "$result", "sv");
1024 Replaceall(tm, "$source", name);
1025 if (is_shadow(t)) {
1026 Replaceall(tm, "$shadow", "SWIG_SHADOW");
1027 } else {
1028 Replaceall(tm, "$shadow", "0");
1029 }
1030 /* Printf(getf->code,"%s\n", tm); */
1031 addfail = emit_action_code(n, getf->code, tm);
1032 } else {
1033 Swig_warning(WARN_TYPEMAP_VAROUT_UNDEF, input_file, line_number, "Unable to read variable of type %s\n", SwigType_str(t, 0));
1034 DelWrapper(setf);
1035 DelWrapper(getf);
1036 return SWIG_NOWRAP;
1037 }
1038 Printf(getf->code, " return 1;\n");
1039 if (addfail) {
1040 Append(getf->code, "fail:\n");
1041 Append(getf->code, " return 0;\n");
1042 }
1043 Append(getf->code, "}\n");
1044
1045
1046 Replaceall(getf->code, "$symname", iname);
1047 Wrapper_print(getf, magic);
1048
1049 String *tt = Getattr(n, "tmap:varout:type");
1050 if (tt) {
1051 tt = NewStringf("&%s", tt);
1052 } else {
1053 tt = NewString("0");
1054 }
1055 /* Now add symbol to the PERL interpreter */
1056 if (GetFlag(n, "feature:immutable")) {
1057 Printv(variable_tab, tab4, "{ \"", cmodule, "::", iname, "\", MAGIC_CLASS swig_magic_readonly, MAGIC_CLASS ", get_name, ",", tt, " },\n", NIL);
1058
1059 } else {
1060 Printv(variable_tab, tab4, "{ \"", cmodule, "::", iname, "\", MAGIC_CLASS ", set_name, ", MAGIC_CLASS ", get_name, ",", tt, " },\n", NIL);
1061 }
1062
1063 /* If we're blessed, try to figure out what to do with the variable
1064 1. If it's a Perl object of some sort, create a tied-hash
1065 around it.
1066 2. Otherwise, just hack Perl's symbol table */
1067
1068 if (blessed) {
1069 if (is_shadow(t)) {
1070 Printv(var_stubs,
1071 "\nmy %__", iname, "_hash;\n",
1072 "tie %__", iname, "_hash,\"", is_shadow(t), "\", $",
1073 cmodule, "::", iname, ";\n", "$", iname, "= \\%__", iname, "_hash;\n", "bless $", iname, ", ", is_shadow(t), ";\n", NIL);
1074 } else {
1075 Printv(var_stubs, "*", iname, " = *", cmodule, "::", iname, ";\n", NIL);
1076 }
1077 }
1078 if (export_all)
1079 Printf(exported, "$%s ", iname);
1080
1081 Delete(tt);
1082 DelWrapper(setf);
1083 DelWrapper(getf);
1084 Delete(getname);
1085 Delete(setname);
1086 Delete(set_name);
1087 Delete(get_name);
1088 return SWIG_OK;
1089 }
1090
1091 /* ------------------------------------------------------------
1092 * constantWrapper()
1093 * ------------------------------------------------------------ */
1094
constantWrapper(Node * n)1095 virtual int constantWrapper(Node *n) {
1096 String *name = Getattr(n, "name");
1097 String *iname = Getattr(n, "sym:name");
1098 SwigType *type = Getattr(n, "type");
1099 String *rawval = Getattr(n, "rawval");
1100 String *value = rawval ? rawval : Getattr(n, "value");
1101 String *tm;
1102
1103 if (!addSymbol(iname, n))
1104 return SWIG_ERROR;
1105
1106 /* Special hook for member pointer */
1107 if (SwigType_type(type) == T_MPOINTER) {
1108 String *wname = Swig_name_wrapper(iname);
1109 Printf(f_wrappers, "static %s = %s;\n", SwigType_str(type, wname), value);
1110 value = Char(wname);
1111 }
1112
1113 if ((tm = Swig_typemap_lookup("consttab", n, name, 0))) {
1114 Replaceall(tm, "$source", value);
1115 Replaceall(tm, "$target", name);
1116 Replaceall(tm, "$value", value);
1117 if (is_shadow(type)) {
1118 Replaceall(tm, "$shadow", "SWIG_SHADOW");
1119 } else {
1120 Replaceall(tm, "$shadow", "0");
1121 }
1122 Printf(constant_tab, "%s,\n", tm);
1123 } else if ((tm = Swig_typemap_lookup("constcode", n, name, 0))) {
1124 Replaceall(tm, "$source", value);
1125 Replaceall(tm, "$target", name);
1126 Replaceall(tm, "$value", value);
1127 if (is_shadow(type)) {
1128 Replaceall(tm, "$shadow", "SWIG_SHADOW");
1129 } else {
1130 Replaceall(tm, "$shadow", "0");
1131 }
1132 Printf(f_init, "%s\n", tm);
1133 } else {
1134 Swig_warning(WARN_TYPEMAP_CONST_UNDEF, input_file, line_number, "Unsupported constant value.\n");
1135 return SWIG_NOWRAP;
1136 }
1137
1138 if (blessed) {
1139 if (is_shadow(type)) {
1140 Printv(var_stubs,
1141 "\nmy %__", iname, "_hash;\n",
1142 "tie %__", iname, "_hash,\"", is_shadow(type), "\", $",
1143 cmodule, "::", iname, ";\n", "$", iname, "= \\%__", iname, "_hash;\n", "bless $", iname, ", ", is_shadow(type), ";\n", NIL);
1144 } else if (do_constants) {
1145 Printv(const_stubs, "sub ", name, " () { $", cmodule, "::", name, " }\n", NIL);
1146 num_consts++;
1147 } else {
1148 Printv(var_stubs, "*", iname, " = *", cmodule, "::", iname, ";\n", NIL);
1149 }
1150 }
1151 if (export_all) {
1152 if (do_constants && !is_shadow(type)) {
1153 Printf(exported, "%s ", name);
1154 } else {
1155 Printf(exported, "$%s ", iname);
1156 }
1157 }
1158 return SWIG_OK;
1159 }
1160
1161 /* ------------------------------------------------------------
1162 * usage_func()
1163 * ------------------------------------------------------------ */
usage_func(char * iname,SwigType *,ParmList * l)1164 char *usage_func(char *iname, SwigType *, ParmList *l) {
1165 static String *temp = 0;
1166 Parm *p;
1167 int i;
1168
1169 if (!temp)
1170 temp = NewString("");
1171 Clear(temp);
1172 Printf(temp, "%s(", iname);
1173
1174 /* Now go through and print parameters */
1175 p = l;
1176 i = 0;
1177 while (p != 0) {
1178 SwigType *pt = Getattr(p, "type");
1179 String *pn = Getattr(p, "name");
1180 if (!checkAttribute(p,"tmap:in:numinputs","0")) {
1181 /* If parameter has been named, use that. Otherwise, just print a type */
1182 if (SwigType_type(pt) != T_VOID) {
1183 if (Len(pn) > 0) {
1184 Printf(temp, "%s", pn);
1185 } else {
1186 Printf(temp, "%s", SwigType_str(pt, 0));
1187 }
1188 }
1189 i++;
1190 p = nextSibling(p);
1191 if (p)
1192 if (!checkAttribute(p,"tmap:in:numinputs","0"))
1193 Putc(',', temp);
1194 } else {
1195 p = nextSibling(p);
1196 if (p)
1197 if ((i > 0) && (!checkAttribute(p,"tmap:in:numinputs","0")))
1198 Putc(',', temp);
1199 }
1200 }
1201 Printf(temp, ");");
1202 return Char(temp);
1203 }
1204
1205 /* ------------------------------------------------------------
1206 * nativeWrapper()
1207 * ------------------------------------------------------------ */
1208
nativeWrapper(Node * n)1209 virtual int nativeWrapper(Node *n) {
1210 String *name = Getattr(n, "sym:name");
1211 String *funcname = Getattr(n, "wrap:name");
1212
1213 if (!addSymbol(funcname, n))
1214 return SWIG_ERROR;
1215
1216 Printf(command_tab, "{\"%s::%s\", %s},\n", cmodule, name, funcname);
1217 if (export_all)
1218 Printf(exported, "%s ", name);
1219 if (blessed) {
1220 Printv(func_stubs, "*", name, " = *", cmodule, "::", name, ";\n", NIL);
1221 }
1222 return SWIG_OK;
1223 }
1224
1225 /* ----------------------------------------------------------------------------
1226 * OBJECT-ORIENTED FEATURES
1227 *
1228 * These extensions provide a more object-oriented interface to C++
1229 * classes and structures. The code here is based on extensions
1230 * provided by David Fletcher and Gary Holt.
1231 *
1232 * I have generalized these extensions to make them more general purpose
1233 * and to resolve object-ownership problems.
1234 *
1235 * The approach here is very similar to the Python module :
1236 * 1. All of the original methods are placed into a single
1237 * package like before except that a 'c' is appended to the
1238 * package name.
1239 *
1240 * 2. All methods and function calls are wrapped with a new
1241 * perl function. While possibly inefficient this allows
1242 * us to catch complex function arguments (which are hard to
1243 * track otherwise).
1244 *
1245 * 3. Classes are represented as tied-hashes in a manner similar
1246 * to Gary Holt's extension. This allows us to access
1247 * member data.
1248 *
1249 * 4. Stand-alone (global) C functions are modified to take
1250 * tied hashes as arguments for complex datatypes (if
1251 * appropriate).
1252 *
1253 * 5. Global variables involving a class/struct is encapsulated
1254 * in a tied hash.
1255 *
1256 * ------------------------------------------------------------------------- */
1257
1258
setclassname(Node * n)1259 void setclassname(Node *n) {
1260 String *symname = Getattr(n, "sym:name");
1261 String *fullname;
1262 String *actualpackage;
1263 Node *clsmodule = Getattr(n, "module");
1264
1265 if (!clsmodule) {
1266 /* imported module does not define a module name. Oh well */
1267 return;
1268 }
1269
1270 /* Do some work on the class name */
1271 if (verbose > 0) {
1272 String *modulename = Getattr(clsmodule, "name");
1273 fprintf(stdout, "setclassname: Found sym:name: %s\n", Char(symname));
1274 fprintf(stdout, "setclassname: Found module: %s\n", Char(modulename));
1275 fprintf(stdout, "setclassname: No package found\n");
1276 }
1277
1278 if (dest_package) {
1279 fullname = NewStringf("%s::%s", namespace_module, symname);
1280 } else {
1281 actualpackage = Getattr(clsmodule,"name");
1282
1283 if (verbose > 0) {
1284 fprintf(stdout, "setclassname: Found actualpackage: %s\n", Char(actualpackage));
1285 }
1286 if ((!compat) && (!Strchr(symname,':'))) {
1287 fullname = NewStringf("%s::%s",actualpackage,symname);
1288 } else {
1289 fullname = NewString(symname);
1290 }
1291 }
1292 if (verbose > 0) {
1293 fprintf(stdout, "setclassname: setting proxy: %s\n", Char(fullname));
1294 }
1295 Setattr(n, "perl5:proxy", fullname);
1296 }
1297
1298 /* ------------------------------------------------------------
1299 * classDeclaration()
1300 * ------------------------------------------------------------ */
classDeclaration(Node * n)1301 virtual int classDeclaration(Node *n) {
1302 /* Do some work on the class name */
1303 if (!Getattr(n, "feature:onlychildren")) {
1304 if (blessed) {
1305 setclassname(n);
1306 Append(classlist, n);
1307 }
1308 }
1309
1310 return Language::classDeclaration(n);
1311 }
1312
1313 /* ------------------------------------------------------------
1314 * classHandler()
1315 * ------------------------------------------------------------ */
1316
classHandler(Node * n)1317 virtual int classHandler(Node *n) {
1318
1319 if (blessed) {
1320 have_constructor = 0;
1321 have_operators = 0;
1322 have_destructor = 0;
1323 have_data_members = 0;
1324 operators = NewHash();
1325
1326 class_name = Getattr(n, "sym:name");
1327
1328 if (!addSymbol(class_name, n))
1329 return SWIG_ERROR;
1330
1331 /* Use the fully qualified name of the Perl class */
1332 if (!compat) {
1333 fullclassname = NewStringf("%s::%s", namespace_module, class_name);
1334 } else {
1335 fullclassname = NewString(class_name);
1336 }
1337 real_classname = Getattr(n, "name");
1338 pcode = NewString("");
1339 // blessedmembers = NewString("");
1340 }
1341
1342 /* Emit all of the members */
1343 Language::classHandler(n);
1344
1345
1346 /* Finish the rest of the class */
1347 if (blessed) {
1348 /* Generate a client-data entry */
1349 SwigType *ct = NewStringf("p.%s", real_classname);
1350 Printv(f_init, "SWIG_TypeClientData(SWIGTYPE", SwigType_manglestr(ct), ", (void*) \"", fullclassname, "\");\n", NIL);
1351 SwigType_remember(ct);
1352 Delete(ct);
1353
1354 Printv(pm, "\n############# Class : ", fullclassname, " ##############\n", "\npackage ", fullclassname, ";\n", NIL);
1355
1356 if (have_operators) {
1357 Printf(pm, "use overload\n");
1358 Iterator ki;
1359 for (ki = First(operators); ki.key; ki = Next(ki)) {
1360 char *name = Char(ki.key);
1361 // fprintf(stderr,"found name: <%s>\n", name);
1362 if (strstr(name, "__eq__")) {
1363 Printv(pm, tab4, "\"==\" => sub { $_[0]->__eq__($_[1])},\n",NIL);
1364 } else if (strstr(name, "__ne__")) {
1365 Printv(pm, tab4, "\"!=\" => sub { $_[0]->__ne__($_[1])},\n",NIL);
1366 // there are no tests for this in operator_overload_runme.pl
1367 // it is likely to be broken
1368 // } else if (strstr(name, "__assign__")) {
1369 // Printv(pm, tab4, "\"=\" => sub { $_[0]->__assign__($_[1])},\n",NIL);
1370 } else if (strstr(name, "__str__")) {
1371 Printv(pm, tab4, "'\"\"' => sub { $_[0]->__str__()},\n",NIL);
1372 } else if (strstr(name, "__plusplus__")) {
1373 Printv(pm, tab4, "\"++\" => sub { $_[0]->__plusplus__()},\n",NIL);
1374 } else if (strstr(name, "__minmin__")) {
1375 Printv(pm, tab4, "\"--\" => sub { $_[0]->__minmin__()},\n",NIL);
1376 } else if (strstr(name, "__add__")) {
1377 Printv(pm, tab4, "\"+\" => sub { $_[0]->__add__($_[1])},\n",NIL);
1378 } else if (strstr(name, "__sub__")) {
1379 Printv(pm, tab4, "\"-\" => sub { if( not $_[2] ) { $_[0]->__sub__($_[1]) }\n",NIL);
1380 Printv(pm, tab8, "elsif( $_[0]->can('__rsub__') ) { $_[0]->__rsub__($_[1]) }\n",NIL);
1381 Printv(pm, tab8, "else { die(\"reverse subtraction not supported\") }\n",NIL);
1382 Printv(pm, tab8, "},\n",NIL);
1383 } else if (strstr(name, "__mul__")) {
1384 Printv(pm, tab4, "\"*\" => sub { $_[0]->__mul__($_[1])},\n",NIL);
1385 } else if (strstr(name, "__div__")) {
1386 Printv(pm, tab4, "\"/\" => sub { $_[0]->__div__($_[1])},\n",NIL);
1387 } else if (strstr(name, "__mod__")) {
1388 Printv(pm, tab4, "\"%\" => sub { $_[0]->__mod__($_[1])},\n",NIL);
1389 // there are no tests for this in operator_overload_runme.pl
1390 // it is likely to be broken
1391 // } else if (strstr(name, "__and__")) {
1392 // Printv(pm, tab4, "\"&\" => sub { $_[0]->__and__($_[1])},\n",NIL);
1393
1394 // there are no tests for this in operator_overload_runme.pl
1395 // it is likely to be broken
1396 // } else if (strstr(name, "__or__")) {
1397 // Printv(pm, tab4, "\"|\" => sub { $_[0]->__or__($_[1])},\n",NIL);
1398 } else if (strstr(name, "__gt__")) {
1399 Printv(pm, tab4, "\">\" => sub { $_[0]->__gt__($_[1])},\n",NIL);
1400 } else if (strstr(name, "__ge__")) {
1401 Printv(pm, tab4, "\">=\" => sub { $_[0]->__ge__($_[1])},\n",NIL);
1402 } else if (strstr(name, "__not__")) {
1403 Printv(pm, tab4, "\"!\" => sub { $_[0]->__not__()},\n",NIL);
1404 } else if (strstr(name, "__lt__")) {
1405 Printv(pm, tab4, "\"<\" => sub { $_[0]->__lt__($_[1])},\n",NIL);
1406 } else if (strstr(name, "__le__")) {
1407 Printv(pm, tab4, "\"<=\" => sub { $_[0]->__le__($_[1])},\n",NIL);
1408 } else if (strstr(name, "__pluseq__")) {
1409 Printv(pm, tab4, "\"+=\" => sub { $_[0]->__pluseq__($_[1])},\n",NIL);
1410 } else if (strstr(name, "__mineq__")) {
1411 Printv(pm, tab4, "\"-=\" => sub { $_[0]->__mineq__($_[1])},\n",NIL);
1412 } else if (strstr(name, "__neg__")) {
1413 Printv(pm, tab4, "\"neg\" => sub { $_[0]->__neg__()},\n",NIL);
1414 } else {
1415 fprintf(stderr,"Unknown operator: %s\n", name);
1416 }
1417 }
1418 Printv(pm, tab4,
1419 "\"=\" => sub { my $class = ref($_[0]); $class->new($_[0]) },\n", NIL);
1420 Printv(pm, tab4, "\"fallback\" => 1;\n", NIL);
1421 }
1422 // make use strict happy
1423 Printv(pm, "use vars qw(@ISA %OWNER %ITERATORS %BLESSEDMEMBERS);\n", NIL);
1424
1425 /* If we are inheriting from a base class, set that up */
1426
1427 Printv(pm, "@ISA = qw(", NIL);
1428
1429 /* Handle inheritance */
1430 List *baselist = Getattr(n, "bases");
1431 if (baselist && Len(baselist)) {
1432 Iterator b;
1433 b = First(baselist);
1434 while (b.item) {
1435 String *bname = Getattr(b.item, "perl5:proxy");
1436 if (!bname) {
1437 b = Next(b);
1438 continue;
1439 }
1440 Printv(pm, " ", bname, NIL);
1441 b = Next(b);
1442 }
1443 }
1444
1445 /* Module comes last */
1446 if (!compat || Cmp(namespace_module, fullclassname)) {
1447 Printv(pm, " ", namespace_module, NIL);
1448 }
1449
1450 Printf(pm, " );\n");
1451
1452 /* Dump out a hash table containing the pointers that we own */
1453 Printf(pm, "%%OWNER = ();\n");
1454 if (have_data_members || have_destructor)
1455 Printf(pm, "%%ITERATORS = ();\n");
1456
1457 /* Dump out the package methods */
1458
1459 Printv(pm, pcode, NIL);
1460 Delete(pcode);
1461
1462 /* Output methods for managing ownership */
1463
1464 String *director_disown;
1465 if (Getattr(n, "perl5:directordisown")) {
1466 director_disown = NewStringf("%s%s($self);\n", tab4, Getattr(n, "perl5:directordisown"));
1467 } else {
1468 director_disown = NewString("");
1469 }
1470 Printv(pm,
1471 "sub DISOWN {\n",
1472 tab4, "my $self = shift;\n",
1473 director_disown,
1474 tab4, "my $ptr = tied(%$self);\n",
1475 tab4, "delete $OWNER{$ptr};\n",
1476 "}\n\n", "sub ACQUIRE {\n", tab4, "my $self = shift;\n", tab4, "my $ptr = tied(%$self);\n", tab4, "$OWNER{$ptr} = 1;\n", "}\n\n", NIL);
1477 Delete(director_disown);
1478
1479 /* Only output the following methods if a class has member data */
1480
1481 Delete(operators);
1482 operators = 0;
1483 if (Swig_directorclass(n)) {
1484 /* director classes need a way to recover subclass instance attributes */
1485 Node *get_attr = NewHash();
1486 String *mrename;
1487 String *symname = Getattr(n, "sym:name");
1488 mrename = Swig_name_disown(NSPACE_TODO, symname);
1489 Replaceall(mrename, "disown", "swig_get_attr");
1490 String *type = NewString(getClassType());
1491 String *name = NewString("self");
1492 SwigType_add_pointer(type);
1493 Parm *p = NewParm(type, name, n);
1494 Delete(name);
1495 Delete(type);
1496 type = NewString("SV");
1497 SwigType_add_pointer(type);
1498 String *action = NewString("");
1499 Printv(action, "{\n", " Swig::Director *director = SWIG_DIRECTOR_CAST(arg1);\n",
1500 " result = sv_newmortal();\n" " if (director) sv_setsv(result, director->swig_get_self());\n", "}\n", NIL);
1501 Setfile(get_attr, Getfile(n));
1502 Setline(get_attr, Getline(n));
1503 Setattr(get_attr, "wrap:action", action);
1504 Setattr(get_attr, "name", mrename);
1505 Setattr(get_attr, "sym:name", mrename);
1506 Setattr(get_attr, "type", type);
1507 Setattr(get_attr, "parms", p);
1508 Delete(action);
1509 Delete(type);
1510 Delete(p);
1511
1512 member_func = 1;
1513 functionWrapper(get_attr);
1514 member_func = 0;
1515 Delete(get_attr);
1516
1517 Printv(pm, "sub FETCH {\n", tab4, "my ($self,$field) = @_;\n", tab4, "my $member_func = \"swig_${field}_get\";\n", tab4,
1518 "if (not $self->can($member_func)) {\n", tab8, "my $h = ", cmodule, "::", mrename, "($self);\n", tab8, "return $h->{$field} if $h;\n",
1519 tab4, "}\n", tab4, "return $self->$member_func;\n", "}\n", "\n", "sub STORE {\n", tab4, "my ($self,$field,$newval) = @_;\n", tab4,
1520 "my $member_func = \"swig_${field}_set\";\n", tab4, "if (not $self->can($member_func)) {\n", tab8, "my $h = ", cmodule, "::", mrename,
1521 "($self);\n", tab8, "return $h->{$field} = $newval if $h;\n", tab4, "}\n", tab4, "return $self->$member_func($newval);\n", "}\n", NIL);
1522
1523 Delete(mrename);
1524 }
1525 }
1526 return SWIG_OK;
1527 }
1528
1529 /* ------------------------------------------------------------
1530 * memberfunctionHandler()
1531 * ------------------------------------------------------------ */
1532
memberfunctionHandler(Node * n)1533 virtual int memberfunctionHandler(Node *n) {
1534 String *symname = Getattr(n, "sym:name");
1535
1536 member_func = 1;
1537 Language::memberfunctionHandler(n);
1538 member_func = 0;
1539
1540 if ((blessed) && (!Getattr(n, "sym:nextSibling"))) {
1541
1542 if (Strstr(symname, "__eq__")) {
1543 DohSetInt(operators, "__eq__", 1);
1544 have_operators = 1;
1545 } else if (Strstr(symname, "__ne__")) {
1546 DohSetInt(operators, "__ne__", 1);
1547 have_operators = 1;
1548 } else if (Strstr(symname, "__assign__")) {
1549 DohSetInt(operators, "__assign__", 1);
1550 have_operators = 1;
1551 } else if (Strstr(symname, "__str__")) {
1552 DohSetInt(operators, "__str__", 1);
1553 have_operators = 1;
1554 } else if (Strstr(symname, "__add__")) {
1555 DohSetInt(operators, "__add__", 1);
1556 have_operators = 1;
1557 } else if (Strstr(symname, "__sub__")) {
1558 DohSetInt(operators, "__sub__", 1);
1559 have_operators = 1;
1560 } else if (Strstr(symname, "__mul__")) {
1561 DohSetInt(operators, "__mul__", 1);
1562 have_operators = 1;
1563 } else if (Strstr(symname, "__div__")) {
1564 DohSetInt(operators, "__div__", 1);
1565 have_operators = 1;
1566 } else if (Strstr(symname, "__mod__")) {
1567 DohSetInt(operators, "__mod__", 1);
1568 have_operators = 1;
1569 } else if (Strstr(symname, "__and__")) {
1570 DohSetInt(operators, "__and__", 1);
1571 have_operators = 1;
1572 } else if (Strstr(symname, "__or__")) {
1573 DohSetInt(operators, "__or__", 1);
1574 have_operators = 1;
1575 } else if (Strstr(symname, "__not__")) {
1576 DohSetInt(operators, "__not__", 1);
1577 have_operators = 1;
1578 } else if (Strstr(symname, "__gt__")) {
1579 DohSetInt(operators, "__gt__", 1);
1580 have_operators = 1;
1581 } else if (Strstr(symname, "__ge__")) {
1582 DohSetInt(operators, "__ge__", 1);
1583 have_operators = 1;
1584 } else if (Strstr(symname, "__lt__")) {
1585 DohSetInt(operators, "__lt__", 1);
1586 have_operators = 1;
1587 } else if (Strstr(symname, "__le__")) {
1588 DohSetInt(operators, "__le__", 1);
1589 have_operators = 1;
1590 } else if (Strstr(symname, "__neg__")) {
1591 DohSetInt(operators, "__neg__", 1);
1592 have_operators = 1;
1593 } else if (Strstr(symname, "__plusplus__")) {
1594 DohSetInt(operators, "__plusplus__", 1);
1595 have_operators = 1;
1596 } else if (Strstr(symname, "__minmin__")) {
1597 DohSetInt(operators, "__minmin__", 1);
1598 have_operators = 1;
1599 } else if (Strstr(symname, "__mineq__")) {
1600 DohSetInt(operators, "__mineq__", 1);
1601 have_operators = 1;
1602 } else if (Strstr(symname, "__pluseq__")) {
1603 DohSetInt(operators, "__pluseq__", 1);
1604 have_operators = 1;
1605 }
1606
1607 if (Getattr(n, "feature:shadow")) {
1608 String *plcode = perlcode(Getattr(n, "feature:shadow"), 0);
1609 String *plaction = NewStringf("%s::%s", cmodule, Swig_name_member(NSPACE_TODO, class_name, symname));
1610 Replaceall(plcode, "$action", plaction);
1611 Delete(plaction);
1612 Printv(pcode, plcode, NIL);
1613 } else {
1614 Printv(pcode, "*", symname, " = *", cmodule, "::", Swig_name_member(NSPACE_TODO, class_name, symname), ";\n", NIL);
1615 }
1616 }
1617 return SWIG_OK;
1618 }
1619
1620 /* ------------------------------------------------------------
1621 * membervariableHandler()
1622 *
1623 * Adds an instance member.
1624 * ----------------------------------------------------------------------------- */
1625
membervariableHandler(Node * n)1626 virtual int membervariableHandler(Node *n) {
1627
1628 String *symname = Getattr(n, "sym:name");
1629 /* SwigType *t = Getattr(n,"type"); */
1630
1631 /* Emit a pair of get/set functions for the variable */
1632
1633 member_func = 1;
1634 Language::membervariableHandler(n);
1635 member_func = 0;
1636
1637 if (blessed) {
1638
1639 Printv(pcode, "*swig_", symname, "_get = *", cmodule, "::", Swig_name_get(NSPACE_TODO, Swig_name_member(NSPACE_TODO, class_name, symname)), ";\n", NIL);
1640 Printv(pcode, "*swig_", symname, "_set = *", cmodule, "::", Swig_name_set(NSPACE_TODO, Swig_name_member(NSPACE_TODO, class_name, symname)), ";\n", NIL);
1641
1642 /* Now we need to generate a little Perl code for this */
1643
1644 /* if (is_shadow(t)) {
1645
1646 *//* This is a Perl object that we have already seen. Add an
1647 entry to the members list *//*
1648 Printv(blessedmembers,
1649 tab4, symname, " => '", is_shadow(t), "',\n",
1650 NIL);
1651
1652 }
1653 */
1654 }
1655 have_data_members++;
1656 return SWIG_OK;
1657 }
1658
1659 /* ------------------------------------------------------------
1660 * constructorDeclaration()
1661 *
1662 * Emits a blessed constructor for our class. In addition to our construct
1663 * we manage a Perl hash table containing all of the pointers created by
1664 * the constructor. This prevents us from accidentally trying to free
1665 * something that wasn't necessarily allocated by malloc or new
1666 * ------------------------------------------------------------ */
1667
constructorHandler(Node * n)1668 virtual int constructorHandler(Node *n) {
1669
1670 String *symname = Getattr(n, "sym:name");
1671
1672 member_func = 1;
1673
1674 Swig_save("perl5:constructorHandler", n, "parms", NIL);
1675 if (Swig_directorclass(n)) {
1676 Parm *parms = Getattr(n, "parms");
1677 Parm *self;
1678 String *name = NewString("self");
1679 String *type = NewString("SV");
1680 SwigType_add_pointer(type);
1681 self = NewParm(type, name, n);
1682 Delete(type);
1683 Delete(name);
1684 Setattr(self, "lname", "O");
1685 if (parms)
1686 set_nextSibling(self, parms);
1687 Setattr(n, "parms", self);
1688 Setattr(n, "wrap:self", "1");
1689 Setattr(n, "hidden", "1");
1690 Delete(self);
1691 }
1692
1693 String *saved_nc = none_comparison;
1694 none_comparison = NewStringf("strcmp(SvPV_nolen(ST(0)), \"%s::%s\") != 0", module, class_name);
1695 String *saved_director_prot_ctor_code = director_prot_ctor_code;
1696 director_prot_ctor_code = NewStringf("if ($comparison) { /* subclassed */\n" " $director_new\n" "} else {\n"
1697 "SWIG_exception_fail(SWIG_RuntimeError, \"accessing abstract class or protected constructor\");\n" "}\n");
1698 Language::constructorHandler(n);
1699 Delete(none_comparison);
1700 none_comparison = saved_nc;
1701 Delete(director_prot_ctor_code);
1702 director_prot_ctor_code = saved_director_prot_ctor_code;
1703 Swig_restore(n);
1704
1705 if ((blessed) && (!Getattr(n, "sym:nextSibling"))) {
1706 if (Getattr(n, "feature:shadow")) {
1707 String *plcode = perlcode(Getattr(n, "feature:shadow"), 0);
1708 String *plaction = NewStringf("%s::%s", module, Swig_name_member(NSPACE_TODO, class_name, symname));
1709 Replaceall(plcode, "$action", plaction);
1710 Delete(plaction);
1711 Printv(pcode, plcode, NIL);
1712 } else {
1713 if ((Cmp(symname, class_name) == 0)) {
1714 /* Emit a blessed constructor */
1715 Printf(pcode, "sub new {\n");
1716 } else {
1717 /* Constructor doesn't match classname so we'll just use the normal name */
1718 Printv(pcode, "sub ", Swig_name_construct(NSPACE_TODO, symname), " {\n", NIL);
1719 }
1720
1721 const char *pkg = getCurrentClass() && Swig_directorclass(getCurrentClass())? "$_[0]" : "shift";
1722 Printv(pcode,
1723 tab4, "my $pkg = ", pkg, ";\n",
1724 tab4, "my $self = ", cmodule, "::", Swig_name_construct(NSPACE_TODO, symname), "(@_);\n", tab4, "bless $self, $pkg if defined($self);\n", "}\n\n", NIL);
1725
1726 have_constructor = 1;
1727 }
1728 }
1729 member_func = 0;
1730 return SWIG_OK;
1731 }
1732
1733 /* ------------------------------------------------------------
1734 * destructorHandler()
1735 * ------------------------------------------------------------ */
1736
destructorHandler(Node * n)1737 virtual int destructorHandler(Node *n) {
1738 String *symname = Getattr(n, "sym:name");
1739 member_func = 1;
1740 Language::destructorHandler(n);
1741 if (blessed) {
1742 if (Getattr(n, "feature:shadow")) {
1743 String *plcode = perlcode(Getattr(n, "feature:shadow"), 0);
1744 String *plaction = NewStringf("%s::%s", module, Swig_name_member(NSPACE_TODO, class_name, symname));
1745 Replaceall(plcode, "$action", plaction);
1746 Delete(plaction);
1747 Printv(pcode, plcode, NIL);
1748 } else {
1749 Printv(pcode,
1750 "sub DESTROY {\n",
1751 tab4, "return unless $_[0]->isa('HASH');\n",
1752 tab4, "my $self = tied(%{$_[0]});\n",
1753 tab4, "return unless defined $self;\n",
1754 tab4, "delete $ITERATORS{$self};\n",
1755 tab4, "if (exists $OWNER{$self}) {\n",
1756 tab8, cmodule, "::", Swig_name_destroy(NSPACE_TODO, symname), "($self);\n", tab8, "delete $OWNER{$self};\n", tab4, "}\n}\n\n", NIL);
1757 have_destructor = 1;
1758 }
1759 }
1760 member_func = 0;
1761 return SWIG_OK;
1762 }
1763
1764 /* ------------------------------------------------------------
1765 * staticmemberfunctionHandler()
1766 * ------------------------------------------------------------ */
1767
staticmemberfunctionHandler(Node * n)1768 virtual int staticmemberfunctionHandler(Node *n) {
1769 member_func = 1;
1770 Language::staticmemberfunctionHandler(n);
1771 member_func = 0;
1772 if ((blessed) && (!Getattr(n, "sym:nextSibling"))) {
1773 String *symname = Getattr(n, "sym:name");
1774 Printv(pcode, "*", symname, " = *", cmodule, "::", Swig_name_member(NSPACE_TODO, class_name, symname), ";\n", NIL);
1775 }
1776 return SWIG_OK;
1777 }
1778
1779 /* ------------------------------------------------------------
1780 * staticmembervariableHandler()
1781 * ------------------------------------------------------------ */
1782
staticmembervariableHandler(Node * n)1783 virtual int staticmembervariableHandler(Node *n) {
1784 Language::staticmembervariableHandler(n);
1785 if (blessed) {
1786 String *symname = Getattr(n, "sym:name");
1787 Printv(pcode, "*", symname, " = *", cmodule, "::", Swig_name_member(NSPACE_TODO, class_name, symname), ";\n", NIL);
1788 }
1789 return SWIG_OK;
1790 }
1791
1792 /* ------------------------------------------------------------
1793 * memberconstantHandler()
1794 * ------------------------------------------------------------ */
1795
memberconstantHandler(Node * n)1796 virtual int memberconstantHandler(Node *n) {
1797 String *symname = Getattr(n, "sym:name");
1798 int oldblessed = blessed;
1799
1800 /* Create a normal constant */
1801 blessed = 0;
1802 Language::memberconstantHandler(n);
1803 blessed = oldblessed;
1804
1805 if (blessed) {
1806 Printv(pcode, "*", symname, " = *", cmodule, "::", Swig_name_member(NSPACE_TODO, class_name, symname), ";\n", NIL);
1807 }
1808 return SWIG_OK;
1809 }
1810
1811 /* ------------------------------------------------------------
1812 * pragma()
1813 *
1814 * Pragma directive.
1815 *
1816 * %pragma(perl5) code="String" # Includes a string in the .pm file
1817 * %pragma(perl5) include="file.pl" # Includes a file in the .pm file
1818 * ------------------------------------------------------------ */
1819
pragmaDirective(Node * n)1820 virtual int pragmaDirective(Node *n) {
1821 String *lang;
1822 String *code;
1823 String *value;
1824 if (!ImportMode) {
1825 lang = Getattr(n, "lang");
1826 code = Getattr(n, "name");
1827 value = Getattr(n, "value");
1828 if (Strcmp(lang, "perl5") == 0) {
1829 if (Strcmp(code, "code") == 0) {
1830 /* Dump the value string into the .pm file */
1831 if (value) {
1832 Printf(pragma_include, "%s\n", value);
1833 }
1834 } else if (Strcmp(code, "include") == 0) {
1835 /* Include a file into the .pm file */
1836 if (value) {
1837 FILE *f = Swig_include_open(value);
1838 if (!f) {
1839 Swig_error(input_file, line_number, "Unable to locate file %s\n", value);
1840 } else {
1841 char buffer[4096];
1842 while (fgets(buffer, 4095, f)) {
1843 Printf(pragma_include, "%s", buffer);
1844 }
1845 fclose(f);
1846 }
1847 }
1848 } else {
1849 Swig_error(input_file, line_number, "Unrecognized pragma.\n");
1850 }
1851 }
1852 }
1853 return Language::pragmaDirective(n);
1854 }
1855
1856 /* ------------------------------------------------------------
1857 * perlcode() - Output perlcode code into the shadow file
1858 * ------------------------------------------------------------ */
1859
perlcode(String * code,const String * indent)1860 String *perlcode(String *code, const String *indent) {
1861 String *out = NewString("");
1862 String *temp;
1863 char *t;
1864 if (!indent)
1865 indent = "";
1866
1867 temp = NewString(code);
1868
1869 t = Char(temp);
1870 if (*t == '{') {
1871 Delitem(temp, 0);
1872 Delitem(temp, DOH_END);
1873 }
1874
1875 /* Split the input text into lines */
1876 List *clist = SplitLines(temp);
1877 Delete(temp);
1878 int initial = 0;
1879 String *s = 0;
1880 Iterator si;
1881 /* Get the initial indentation */
1882
1883 for (si = First(clist); si.item; si = Next(si)) {
1884 s = si.item;
1885 if (Len(s)) {
1886 char *c = Char(s);
1887 while (*c) {
1888 if (!isspace(*c))
1889 break;
1890 initial++;
1891 c++;
1892 }
1893 if (*c && !isspace(*c))
1894 break;
1895 else {
1896 initial = 0;
1897 }
1898 }
1899 }
1900 while (si.item) {
1901 s = si.item;
1902 if (Len(s) > initial) {
1903 char *c = Char(s);
1904 c += initial;
1905 Printv(out, indent, c, "\n", NIL);
1906 } else {
1907 Printv(out, "\n", NIL);
1908 }
1909 si = Next(si);
1910 }
1911 Delete(clist);
1912 return out;
1913 }
1914
1915 /* ------------------------------------------------------------
1916 * insertDirective()
1917 *
1918 * Hook for %insert directive.
1919 * ------------------------------------------------------------ */
1920
insertDirective(Node * n)1921 virtual int insertDirective(Node *n) {
1922 String *code = Getattr(n, "code");
1923 String *section = Getattr(n, "section");
1924
1925 if ((!ImportMode) && (Cmp(section, "perl") == 0)) {
1926 Printv(additional_perl_code, code, NIL);
1927 } else {
1928 Language::insertDirective(n);
1929 }
1930 return SWIG_OK;
1931 }
1932
runtimeCode()1933 String *runtimeCode() {
1934 String *s = NewString("");
1935 String *shead = Swig_include_sys("perlhead.swg");
1936 if (!shead) {
1937 Printf(stderr, "*** Unable to open 'perlhead.swg'\n");
1938 } else {
1939 Append(s, shead);
1940 Delete(shead);
1941 }
1942 String *serrors = Swig_include_sys("perlerrors.swg");
1943 if (!serrors) {
1944 Printf(stderr, "*** Unable to open 'perlerrors.swg'\n");
1945 } else {
1946 Append(s, serrors);
1947 Delete(serrors);
1948 }
1949 String *srun = Swig_include_sys("perlrun.swg");
1950 if (!srun) {
1951 Printf(stderr, "*** Unable to open 'perlrun.swg'\n");
1952 } else {
1953 Append(s, srun);
1954 Delete(srun);
1955 }
1956 return s;
1957 }
1958
defaultExternalRuntimeFilename()1959 String *defaultExternalRuntimeFilename() {
1960 return NewString("swigperlrun.h");
1961 }
1962
classDirectorInit(Node * n)1963 virtual int classDirectorInit(Node *n) {
1964 String *declaration = Swig_director_declaration(n);
1965 Printf(f_directors_h, "\n");
1966 Printf(f_directors_h, "%s\n", declaration);
1967 Printf(f_directors_h, "public:\n");
1968 Delete(declaration);
1969 return Language::classDirectorInit(n);
1970 }
1971
classDirectorEnd(Node * n)1972 virtual int classDirectorEnd(Node *n) {
1973 if (dirprot_mode()) {
1974 /*
1975 This implementation uses a std::map<std::string,int>.
1976
1977 It should be possible to rewrite it using a more elegant way,
1978 like copying the Java approach for the 'override' array.
1979
1980 But for now, this seems to be the least intrusive way.
1981 */
1982 Printf(f_directors_h, "\n");
1983 Printf(f_directors_h, "/* Internal director utilities */\n");
1984 Printf(f_directors_h, "public:\n");
1985 Printf(f_directors_h, " bool swig_get_inner(const char *swig_protected_method_name) const {\n");
1986 Printf(f_directors_h, " std::map<std::string, bool>::const_iterator iv = swig_inner.find(swig_protected_method_name);\n");
1987 Printf(f_directors_h, " return (iv != swig_inner.end() ? iv->second : false);\n");
1988 Printf(f_directors_h, " }\n");
1989
1990 Printf(f_directors_h, " void swig_set_inner(const char *swig_protected_method_name, bool swig_val) const {\n");
1991 Printf(f_directors_h, " swig_inner[swig_protected_method_name] = swig_val;\n");
1992 Printf(f_directors_h, " }\n");
1993 Printf(f_directors_h, "private:\n");
1994 Printf(f_directors_h, " mutable std::map<std::string, bool> swig_inner;\n");
1995 }
1996 Printf(f_directors_h, "};\n");
1997 return Language::classDirectorEnd(n);
1998 }
1999
classDirectorConstructor(Node * n)2000 virtual int classDirectorConstructor(Node *n) {
2001 Node *parent = Getattr(n, "parentNode");
2002 String *sub = NewString("");
2003 String *decl = Getattr(n, "decl");
2004 String *supername = Swig_class_name(parent);
2005 String *classname = NewString("");
2006 Printf(classname, "SwigDirector_%s", supername);
2007
2008 /* insert self parameter */
2009 Parm *p;
2010 ParmList *superparms = Getattr(n, "parms");
2011 ParmList *parms = CopyParmList(superparms);
2012 String *type = NewString("SV");
2013 SwigType_add_pointer(type);
2014 p = NewParm(type, NewString("self"), n);
2015 set_nextSibling(p, parms);
2016 parms = p;
2017
2018 if (!Getattr(n, "defaultargs")) {
2019 /* constructor */
2020 {
2021 Wrapper *w = NewWrapper();
2022 String *call;
2023 String *basetype = Getattr(parent, "classtype");
2024 String *target = Swig_method_decl(0, decl, classname, parms, 0);
2025 call = Swig_csuperclass_call(0, basetype, superparms);
2026 Printf(w->def, "%s::%s: %s, Swig::Director(self) { \n", classname, target, call);
2027 Printf(w->def, " SWIG_DIRECTOR_RGTR((%s *)this, this); \n", basetype);
2028 Append(w->def, "}\n");
2029 Delete(target);
2030 Wrapper_print(w, f_directors);
2031 Delete(call);
2032 DelWrapper(w);
2033 }
2034
2035 /* constructor header */
2036 {
2037 String *target = Swig_method_decl(0, decl, classname, parms, 1);
2038 Printf(f_directors_h, " %s;\n", target);
2039 Delete(target);
2040 }
2041 }
2042
2043 Delete(sub);
2044 Delete(classname);
2045 Delete(supername);
2046 Delete(parms);
2047 return Language::classDirectorConstructor(n);
2048 }
2049
classDirectorMethod(Node * n,Node * parent,String * super)2050 virtual int classDirectorMethod(Node *n, Node *parent, String *super) {
2051 int is_void = 0;
2052 int is_pointer = 0;
2053 String *decl = Getattr(n, "decl");
2054 String *name = Getattr(n, "name");
2055 String *classname = Getattr(parent, "sym:name");
2056 String *c_classname = Getattr(parent, "name");
2057 String *symname = Getattr(n, "sym:name");
2058 String *declaration = NewString("");
2059 ParmList *l = Getattr(n, "parms");
2060 Wrapper *w = NewWrapper();
2061 String *tm;
2062 String *wrap_args = NewString("");
2063 String *returntype = Getattr(n, "type");
2064 String *value = Getattr(n, "value");
2065 String *storage = Getattr(n, "storage");
2066 bool pure_virtual = false;
2067 int status = SWIG_OK;
2068 int idx;
2069 bool ignored_method = GetFlag(n, "feature:ignore") ? true : false;
2070
2071 if (Cmp(storage, "virtual") == 0) {
2072 if (Cmp(value, "0") == 0) {
2073 pure_virtual = true;
2074 }
2075 }
2076
2077 /* determine if the method returns a pointer */
2078 is_pointer = SwigType_ispointer_return(decl);
2079 is_void = (!Cmp(returntype, "void") && !is_pointer);
2080
2081 /* virtual method definition */
2082 String *target;
2083 String *pclassname = NewStringf("SwigDirector_%s", classname);
2084 String *qualified_name = NewStringf("%s::%s", pclassname, name);
2085 SwigType *rtype = Getattr(n, "conversion_operator") ? 0 : Getattr(n, "classDirectorMethods:type");
2086 target = Swig_method_decl(rtype, decl, qualified_name, l, 0);
2087 Printf(w->def, "%s", target);
2088 Delete(qualified_name);
2089 Delete(target);
2090 /* header declaration */
2091 target = Swig_method_decl(rtype, decl, name, l, 1);
2092 Printf(declaration, " virtual %s", target);
2093 Delete(target);
2094
2095 // Get any exception classes in the throws typemap
2096 if (Getattr(n, "noexcept")) {
2097 Append(w->def, " noexcept");
2098 Append(declaration, " noexcept");
2099 }
2100 ParmList *throw_parm_list = 0;
2101
2102 if ((throw_parm_list = Getattr(n, "throws")) || Getattr(n, "throw")) {
2103 Parm *p;
2104 int gencomma = 0;
2105
2106 Append(w->def, " throw(");
2107 Append(declaration, " throw(");
2108
2109 if (throw_parm_list)
2110 Swig_typemap_attach_parms("throws", throw_parm_list, 0);
2111 for (p = throw_parm_list; p; p = nextSibling(p)) {
2112 if (Getattr(p, "tmap:throws")) {
2113 if (gencomma++) {
2114 Append(w->def, ", ");
2115 Append(declaration, ", ");
2116 }
2117 String *str = SwigType_str(Getattr(p, "type"), 0);
2118 Append(w->def, str);
2119 Append(declaration, str);
2120 Delete(str);
2121 }
2122 }
2123
2124 Append(w->def, ")");
2125 Append(declaration, ")");
2126 }
2127
2128 Append(w->def, " {");
2129 Append(declaration, ";\n");
2130
2131 /* declare method return value
2132 * if the return value is a reference or const reference, a specialized typemap must
2133 * handle it, including declaration of c_result ($result).
2134 */
2135 if (!is_void && (!ignored_method || pure_virtual)) {
2136 if (!SwigType_isclass(returntype)) {
2137 if (!(SwigType_ispointer(returntype) || SwigType_isreference(returntype))) {
2138 String *construct_result = NewStringf("= SwigValueInit< %s >()", SwigType_lstr(returntype, 0));
2139 Wrapper_add_localv(w, "c_result", SwigType_lstr(returntype, "c_result"), construct_result, NIL);
2140 Delete(construct_result);
2141 } else {
2142 Wrapper_add_localv(w, "c_result", SwigType_lstr(returntype, "c_result"), "= 0", NIL);
2143 }
2144 } else {
2145 String *cres = SwigType_lstr(returntype, "c_result");
2146 Printf(w->code, "%s;\n", cres);
2147 Delete(cres);
2148 }
2149 }
2150
2151 if (!is_void && !ignored_method) {
2152 String *pres = NewStringf("SV *%s", Swig_cresult_name());
2153 Wrapper_add_local(w, Swig_cresult_name(), pres);
2154 Delete(pres);
2155 }
2156
2157 if (ignored_method) {
2158 if (!pure_virtual) {
2159 if (!is_void)
2160 Printf(w->code, "return ");
2161 String *super_call = Swig_method_call(super, l);
2162 Printf(w->code, "%s;\n", super_call);
2163 Delete(super_call);
2164 } else {
2165 Printf(w->code, "Swig::DirectorPureVirtualException::raise(\"Attempted to invoke pure virtual method %s::%s\");\n", SwigType_namestr(c_classname),
2166 SwigType_namestr(name));
2167 }
2168 } else {
2169 /* attach typemaps to arguments (C/C++ -> Perl) */
2170 String *parse_args = NewString("");
2171 String *pstack = NewString("");
2172
2173 Swig_director_parms_fixup(l);
2174
2175 /* remove the wrapper 'w' since it was producing spurious temps */
2176 Swig_typemap_attach_parms("in", l, 0);
2177 Swig_typemap_attach_parms("directorin", l, w);
2178 Swig_typemap_attach_parms("directorargout", l, w);
2179
2180 Wrapper_add_local(w, "SP", "dSP");
2181
2182 {
2183 String *ptype = Copy(getClassType());
2184 SwigType_add_pointer(ptype);
2185 String *mangle = SwigType_manglestr(ptype);
2186
2187 Wrapper_add_local(w, "swigself", "SV *swigself");
2188 Printf(w->code, "swigself = SWIG_NewPointerObj(SWIG_as_voidptr(this), SWIGTYPE%s, SWIG_SHADOW);\n", mangle);
2189 Printf(w->code, "sv_bless(swigself, gv_stashpv(swig_get_class(), 0));\n");
2190 Delete(mangle);
2191 Delete(ptype);
2192 Append(pstack, "XPUSHs(swigself);\n");
2193 }
2194
2195 Parm *p;
2196 char source[256];
2197
2198 int outputs = 0;
2199 if (!is_void)
2200 outputs++;
2201
2202 /* build argument list and type conversion string */
2203 idx = 0;
2204 p = l;
2205 while (p) {
2206 if (checkAttribute(p, "tmap:in:numinputs", "0")) {
2207 p = Getattr(p, "tmap:in:next");
2208 continue;
2209 }
2210
2211 /* old style? caused segfaults without the p!=0 check
2212 in the for() condition, and seems dangerous in the
2213 while loop as well.
2214 while (Getattr(p, "tmap:ignore")) {
2215 p = Getattr(p, "tmap:ignore:next");
2216 }
2217 */
2218
2219 if (Getattr(p, "tmap:directorargout") != 0)
2220 outputs++;
2221
2222 String *pname = Getattr(p, "name");
2223 String *ptype = Getattr(p, "type");
2224
2225 if ((tm = Getattr(p, "tmap:directorin")) != 0) {
2226 sprintf(source, "obj%d", idx++);
2227 String *input = NewString(source);
2228 Setattr(p, "emit:directorinput", input);
2229 Replaceall(tm, "$input", input);
2230 Delete(input);
2231 Replaceall(tm, "$owner", "0");
2232 Replaceall(tm, "$shadow", "0");
2233 /* Wrapper_add_localv(w, source, "SV *", source, "= 0", NIL); */
2234 Printv(wrap_args, "SV *", source, ";\n", NIL);
2235
2236 Printv(wrap_args, tm, "\n", NIL);
2237 Putc('O', parse_args);
2238 Printv(pstack, "XPUSHs(", source, ");\n", NIL);
2239 p = Getattr(p, "tmap:directorin:next");
2240 continue;
2241 } else if (Cmp(ptype, "void")) {
2242 /* special handling for pointers to other C++ director classes.
2243 * ideally this would be left to a typemap, but there is currently no
2244 * way to selectively apply the dynamic_cast<> to classes that have
2245 * directors. in other words, the type "SwigDirector_$1_lname" only exists
2246 * for classes with directors. we avoid the problem here by checking
2247 * module.wrap::directormap, but it's not clear how to get a typemap to
2248 * do something similar. perhaps a new default typemap (in addition
2249 * to SWIGTYPE) called DIRECTORTYPE?
2250 */
2251 if (SwigType_ispointer(ptype) || SwigType_isreference(ptype)) {
2252 Node *module = Getattr(parent, "module");
2253 Node *target = Swig_directormap(module, ptype);
2254 sprintf(source, "obj%d", idx++);
2255 String *nonconst = 0;
2256 /* strip pointer/reference --- should move to Swig/stype.c */
2257 String *nptype = NewString(Char(ptype) + 2);
2258 /* name as pointer */
2259 String *ppname = Copy(pname);
2260 if (SwigType_isreference(ptype)) {
2261 Insert(ppname, 0, "&");
2262 }
2263 /* if necessary, cast away const since Perl doesn't support it! */
2264 if (SwigType_isconst(nptype)) {
2265 nonconst = NewStringf("nc_tmp_%s", pname);
2266 String *nonconst_i = NewStringf("= const_cast< %s >(%s)", SwigType_lstr(ptype, 0), ppname);
2267 Wrapper_add_localv(w, nonconst, SwigType_lstr(ptype, 0), nonconst, nonconst_i, NIL);
2268 Delete(nonconst_i);
2269 Swig_warning(WARN_LANG_DISCARD_CONST, input_file, line_number,
2270 "Target language argument '%s' discards const in director method %s::%s.\n",
2271 SwigType_str(ptype, pname), SwigType_namestr(c_classname), SwigType_namestr(name));
2272 } else {
2273 nonconst = Copy(ppname);
2274 }
2275 Delete(nptype);
2276 Delete(ppname);
2277 String *mangle = SwigType_manglestr(ptype);
2278 if (target) {
2279 String *director = NewStringf("director_%s", mangle);
2280 Wrapper_add_localv(w, director, "Swig::Director *", director, "= 0", NIL);
2281 Wrapper_add_localv(w, source, "SV *", source, "= 0", NIL);
2282 Printf(wrap_args, "%s = SWIG_DIRECTOR_CAST(%s);\n", director, nonconst);
2283 Printf(wrap_args, "if (!%s) {\n", director);
2284 Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE%s, 0);\n", source, nonconst, mangle);
2285 Append(wrap_args, "} else {\n");
2286 Printf(wrap_args, "%s = %s->swig_get_self();\n", source, director);
2287 Printf(wrap_args, "SvREFCNT_inc((SV *)%s);\n", source);
2288 Append(wrap_args, "}\n");
2289 Delete(director);
2290 } else {
2291 Wrapper_add_localv(w, source, "SV *", source, "= 0", NIL);
2292 Printf(wrap_args, "%s = SWIG_NewPointerObj(%s, SWIGTYPE%s, 0);\n", source, nonconst, mangle);
2293 Printf(pstack, "XPUSHs(sv_2mortal(%s));\n", source);
2294 }
2295 Putc('O', parse_args);
2296 Delete(mangle);
2297 Delete(nonconst);
2298 } else {
2299 Swig_warning(WARN_TYPEMAP_DIRECTORIN_UNDEF, input_file, line_number,
2300 "Unable to use type %s as a function argument in director method %s::%s (skipping method).\n", SwigType_str(ptype, 0),
2301 SwigType_namestr(c_classname), SwigType_namestr(name));
2302 status = SWIG_NOWRAP;
2303 break;
2304 }
2305 }
2306 p = nextSibling(p);
2307 }
2308
2309 /* add the method name as a PyString */
2310 String *pyname = Getattr(n, "sym:name");
2311
2312 /* wrap complex arguments to PyObjects */
2313 Printv(w->code, wrap_args, NIL);
2314
2315 /* pass the method call on to the Python object */
2316 if (dirprot_mode() && !is_public(n)) {
2317 Printf(w->code, "swig_set_inner(\"%s\", true);\n", name);
2318 }
2319
2320 Append(w->code, "ENTER;\n");
2321 Append(w->code, "SAVETMPS;\n");
2322 Append(w->code, "PUSHMARK(SP);\n");
2323 Append(w->code, pstack);
2324 Delete(pstack);
2325 Append(w->code, "PUTBACK;\n");
2326 Printf(w->code, "call_method(\"%s\", G_EVAL | G_SCALAR);\n", pyname);
2327
2328 if (dirprot_mode() && !is_public(n))
2329 Printf(w->code, "swig_set_inner(\"%s\", false);\n", name);
2330
2331 /* exception handling */
2332 tm = Swig_typemap_lookup("director:except", n, Swig_cresult_name(), 0);
2333 if (!tm) {
2334 tm = Getattr(n, "feature:director:except");
2335 if (tm)
2336 tm = Copy(tm);
2337 }
2338 Append(w->code, "if (SvTRUE(ERRSV)) {\n");
2339 Append(w->code, " PUTBACK;\n FREETMPS;\n LEAVE;\n");
2340 if ((tm) && Len(tm) && (Strcmp(tm, "1") != 0)) {
2341 Replaceall(tm, "$error", "ERRSV");
2342 Printv(w->code, Str(tm), "\n", NIL);
2343 } else {
2344 Printf(w->code, " Swig::DirectorMethodException::raise(ERRSV);\n", classname, pyname);
2345 }
2346 Append(w->code, "}\n");
2347 Delete(tm);
2348
2349 /*
2350 * Python method may return a simple object, or a tuple.
2351 * for in/out arguments, we have to extract the appropriate PyObjects from the tuple,
2352 * then marshal everything back to C/C++ (return value and output arguments).
2353 *
2354 */
2355
2356 /* marshal return value and other outputs (if any) from PyObject to C/C++ type */
2357
2358 String *cleanup = NewString("");
2359 String *outarg = NewString("");
2360
2361 if (outputs > 1) {
2362 Wrapper_add_local(w, "output", "SV *output");
2363 Printf(w->code, "if (count != %d) {\n", outputs);
2364 Printf(w->code, " Swig::DirectorTypeMismatchException::raise(\"Perl method %s.%sfailed to return a list.\");\n", classname, pyname);
2365 Append(w->code, "}\n");
2366 }
2367
2368 idx = 0;
2369
2370 /* marshal return value */
2371 if (!is_void) {
2372 Append(w->code, "SPAGAIN;\n");
2373 Printf(w->code, "%s = POPs;\n", Swig_cresult_name());
2374 tm = Swig_typemap_lookup("directorout", n, Swig_cresult_name(), w);
2375 if (tm != 0) {
2376 if (outputs > 1) {
2377 Printf(w->code, "output = POPs;\n");
2378 Replaceall(tm, "$input", "output");
2379 } else {
2380 Replaceall(tm, "$input", Swig_cresult_name());
2381 }
2382 char temp[24];
2383 sprintf(temp, "%d", idx);
2384 Replaceall(tm, "$argnum", temp);
2385
2386 /* TODO check this */
2387 if (Getattr(n, "wrap:disown")) {
2388 Replaceall(tm, "$disown", "SWIG_POINTER_DISOWN");
2389 } else {
2390 Replaceall(tm, "$disown", "0");
2391 }
2392 Replaceall(tm, "$result", "c_result");
2393 Printv(w->code, tm, "\n", NIL);
2394 Delete(tm);
2395 } else {
2396 Swig_warning(WARN_TYPEMAP_DIRECTOROUT_UNDEF, input_file, line_number,
2397 "Unable to use return type %s in director method %s::%s (skipping method).\n", SwigType_str(returntype, 0),
2398 SwigType_namestr(c_classname), SwigType_namestr(name));
2399 status = SWIG_ERROR;
2400 }
2401 }
2402
2403 /* marshal outputs */
2404 for (p = l; p;) {
2405 if ((tm = Getattr(p, "tmap:directorargout")) != 0) {
2406 if (outputs > 1) {
2407 Printf(w->code, "output = POPs;\n");
2408 Replaceall(tm, "$result", "output");
2409 } else {
2410 Replaceall(tm, "$result", Swig_cresult_name());
2411 }
2412 Replaceall(tm, "$input", Getattr(p, "emit:directorinput"));
2413 Printv(w->code, tm, "\n", NIL);
2414 p = Getattr(p, "tmap:directorargout:next");
2415 } else {
2416 p = nextSibling(p);
2417 }
2418 }
2419
2420 Delete(parse_args);
2421 Delete(cleanup);
2422 Delete(outarg);
2423 }
2424
2425 if (!ignored_method) {
2426 Append(w->code, "PUTBACK;\n");
2427 Append(w->code, "FREETMPS;\n");
2428 Append(w->code, "LEAVE;\n");
2429 }
2430
2431 if (!is_void) {
2432 if (!(ignored_method && !pure_virtual)) {
2433 String *rettype = SwigType_str(returntype, 0);
2434 if (!SwigType_isreference(returntype)) {
2435 Printf(w->code, "return (%s) c_result;\n", rettype);
2436 } else {
2437 Printf(w->code, "return (%s) *c_result;\n", rettype);
2438 }
2439 Delete(rettype);
2440 }
2441 }
2442
2443 Append(w->code, "}\n");
2444
2445 // We expose protected methods via an extra public inline method which makes a straight call to the wrapped class' method
2446 String *inline_extra_method = NewString("");
2447 if (dirprot_mode() && !is_public(n) && !pure_virtual) {
2448 Printv(inline_extra_method, declaration, NIL);
2449 String *extra_method_name = NewStringf("%sSwigPublic", name);
2450 Replaceall(inline_extra_method, name, extra_method_name);
2451 Replaceall(inline_extra_method, ";\n", " {\n ");
2452 if (!is_void)
2453 Printf(inline_extra_method, "return ");
2454 String *methodcall = Swig_method_call(super, l);
2455 Printv(inline_extra_method, methodcall, ";\n }\n", NIL);
2456 Delete(methodcall);
2457 Delete(extra_method_name);
2458 }
2459
2460 /* emit the director method */
2461 if (status == SWIG_OK) {
2462 if (!Getattr(n, "defaultargs")) {
2463 Replaceall(w->code, "$symname", symname);
2464 Wrapper_print(w, f_directors);
2465 Printv(f_directors_h, declaration, NIL);
2466 Printv(f_directors_h, inline_extra_method, NIL);
2467 }
2468 }
2469
2470 /* clean up */
2471 Delete(wrap_args);
2472 Delete(pclassname);
2473 DelWrapper(w);
2474 return status;
2475 }
classDirectorDisown(Node * n)2476 int classDirectorDisown(Node *n) {
2477 int rv;
2478 member_func = 1;
2479 rv = Language::classDirectorDisown(n);
2480 member_func = 0;
2481 if (rv == SWIG_OK && Swig_directorclass(n)) {
2482 String *symname = Getattr(n, "sym:name");
2483 String *disown = Swig_name_disown(NSPACE_TODO, symname);
2484 Setattr(n, "perl5:directordisown", NewStringf("%s::%s", cmodule, disown));
2485 }
2486 return rv;
2487 }
classDirectorDestructor(Node * n)2488 int classDirectorDestructor(Node *n) {
2489 /* TODO: it would be nice if this didn't have to copy the body of Language::classDirectorDestructor() */
2490 String *DirectorClassName = directorClassName(getCurrentClass());
2491 String *body = NewString("\n");
2492
2493 String *ptype = Copy(getClassType());
2494 SwigType_add_pointer(ptype);
2495 String *mangle = SwigType_manglestr(ptype);
2496
2497 Printv(body, tab4, "dSP;\n", tab4, "SV *self = SWIG_NewPointerObj(SWIG_as_voidptr(this), SWIGTYPE", mangle, ", SWIG_SHADOW);\n", tab4, "\n", tab4,
2498 "sv_bless(self, gv_stashpv(swig_get_class(), 0));\n", tab4, "ENTER;\n", tab4, "SAVETMPS;\n", tab4, "PUSHMARK(SP);\n", tab4,
2499 "XPUSHs(self);\n", tab4, "XPUSHs(&PL_sv_yes);\n", tab4, "PUTBACK;\n", tab4, "call_method(\"DESTROY\", G_EVAL | G_VOID);\n", tab4,
2500 "FREETMPS;\n", tab4, "LEAVE;\n", NIL);
2501
2502 Delete(mangle);
2503 Delete(ptype);
2504
2505 if (Getattr(n, "noexcept")) {
2506 Printf(f_directors_h, " virtual ~%s() noexcept;\n", DirectorClassName);
2507 Printf(f_directors, "%s::~%s() noexcept {%s}\n\n", DirectorClassName, DirectorClassName, body);
2508 } else if (Getattr(n, "throw")) {
2509 Printf(f_directors_h, " virtual ~%s() throw();\n", DirectorClassName);
2510 Printf(f_directors, "%s::~%s() throw() {%s}\n\n", DirectorClassName, DirectorClassName, body);
2511 } else {
2512 Printf(f_directors_h, " virtual ~%s();\n", DirectorClassName);
2513 Printf(f_directors, "%s::~%s() {%s}\n\n", DirectorClassName, DirectorClassName, body);
2514 }
2515 return SWIG_OK;
2516 }
2517 };
2518
2519 /* -----------------------------------------------------------------------------
2520 * swig_perl5() - Instantiate module
2521 * ----------------------------------------------------------------------------- */
2522
new_swig_perl5()2523 static Language *new_swig_perl5() {
2524 return new PERL5();
2525 }
swig_perl5(void)2526 extern "C" Language *swig_perl5(void) {
2527 return new_swig_perl5();
2528 }
2529