From: Leon Timmermans <fawaka@gmail.com>
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?a=commitdiff_plain;h=b94ac53ea582dc640649a061e431a7ddb2b64797;p=p5sagit%2FSub-Exporter-Progressive.git

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;