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

package option for perl5

Browse source 
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@10393 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Jason Stewart 2008-04-26 13:12:45 +00:00
commit bea5f1d47b
9 changed files with 228 additions and 66 deletions
Download patch file Download diff file Expand all files Collapse all files

28
Doc/Manual/Perl5.html
View file

@ -1298,6 +1298,34 @@ nested namespace simply provide the fully qualified name in your
<b>NOTE:</b> the double quotes are necessary.
</p>
<p>
Using the <tt>package</tt> option of the <tt>%module</tt> directive allows
you to specify what Perl namespace that the module will be living in when
installed. This is useful in the situation where a module maintainer
wants to split a large module into smaller pieces to make maintenance
easier, but doesn't want to have that affect the module name used by
applications. So for example, if I wanted to split <tt>XML::Xerces</tt>
into <tt>XML::Xerces::SAX</tt>, etc. , but I wanted all the applications
to be able to access the classes using the <tt>XML::Xerces</tt> namespace
I could use:
</p>
<div class="code">
<pre>
%module(package="XML::Xerces") "XML::Xerces::SAX
</pre>
</div>
<p>
And now all the applications could use the class
<tt>XML::Xerces::SAXParser</tt>. Without the <tt>package</tt> directive
splitting the module would force applications to use the class
<tt>XML::Xerces::SAX::SAXParser</tt>. This could break compatibility for
existing applications that are already using the class under the name
<tt>XML::Xerces::SAXParser</tt>.
</p>
<!--
<p>
This can be changed by giving SWIG the -package

1
Examples/test-suite/common.mk
View file

@ -422,6 +422,7 @@ C_TEST_CASES += \
MULTI_CPP_TEST_CASES += \
clientdata_prop \
imports \
package \
mod \
template_typedef_import \
multi_import

5
Examples/test-suite/package.h Normal file
View file

@ -0,0 +1,5 @@
class A
{
public:
int testInt() { return 2;}
};

2
Examples/test-suite/package.list Normal file
View file

@ -0,0 +1,2 @@
package_a
package_b

10
Examples/test-suite/package_a.i Normal file
View file

@ -0,0 +1,10 @@
%module(package="C") "package_a";
%inline %{
class A
{
public:
int testInt() { return 2;}
};
%}

10
Examples/test-suite/package_b.i Normal file
View file

@ -0,0 +1,10 @@
%module(package="C") "package_b";
%inline %{
class B
{
public:
int testInt() { return 4; }
};
%}

2
Examples/test-suite/perl5/README
View file

@ -12,4 +12,6 @@ adding a new test to this suite, please use Test::More.
Currently converted test cases include:
* operator_overload
* operator_overload_break
* package
* overload_simple

24
Examples/test-suite/perl5/package_runme.pl Normal file
View file

@ -0,0 +1,24 @@
#!/usr/bin/perl -w
use strict;
use Test::More tests => 4;
BEGIN { use_ok('package_a'); }
BEGIN { use_ok('package_b'); }
# Workaround for
# ok( not (expression) , "test description" );
# does not working in older versions of Perl, eg 5.004_04
sub ok_not ($;$) {
my($test, $name) = @_;
$test = not $test;
ok($test, $name);
}
my $a = C::A->new();
isa_ok($a, 'C::A');
my $b = C::B->new();
isa_ok($b, 'C::B');

212
Source/Modules/perl5.cxx
View file

@ -45,17 +45,21 @@ 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.
* 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;
/*
* fullmodule
* the fully namespace qualified name of the module, e.g. "XML::Xerces"
* 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
* 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 *fullmodule = 0;
static String *namespace_module = 0;
/*
* cmodule
* the namespace of the internal glue code, set to the value of
@ -63,6 +67,13 @@ static String *fullmodule = 0;
*/
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;
@ -77,6 +88,9 @@ 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 */
@ -170,6 +184,9 @@ public:
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], "-cppcast") == 0) {
cppcast = 1;
Swig_mark_arg(i);
@ -241,16 +258,43 @@ public:
Printf(f_runtime, "#define SWIG_CASTRANK_MODE\n");
module = Copy(Getattr(n, "name"));
// 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"));
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");
}
}
String *underscore_module = Copy(module);
Replaceall(underscore_module,":","_");
if (verbose > 0) {
fprintf(stdout, "top: using namespace_module: %s\n", Char(namespace_module));
}
/* If we're in blessed mode, change the package name to "packagec" */
if (blessed) {
cmodule = NewStringf("%sc", module);
cmodule = NewStringf("%sc",namespace_module);
} else {
cmodule = NewString(module);
cmodule = NewString(namespace_module);
}
fullmodule = NewString(module);
/* Create a .pm file
* Need to strip off any prefixes that might be found in
@ -281,12 +325,11 @@ public:
Swig_register_filebyname("perl", f_pm);
}
{
String *tmp = NewString(fullmodule);
Replaceall(tmp, ":", "_");
Printf(f_header, "#define SWIG_init boot_%s\n\n", tmp);
Printf(f_header, "#define SWIG_name \"%s::boot_%s\"\n", cmodule, tmp);
Printf(f_header, "#define SWIG_prefix \"%s::\"\n", cmodule);
Delete(tmp);
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);
}
Printf(f_pm, "# This file was automatically generated by SWIG (http://www.swig.org).\n");
@ -295,14 +338,20 @@ public:
Printf(f_pm, "# Don't modify this file, modify the SWIG interface instead.\n");
Printf(f_pm, "\n");
Printf(f_pm, "package %s;\n", fullmodule);
Printf(f_pm, "package %s;\n", module);
Printf(f_pm, "require Exporter;\n");
if (!staticoption) {
Printf(f_pm, "require DynaLoader;\n");
Printf(f_pm, "@ISA = qw(Exporter DynaLoader);\n");
/*
* 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, "@ISA = qw(Exporter);\n");
Printf(f_pm,"use base qw(Exporter);\n");
if (!staticoption) {
Printf(f_pm,"use base qw(DynaLoader);\n");
}
}
/* Start creating magic code */
@ -310,8 +359,8 @@ public:
Printv(magic,
"#ifdef __cplusplus\nextern \"C\" {\n#endif\n\n",
"#ifdef PERL_OBJECT\n",
"#define MAGIC_CLASS _wrap_", module, "_var::\n",
"class _wrap_", module, "_var : public CPerlObj {\n",
"#define MAGIC_CLASS _wrap_", underscore_module, "_var::\n",
"class _wrap_", underscore_module, "_var : public CPerlObj {\n",
"public:\n",
"#else\n",
"#define MAGIC_CLASS\n",
@ -379,60 +428,72 @@ public:
Printf(f_pm, "package %s;\n", cmodule);
if (!staticoption) {
Printf(f_pm, "bootstrap %s;\n", fullmodule);
Printf(f_pm,"bootstrap %s;\n", module);
} else {
String *tmp = NewString(fullmodule);
Replaceall(tmp, ":", "_");
Printf(f_pm, "boot_%s();\n", tmp);
Delete(tmp);
Printf(f_pm,"package %s;\n", cmodule);
Printf(f_pm,"boot_%s();\n", underscore_module);
}
Printf(f_pm, "package %s;\n", fullmodule);
Printf(f_pm, "@EXPORT = qw( %s);\n", exported);
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) {
Printv(base, "\n# ---------- BASE METHODS -------------\n\n", "package ", fullmodule, ";\n\n", NIL);
/*
* 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 */
/* Write out the TIE method */
Printv(base, "sub TIEHASH {\n", tab4, "my ($classname,$obj) = @_;\n", tab4, "return bless $obj, $classname;\n", "}\n\n", NIL);
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. */
/* 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");
Printf(base, "sub CLEAR { }\n\n");
/* Output default firstkey/nextkey methods */
/* Output default firstkey/nextkey methods */
Printf(base, "sub FIRSTKEY { }\n\n");
Printf(base, "sub NEXTKEY { }\n\n");
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 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) */
/* 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);
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 */
/* Output a 'this' method */
Printv(base, "sub this {\n", tab4, "my $ptr = shift;\n", tab4, "return tied(%$ptr);\n", "}\n\n", NIL);
Printv(base, "sub this {\n", tab4, "my $ptr = shift;\n", tab4, "return tied(%$ptr);\n", "}\n\n", NIL);
Printf(f_pm, "%s", base);
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", fullmodule);
Printf(f_pm, "package %s;\n\n", namespace_module);
Printf(f_pm, "%s", func_stubs);
/* Emit package code for different classes */
@ -441,14 +502,14 @@ public:
if (num_consts > 0) {
/* Emit constant stubs */
Printf(f_pm, "\n# ------- CONSTANT STUBS -------\n\n");
Printf(f_pm, "package %s;\n\n", fullmodule);
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", fullmodule);
Printf(f_pm, "package %s;\n\n", namespace_module);
Printf(f_pm, "%s", var_stubs);
}
@ -459,6 +520,8 @@ public:
Close(f_pm);
Delete(f_pm);
Delete(base);
Delete(dest_package);
Delete(underscore_module);
/* Close all of the files */
Dump(f_header, f_runtime);
@ -1075,11 +1138,28 @@ public:
}
/* Do some work on the class name */
actualpackage = Getattr(clsmodule, "name");
if ((!compat) && (!Strchr(symname, ':'))) {
fullname = NewStringf("%s::%s", actualpackage, symname);
if (verbose > 0) {
fprintf(stdout, "setclassname: Found sym:name: %s\n", Char(symname));
fprintf(stdout, "setclassname: Found module: %s\n", Char(clsmodule));
fprintf(stdout, "setclassname: No package found\n");
}
if (dest_package) {
fullname = NewStringf("%s::%s", namespace_module, symname);
} else {
fullname = NewString(symname);
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);
}
@ -1119,7 +1199,7 @@ public:
/* Use the fully qualified name of the Perl class */
if (!compat) {
fullclassname = NewStringf("%s::%s", fullmodule, class_name);
fullclassname = NewStringf("%s::%s", namespace_module, class_name);
} else {
fullclassname = NewString(class_name);
}
@ -1232,8 +1312,8 @@ public:
}
/* Module comes last */
if (!compat || Cmp(fullmodule, fullclassname)) {
Printv(pm, " ", fullmodule, NIL);
if (!compat || Cmp(namespace_module, fullclassname)) {
Printv(pm, " ", namespace_module, NIL);
}
Printf(pm, " );\n");