From: Leon Timmermans Date: Mon, 21 Jan 2013 14:48:47 +0000 (+0100) Subject: Rewrite -tag to :tag for Exporter.pm X-Git-Tag: v0.001007~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FSub-Exporter-Progressive.git;a=commitdiff_plain;h=b94ac53ea582dc640649a061e431a7ddb2b64797 Rewrite -tag to :tag for Exporter.pm Tests written by Toby Inkster --- diff --git a/Changes b/Changes index caed30c..15dbcac 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,5 @@ + - Rewrite -tag to :tag for Exporter.pm + 0.001006 - 2012-08-27 - Handle ':all' correctly diff --git a/lib/Sub/Exporter/Progressive.pm b/lib/Sub/Exporter/Progressive.pm index 670402c..f4bed06 100644 --- a/lib/Sub/Exporter/Progressive.pm +++ b/lib/Sub/Exporter/Progressive.pm @@ -23,8 +23,8 @@ sub import { use strict; my ($self, @args) = @_; - if (first { ref || !m/^:?\w+$/ } @args) { - die 'your usage of Sub::Exporter::Progressive requires Sub::Exporter to be installed' + if (first { ref || !m/ \A [:-]? \w+ \z /xm } @args) { + croak 'your usage of Sub::Exporter::Progressive requires Sub::Exporter to be installed' unless eval { require Sub::Exporter }; $full_exporter ||= Sub::Exporter::build_exporter($export_data->{original}); @@ -32,6 +32,8 @@ sub import { goto $full_exporter; } else { require Exporter; + s/ \A - /:/xm for @args; + @_ = ($self, @args); goto \&Exporter::import; } }; diff --git a/t/tags.t b/t/tags.t index a94e706..110bcb3 100644 --- a/t/tags.t +++ b/t/tags.t @@ -1,15 +1,69 @@ use strict; use warnings; -use Test::More 0.89; +use Test::More 0.96; use List::Util 'first'; +use Carp; use lib 't/lib'; use A::Junk ':other'; +BEGIN { + unshift @INC, sub { croak 'Shouldn\'t load Sub::Exporter' if $_[1] eq 'Sub/Exporter.pm' }; +} + ok(!main->can('junk1'), 'junk1 not exported'); ok(!main->can('junk2'), 'junk2 not exported'); ok(main->can('junk3'), 'junk3 exported'); ok(! $INC{'Sub/Exporter.pm'}, 'Sub::Exporter not loaded'); +BEGIN { + package Local::Exporter; + use Sub::Exporter::Progressive -setup => { + exports => [qw/ foo bar baz /], + groups => { + default => [qw/ foo /], + bb => [qw/ bar baz /], + }, + }; + use constant { + foo => 1, + bar => 2, + baz => 3, + }; + $INC{'Local/Exporter.pm'} = __FILE__; +}; + +my $i = 0; +sub check_tag +{ + my ($tag, $should, $shouldnt) = @_; + my $pkg = 'Local::Importer' . ++$i; + subtest "test the '$tag' tag" => sub + { + plan tests => 1 + @$should + @$shouldnt; + local $@ = undef; + + ok(eval qq{ + package $pkg; + use Local::Exporter qw( $tag ); + 1; + }, "$pkg compiled") or diag $@; + + ok( $pkg->can($_), "$pkg\->can(\"$_\")") for @$should; + ok(!$pkg->can($_), "$pkg\->can't(\"$_\")") for @$shouldnt; + } +} + +check_tag(':default', [qw/foo/], [qw/bar baz/]); +check_tag('-default', [qw/foo/], [qw/bar baz/]); +check_tag(':default bar', [qw/foo bar/], [qw/baz/]); +check_tag('-default bar', [qw/foo bar/], [qw/baz/]); +check_tag('bar :default', [qw/foo bar/], [qw/baz/]); +check_tag('bar -default', [qw/foo bar/], [qw/baz/]); +check_tag(':bb', [qw/bar baz/], [qw/foo/]); +check_tag('-bb', [qw/bar baz/], [qw/foo/]); +check_tag(':all', [qw/foo bar baz/], []); +check_tag('-all', [qw/foo bar baz/], []); + done_testing;