t/tags.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use List::Util 'first';
   6 use Carp;
   7 use lib 't/lib';
   8 use A::Junk ':other';
   9
  10 BEGIN {
  11    unshift @INC, sub { croak 'Shouldn\'t load Sub::Exporter' if $_[1] eq 'Sub/Exporter.pm' };
  12 }
  13
  14 ok(!main->can('junk1'), 'junk1 not exported');
  15 ok(!main->can('junk2'), 'junk2 not exported');
  16 ok(main->can('junk3'), 'junk3 exported');
  17 ok(! $INC{'Sub/Exporter.pm'}, 'Sub::Exporter not loaded');
  18
  19 BEGIN {
  20    package Local::Exporter;
  21    use Sub::Exporter::Progressive -setup => {
  22       exports => [qw/ foo bar baz /],
  23       groups  => {
  24          default => [qw/ foo /],
  25          bb      => [qw/ bar baz /],
  26       },
  27    };
  28    use constant foo => 1;
  29    use constant bar => 2;
  30    use constant baz => 3;
  31
  32    $INC{'Local/Exporter.pm'} = __FILE__;
  33 };
  34
  35 my $i = 0;
  36 sub check_tag {
  37    my ($tag, $should, $shouldnt) = @_;
  38    my $pkg = 'Local::Importer' . ++$i;
  39
  40    ok(eval qq{
  41       package $pkg;
  42       use Local::Exporter qw( $tag );
  43       1;
  44    }, "'$tag' tag: $pkg compiled") or diag $@;
  45
  46    ok( $pkg->can($_), "'$tag' tag: $pkg\->can(\"$_\")") for @$should;
  47    ok(!$pkg->can($_), "'$tag' tag: $pkg\->can't(\"$_\")") for @$shouldnt;
  48 }
  49
  50 check_tag(':default', [qw/foo/], [qw/bar baz/]);
  51 check_tag('-default', [qw/foo/], [qw/bar baz/]);
  52 check_tag(':default bar', [qw/foo bar/], [qw/baz/]);
  53 check_tag('-default bar', [qw/foo bar/], [qw/baz/]);
  54 check_tag(':bb', [qw/bar baz/], [qw/foo/]);
  55 check_tag('-bb', [qw/bar baz/], [qw/foo/]);
  56 check_tag(':all', [qw/foo bar baz/], []);
  57 check_tag('-all', [qw/foo bar baz/], []);
  58
  59 SKIP: {
  60   skip "Your version of Exporter (@{[ Exporter->VERSION ]}) supports "
  61       .'tags only as the first argument to import()', 1
  62     unless eval { Exporter->VERSION('5.58') };
  63
  64   check_tag('bar :default', [qw/foo bar/], [qw/baz/]);
  65   check_tag('bar -default', [qw/foo bar/], [qw/baz/]);
  66 }
  67
  68 done_testing;
  69