r4609 - in /packages/libsub-exporter-perl/trunk: ./ debian/
inc/Module/
inc/Module/Install/ lib/Sub/ lib/Sub/Exporter/ t/ t/lib/Test/SubExporter/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Fri Dec 8 11:20:12 CET 2006
Author: eloy
Date: Fri Dec 8 11:20:11 2006
New Revision: 4609
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=4609
Log:
eloy: new upstream version
Added:
packages/libsub-exporter-perl/trunk/LICENSE
- copied unchanged from r4608, packages/libsub-exporter-perl/branches/upstream/current/LICENSE
packages/libsub-exporter-perl/trunk/t/lib/Test/SubExporter/GroupGenSubclass.pm
- copied unchanged from r4608, packages/libsub-exporter-perl/branches/upstream/current/t/lib/Test/SubExporter/GroupGenSubclass.pm
packages/libsub-exporter-perl/trunk/t/perl-critic.t
- copied unchanged from r4608, packages/libsub-exporter-perl/branches/upstream/current/t/perl-critic.t
Modified:
packages/libsub-exporter-perl/trunk/Changes
packages/libsub-exporter-perl/trunk/MANIFEST
packages/libsub-exporter-perl/trunk/META.yml
packages/libsub-exporter-perl/trunk/debian/changelog
packages/libsub-exporter-perl/trunk/inc/Module/Install.pm
packages/libsub-exporter-perl/trunk/inc/Module/Install/Base.pm
packages/libsub-exporter-perl/trunk/inc/Module/Install/Can.pm
packages/libsub-exporter-perl/trunk/inc/Module/Install/Fetch.pm
packages/libsub-exporter-perl/trunk/inc/Module/Install/Makefile.pm
packages/libsub-exporter-perl/trunk/inc/Module/Install/Metadata.pm
packages/libsub-exporter-perl/trunk/inc/Module/Install/Win32.pm
packages/libsub-exporter-perl/trunk/inc/Module/Install/WriteAll.pm
packages/libsub-exporter-perl/trunk/lib/Sub/Exporter.pm
packages/libsub-exporter-perl/trunk/lib/Sub/Exporter/Tutorial.pod
packages/libsub-exporter-perl/trunk/lib/Sub/Exporter/Util.pm
packages/libsub-exporter-perl/trunk/t/collection.t
packages/libsub-exporter-perl/trunk/t/lib/Test/SubExporter/GroupGen.pm
packages/libsub-exporter-perl/trunk/t/lib/Test/SubExporter/s_e.pm
packages/libsub-exporter-perl/trunk/t/real-export-groupgen.t
packages/libsub-exporter-perl/trunk/t/real-export-href.t
Modified: packages/libsub-exporter-perl/trunk/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/Changes?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/Changes (original)
+++ packages/libsub-exporter-perl/trunk/Changes Fri Dec 8 11:20:11 2006
@@ -1,4 +1,14 @@
Revision history for Sub-Exporter
+
+0.972 2006-12-05
+ allow exporter config to provide name (via string ref) of generator for
+ groups and exports
+ similarly allow a string ref for a method name for a collector hook
+ remove some pointless conditions
+
+0.971 2006-11-06
+ minor documentation clarification
+ add Perl::Critic tests (disabled by default)
0.970 2006-06-27
defaults populate before collectors collect, now
Modified: packages/libsub-exporter-perl/trunk/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/MANIFEST?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/MANIFEST (original)
+++ packages/libsub-exporter-perl/trunk/MANIFEST Fri Dec 8 11:20:11 2006
@@ -10,8 +10,9 @@
lib/Sub/Exporter.pm
lib/Sub/Exporter/Tutorial.pod
lib/Sub/Exporter/Util.pm
+LICENSE
+MANIFEST
Makefile.PL
-MANIFEST This list of files
META.yml
README
t/collection.t
@@ -24,8 +25,10 @@
t/lib/Test/SubExporter/DashSetup.pm
t/lib/Test/SubExporter/Faux.pm
t/lib/Test/SubExporter/GroupGen.pm
+t/lib/Test/SubExporter/GroupGenSubclass.pm
t/lib/Test/SubExporter/ObjGen.pm
t/lib/Test/SubExporter/s_e.pm
+t/perl-critic.t
t/pod-coverage.t
t/pod.t
t/real-export-groupgen.t
Modified: packages/libsub-exporter-perl/trunk/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/META.yml?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/META.yml (original)
+++ packages/libsub-exporter-perl/trunk/META.yml Fri Dec 8 11:20:11 2006
@@ -1,14 +1,14 @@
-author: 'Ricardo SIGNES <rjbs at cpan.org>'
+author: Ricardo SIGNES <rjbs at cpan.org>
distribution_type: module
-generated_by: Module::Install version 0.62
+generated_by: Module::Install version 0.64
license: perl
name: Sub-Exporter
-no_index:
- directory:
+no_index:
+ directory:
- inc
- t
-requires:
+requires:
Data::OptList: 0.1
Params::Util: 0.14
Sub::Install: 0.92
-version: 0.970
+version: 0.972
Modified: packages/libsub-exporter-perl/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/debian/changelog?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/debian/changelog (original)
+++ packages/libsub-exporter-perl/trunk/debian/changelog Fri Dec 8 11:20:11 2006
@@ -1,3 +1,9 @@
+libsub-exporter-perl (0.972-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Krzysztof Krzyzaniak (eloy) <eloy at debian.org> Fri, 8 Dec 2006 11:19:19 +0100
+
libsub-exporter-perl (0.97.0-1) unstable; urgency=low
* New upstream release (closes: #370695)
@@ -35,4 +41,3 @@
* Initial Release.
-- Krzysztof Krzyzaniak (eloy) <eloy at debian.org> Fri, 28 Apr 2006 16:39:50 +0200
-
Modified: packages/libsub-exporter-perl/trunk/inc/Module/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/inc/Module/Install.pm?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/inc/Module/Install.pm (original)
+++ packages/libsub-exporter-perl/trunk/inc/Module/Install.pm Fri Dec 8 11:20:11 2006
@@ -28,7 +28,7 @@
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.62';
+ $VERSION = '0.64';
}
# Whether or not inc::Module::Install is actually loaded, the
@@ -47,6 +47,22 @@
not:
use ${\__PACKAGE__};
+
+END_DIE
+}
+
+# If the script that is loading Module::Install is from the future,
+# then make will detect this and cause it to re-run over and over
+# again. This is bad. Rather than taking action to touch it (which
+# is unreliable on some platforms and requires write permissions)
+# for now we should catch this and refuse to run.
+if ( -f $0 and (stat($0))[9] > time ) {
+ die << "END_DIE";
+Your installer $0 has a modification time in the future.
+
+This is known to create infinite loops in make.
+
+Please correct this, then run $0 again.
END_DIE
}
Modified: packages/libsub-exporter-perl/trunk/inc/Module/Install/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/inc/Module/Install/Base.pm?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/inc/Module/Install/Base.pm (original)
+++ packages/libsub-exporter-perl/trunk/inc/Module/Install/Base.pm Fri Dec 8 11:20:11 2006
@@ -1,7 +1,7 @@
#line 1
package Module::Install::Base;
-$VERSION = '0.62';
+$VERSION = '0.64';
# Suspend handler for "redefined" warnings
BEGIN {
Modified: packages/libsub-exporter-perl/trunk/inc/Module/Install/Can.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/inc/Module/Install/Can.pm?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/inc/Module/Install/Can.pm (original)
+++ packages/libsub-exporter-perl/trunk/inc/Module/Install/Can.pm Fri Dec 8 11:20:11 2006
@@ -11,7 +11,7 @@
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.62';
+ $VERSION = '0.64';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
Modified: packages/libsub-exporter-perl/trunk/inc/Module/Install/Fetch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/inc/Module/Install/Fetch.pm?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/inc/Module/Install/Fetch.pm (original)
+++ packages/libsub-exporter-perl/trunk/inc/Module/Install/Fetch.pm Fri Dec 8 11:20:11 2006
@@ -6,7 +6,7 @@
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.62';
+ $VERSION = '0.64';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
Modified: packages/libsub-exporter-perl/trunk/inc/Module/Install/Makefile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/inc/Module/Install/Makefile.pm?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/inc/Module/Install/Makefile.pm (original)
+++ packages/libsub-exporter-perl/trunk/inc/Module/Install/Makefile.pm Fri Dec 8 11:20:11 2006
@@ -7,7 +7,7 @@
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.62';
+ $VERSION = '0.64';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
Modified: packages/libsub-exporter-perl/trunk/inc/Module/Install/Metadata.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/inc/Module/Install/Metadata.pm?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/inc/Module/Install/Metadata.pm (original)
+++ packages/libsub-exporter-perl/trunk/inc/Module/Install/Metadata.pm Fri Dec 8 11:20:11 2006
@@ -6,7 +6,7 @@
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.62';
+ $VERSION = '0.64';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
@@ -123,9 +123,9 @@
require Module::Build;
my $build = Module::Build->new(
- dist_name => $self->{name},
- dist_version => $self->{version},
- license => $self->{license},
+ dist_name => $self->name,
+ dist_version => $self->version,
+ license => $self->license,
);
$self->provides(%{ $build->find_dist_packages || {} });
}
Modified: packages/libsub-exporter-perl/trunk/inc/Module/Install/Win32.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/inc/Module/Install/Win32.pm?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/inc/Module/Install/Win32.pm (original)
+++ packages/libsub-exporter-perl/trunk/inc/Module/Install/Win32.pm Fri Dec 8 11:20:11 2006
@@ -6,7 +6,7 @@
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.62';
+ $VERSION = '0.64';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
Modified: packages/libsub-exporter-perl/trunk/inc/Module/Install/WriteAll.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/inc/Module/Install/WriteAll.pm?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/inc/Module/Install/WriteAll.pm (original)
+++ packages/libsub-exporter-perl/trunk/inc/Module/Install/WriteAll.pm Fri Dec 8 11:20:11 2006
@@ -6,7 +6,7 @@
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.62';
+ $VERSION = '0.64';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
Modified: packages/libsub-exporter-perl/trunk/lib/Sub/Exporter.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/lib/Sub/Exporter.pm?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/lib/Sub/Exporter.pm (original)
+++ packages/libsub-exporter-perl/trunk/lib/Sub/Exporter.pm Fri Dec 8 11:20:11 2006
@@ -14,13 +14,13 @@
=head1 VERSION
-version 0.970
-
- $Id: /my/cs/projects/export/trunk/lib/Sub/Exporter.pm 22773 2006-06-27T16:48:37.268002Z rjbs $
+version 0.972
+
+ $Id: /my/cs/projects/export/trunk/lib/Sub/Exporter.pm 28841 2006-12-05T22:44:01.427395Z rjbs $
=cut
-our $VERSION = '0.970';
+our $VERSION = '0.972';
=head1 SYNOPSIS
@@ -372,7 +372,7 @@
sub _group_name {
my ($name) = @_;
- return if (index '-:', (substr $name, 0, 1)) == -1;
+ return if (index q{-:}, (substr $name, 0, 1)) == -1;
return substr $name, 1;
}
@@ -400,7 +400,11 @@
my $prefix = (delete $merge{-prefix}) || '';
my $suffix = (delete $merge{-suffix}) || '';
- if (Params::Util::_CODELIKE($groups[$i][1])) {
+ if (
+ Params::Util::_CODELIKE($groups[$i][1]) ## no critic Private
+ or
+ Params::Util::_SCALAR0($groups[$i][1]) ## no critic Private
+ ) {
# this entry was build by a group generator
$groups[$i][0] = $prefix . $groups[$i][0] . $suffix;
} else {
@@ -443,8 +447,24 @@
my $exports = $config->{groups}{$group_name};
- if (Params::Util::_CODELIKE($exports)) {
- my $group = $exports->($class, $group_name, $group_arg, $collection);
+ if (
+ Params::Util::_CODELIKE($exports) ## no critic Private
+ or
+ Params::Util::_SCALAR0($exports) ## no critic Private
+ ) {
+ # I'm not very happy with this code for hiding -prefix and -suffix, but
+ # it's needed, and I'm not sure, offhand, how to make it better.
+ # -- rjbs, 2006-12-05
+ my $group_arg = $group_arg ? { %$group_arg } : {};
+ delete $group_arg->{-prefix};
+ delete $group_arg->{-suffix};
+
+ my $group;
+ if (Params::Util::_CODELIKE($exports)) {
+ $group = $exports->($class, $group_name, $group_arg, $collection);
+ } else {
+ $group = $class->$$exports($group_name, $group_arg, $collection);
+ }
Carp::croak qq(group generator "$group_name" did not return a hashref)
if ref $group ne 'HASH';
my $stuff = [ map { [ $_ => $group->{$_} ] } keys %$group ];
@@ -490,8 +510,12 @@
into => $into,
};
- Carp::croak "collection $name failed validation"
- unless $hook->($value, $arg);
+ my $error_msg = "collection $name failed validation";
+ if (Params::Util::_SCALAR0($hook)) {
+ Carp::croak $error_msg unless $class->$$hook($value, $arg);
+ } else {
+ Carp::croak $error_msg unless $hook->($value, $arg);
+ }
}
}
@@ -585,16 +609,27 @@
Carp::croak q(into and into_level may not both be supplied to exporter)
if exists $config->{into} and exists $config->{into_level};
- $config->{$_} = Data::OptList::mkopt_hash($config->{$_}, $_, 'CODE')
- for qw(exports collectors);
+ for (qw(exports collectors)) {
+ $config->{$_} = Data::OptList::mkopt_hash(
+ $config->{$_},
+ $_,
+ [ 'CODE', 'SCALAR' ],
+ );
+ }
if (my @names = _key_intersection(@$config{qw(exports collectors)})) {
Carp::croak "names (@names) used in both collections and exports";
}
- $config->{groups}
- = Data::OptList::mkopt_hash(
- $config->{groups}, 'groups', [ 'HASH', 'CODE', 'ARRAY' ]
+ $config->{groups} = Data::OptList::mkopt_hash(
+ $config->{groups},
+ 'groups',
+ [
+ 'HASH', # standard opt list
+ 'ARRAY', # standard opt list
+ 'CODE', # group generator
+ 'SCALAR', # name of group generation method
+ ]
);
# by default, export nothing
@@ -652,7 +687,7 @@
my ($generator, $as);
- if ($arg and Params::Util::_CODELIKE($arg)) {
+ if ($arg and Params::Util::_CODELIKE($arg)) { ## no critic
# This is the case when a group generator has inserted name/code pairs.
$generator = sub { $arg };
$as = $name;
@@ -715,12 +750,17 @@
sub _generate {
my ($class, $generator, $name, $arg, $collection) = @_;
- # I considered making the T case, below, "$class->$generator(" but it seems
- # that overloading precedence would turn an overloaded-as-code generator
- # object into a string before code. -- rjbs, 2006-06-11
- my $code = $generator
- ? $generator->($class, $name, $arg, $collection)
- : $class->can($name);
+ return $class->can($name) unless $generator;
+
+ # I considered making this "$class->$generator(" but it seems that
+ # overloading precedence would turn an overloaded-as-code generator object
+ # into a string before code. -- rjbs, 2006-06-11
+ return $generator->($class, $name, $arg, $collection)
+ if Params::Util::_CODELIKE($generator);
+
+ # This "must" be a scalar reference, to a generator method name.
+ # -- rjbs, 2006-12-05
+ return $class->$$generator($name, $arg, $collection);
}
sub _install {
@@ -800,8 +840,8 @@
possible with Exporter.
When using a module that uses Sub::Exporter, users familiar with Exporter will
-probably see difference in the basics. These two lines do about the same thing
-in whether the exporting module uses Exporter or Sub::Exporter.
+probably see no difference in the basics. These two lines do about the same
+thing in whether the exporting module uses Exporter or Sub::Exporter.
use Some::Module qw(foo bar baz);
use Some::Module qw(foo :bar baz);
Modified: packages/libsub-exporter-perl/trunk/lib/Sub/Exporter/Tutorial.pod
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/lib/Sub/Exporter/Tutorial.pod?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/lib/Sub/Exporter/Tutorial.pod (original)
+++ packages/libsub-exporter-perl/trunk/lib/Sub/Exporter/Tutorial.pod Fri Dec 8 11:20:11 2006
@@ -5,7 +5,7 @@
=head1 VERSION
- $Id: /my/cs/projects/export/trunk/lib/Sub/Exporter/Tutorial.pod 22376 2006-06-11T15:02:24.373468Z rjbs $
+ $Id: /my/cs/projects/export/trunk/lib/Sub/Exporter/Tutorial.pod 1425 2006-08-14T17:02:44.651525Z rjbs $
=head1 DESCRIPTION
Modified: packages/libsub-exporter-perl/trunk/lib/Sub/Exporter/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/lib/Sub/Exporter/Util.pm?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/lib/Sub/Exporter/Util.pm (original)
+++ packages/libsub-exporter-perl/trunk/lib/Sub/Exporter/Util.pm Fri Dec 8 11:20:11 2006
@@ -9,13 +9,13 @@
=head1 VERSION
-version 0.020
-
- $Id$
-
-=cut
-
-our $VERSION = '0.020';
+version 0.022
+
+ $Id: /my/cs/projects/export/trunk/lib/Sub/Exporter/Util.pm 28839 2006-12-05T21:48:53.932621Z rjbs $
+
+=cut
+
+our $VERSION = '0.022';
=head1 DESCRIPTION
@@ -128,10 +128,10 @@
base => "$class\:\:__mixin__",
});
+ ## no critic (ProhibitNoStrict)
no strict 'refs';
if (ref $mix_into) {
- $mix_into = ref $mix_into if ref $mix_into;
- unshift @{"$mixin_class" . "::ISA"}, $mix_into;
+ unshift @{"$mixin_class" . "::ISA"}, ref $mix_into;
} else {
unshift @{"$mix_into" . "::ISA"}, $mixin_class;
}
Modified: packages/libsub-exporter-perl/trunk/t/collection.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/t/collection.t?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/t/collection.t (original)
+++ packages/libsub-exporter-perl/trunk/t/collection.t Fri Dec 8 11:20:11 2006
@@ -8,10 +8,15 @@
=cut
-use Test::More tests => 5;
+use Test::More tests => 7;
use Data::OptList qw(mkopt_hash);
BEGIN { use_ok('Sub::Exporter'); }
+
+sub is_defined {
+ my ($class, $value, $arg) = @_;
+ return defined $value;
+}
my $config = {
exports => [
@@ -27,8 +32,10 @@
},
collectors => [
'defaults',
- 'brand_preference' => sub { 0 },
- 'model_preference' => sub { 1 },
+ brand_preference => sub { 0 },
+ model_preference => sub { 1 },
+ definedp => \'is_defined',
+
]
};
@@ -39,6 +46,7 @@
my $collection = Sub::Exporter::_collect_collections(
$config,
[ [ circsaw => undef ], [ defaults => { foo => 1, bar => 2 } ] ],
+ 'main',
);
is_deeply(
@@ -51,7 +59,7 @@
{
my $arg = [ [ defaults => [ 1 ] ], [ defaults => { foo => 1, bar => 2 } ] ];
- eval { Sub::Exporter::_collect_collections($config, $arg); };
+ eval { Sub::Exporter::_collect_collections($config, $arg, 'main'); };
like(
$@,
qr/collection \S+ provided multiple/,
@@ -62,7 +70,7 @@
{
# because the brand_preference validator always fails, this should die
my $arg = [ [ brand_preference => [ 1, 2, 3 ] ] ];
- eval { Sub::Exporter::_collect_collections($config, $arg) };
+ eval { Sub::Exporter::_collect_collections($config, $arg, 'main') };
like(
$@,
qr/brand_preference failed validation/,
@@ -71,8 +79,30 @@
}
{
+ # the definedp collector should require a defined value; this should be ok
+ my $arg = [ [ definedp => {} ] ];
+ my $collection = Sub::Exporter::_collect_collections($config, $arg, 'main');
+ is_deeply(
+ $collection,
+ { definedp => {} },
+ "collector validator allows collection"
+ );
+}
+
+{
+ # the definedp collector should require a defined value; this should die
+ my $arg = [ [ definedp => undef ] ];
+ eval { Sub::Exporter::_collect_collections($config, $arg, 'main') };
+ like(
+ $@,
+ qr/definedp failed validation/,
+ "collector validator prevents bad export"
+ );
+}
+
+{
my $arg = [ [ model_preference => [ 1, 2, 3 ] ] ];
- my $collection = Sub::Exporter::_collect_collections($config, $arg);
+ my $collection = Sub::Exporter::_collect_collections($config, $arg, 'main');
is_deeply(
$collection,
{ model_preference => [ 1, 2, 3 ] },
Modified: packages/libsub-exporter-perl/trunk/t/lib/Test/SubExporter/GroupGen.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/t/lib/Test/SubExporter/GroupGen.pm?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/t/lib/Test/SubExporter/GroupGen.pm (original)
+++ packages/libsub-exporter-perl/trunk/t/lib/Test/SubExporter/GroupGen.pm Fri Dec 8 11:20:11 2006
@@ -25,11 +25,29 @@
};
};
+sub gen_group_by_name {
+ my ($class, $group, $arg, $collection) = @_;
+
+ my %given = (
+ class => $class,
+ group => $group,
+ arg => $arg,
+ collection => $collection,
+ );
+
+ return {
+ baz => sub { return { name => 'baz', %given }; },
+ };
+}
+
my $config = {
exports => [ ],
groups => {
alphabet => sub { { a => $alfa, b => $bravo } },
generated => $returner,
+ # symbolic => \&gen_group_by_name,
+ # symbolic => sub { shift->gen_group_by_name(@_) },
+ symbolic => \'gen_group_by_name',
},
collectors => [ 'col1' ],
};
Modified: packages/libsub-exporter-perl/trunk/t/lib/Test/SubExporter/s_e.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/t/lib/Test/SubExporter/s_e.pm?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/t/lib/Test/SubExporter/s_e.pm (original)
+++ packages/libsub-exporter-perl/trunk/t/lib/Test/SubExporter/s_e.pm Fri Dec 8 11:20:11 2006
@@ -10,6 +10,7 @@
exports => {
xyzzy => undef,
hello_sailor => \&_hs_gen,
+ hi_sailor => \"_hs_gen",
},
groups => {
default => [ qw(xyzzy hello_sailor) ],
Modified: packages/libsub-exporter-perl/trunk/t/real-export-groupgen.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/t/real-export-groupgen.t?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/t/real-export-groupgen.t (original)
+++ packages/libsub-exporter-perl/trunk/t/real-export-groupgen.t Fri Dec 8 11:20:11 2006
@@ -9,27 +9,76 @@
=cut
-use Test::More tests => 3;
+use Test::More tests => 8;
use lib 't/lib';
+use Carp;
+
BEGIN {
+ local $SIG{__DIE__} = sub { Carp::confess @_ };
use_ok('Test::SubExporter::GroupGen');
Test::SubExporter::GroupGen->import(
- -generated => { xyz => 1 }, col1 => { value => 2 }
+ col1 => { value => 2 },
+ -generated => { xyz => 1 },
+ -generated => { xyz => 5, -prefix => 'five_' },
+ -symbolic => { xyz => 2 },
+ );
+
+ use_ok('Test::SubExporter::GroupGenSubclass');
+ Test::SubExporter::GroupGenSubclass->import(
+ col1 => { value => 3 },
+ -symbolic => { -prefix => 'subclass_', xyz => 4 },
);
}
-for (qw(foo bar)) {
+for my $routine (qw(foo bar)) {
is_deeply(
- main->$_(),
+ main->$routine(),
{
- name => $_,
+ name => $routine,
class => 'Test::SubExporter::GroupGen',
group => 'generated',
arg => { xyz => 1 },
collection => { col1 => { value => 2 } },
},
- "generated foo does what we expect",
+ "generated $routine does what we expect",
+ );
+
+ my $five = "five_$routine";
+ is_deeply(
+ main->$five(),
+ {
+ name => $routine,
+ class => 'Test::SubExporter::GroupGen',
+ group => 'generated',
+ arg => { xyz => 5 },
+ collection => { col1 => { value => 2 } },
+ },
+ "generated $five does what we expect",
);
}
+
+is_deeply(
+ main->baz(),
+ {
+ name => 'baz',
+ class => 'Test::SubExporter::GroupGen',
+ group => 'symbolic',
+ arg => { xyz => 2 },
+ collection => { col1 => { value => 2 } },
+ },
+ "parent class's generated baz does what we expect",
+);
+
+is_deeply(
+ main->subclass_baz(),
+ {
+ name => 'baz-sc',
+ class => 'Test::SubExporter::GroupGenSubclass',
+ group => 'symbolic',
+ arg => { xyz => 4 },
+ collection => { col1 => { value => 3 } },
+ },
+ "inheriting class's generated baz does what we expect",
+);
Modified: packages/libsub-exporter-perl/trunk/t/real-export-href.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/trunk/t/real-export-href.t?rev=4609&op=diff
==============================================================================
--- packages/libsub-exporter-perl/trunk/t/real-export-href.t (original)
+++ packages/libsub-exporter-perl/trunk/t/real-export-href.t Fri Dec 8 11:20:11 2006
@@ -11,7 +11,7 @@
=cut
-use Test::More tests => 46;
+use Test::More tests => 48;
BEGIN { use_ok('Sub::Exporter'); }
@@ -95,13 +95,23 @@
);
package Test::SubExporter::Z3;
- main::use_ok($exporting_class, hello_sailor => { game => 'zork3' });
- use subs qw(hello_sailor);
+ main::use_ok(
+ $exporting_class,
+ hello_sailor => { game => 'zork3' },
+ hi_sailor => undef,
+ );
+ use subs qw(hello_sailor hi_sailor);
main::is(
hello_sailor,
"Something happens!",
"Z3: custom hello_sailor works as expected"
+ );
+
+ main::is(
+ hi_sailor,
+ "Nothing happens yet.",
+ "Z3: hi_sailor, using symbolic import and no args, works as expected"
);
package Test::SubExporter::FROTZ_SAILOR;
More information about the Pkg-perl-cvs-commits
mailing list