t/tags.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More 0.96;
   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 {
  29                 foo => 1,
  30                 bar => 2,
  31                 baz => 3,
  32         };
  33         $INC{'Local/Exporter.pm'} = __FILE__;
  34 };
  35
  36 my $i = 0;
  37 sub check_tag
  38 {
  39         my ($tag, $should, $shouldnt) = @_;
  40         my $pkg = 'Local::Importer' . ++$i;
  41         subtest "test the '$tag' tag" => sub
  42         {
  43                 plan tests => 1 + @$should + @$shouldnt;
  44                 local $@ = undef;
  45
  46                 ok(eval qq{
  47                         package $pkg;
  48                         use Local::Exporter qw( $tag );
  49                         1;
  50                 }, "$pkg compiled") or diag $@;
  51
  52                 ok( $pkg->can($_), "$pkg\->can(\"$_\")") for @$should;
  53                 ok(!$pkg->can($_), "$pkg\->can't(\"$_\")") for @$shouldnt;
  54         }
  55 }
  56
  57 check_tag(':default', [qw/foo/], [qw/bar baz/]);
  58 check_tag('-default', [qw/foo/], [qw/bar baz/]);
  59 check_tag(':default bar', [qw/foo bar/], [qw/baz/]);
  60 check_tag('-default bar', [qw/foo bar/], [qw/baz/]);
  61 check_tag('bar :default', [qw/foo bar/], [qw/baz/]);
  62 check_tag('bar -default', [qw/foo bar/], [qw/baz/]);
  63 check_tag(':bb', [qw/bar baz/], [qw/foo/]);
  64 check_tag('-bb', [qw/bar baz/], [qw/foo/]);
  65 check_tag(':all', [qw/foo bar baz/], []);
  66 check_tag('-all', [qw/foo bar baz/], []);
  67
  68 done_testing;
  69