t/050_metaclasses/024_moose_exporter_groups.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 45;
   7 use Test::Exception;
   8
   9 {
  10
  11     package ExGroups1;
  12     use Moose::Exporter;
  13     use Moose ();
  14
  15     Moose::Exporter->setup_import_methods(
  16         also        => ['Moose'],
  17         with_meta   => ['with_meta1'],
  18         with_caller => ['default_export1'],
  19         as_is       => ['default_export2'],
  20         groups      => {
  21             all_group => [':all'],
  22             just_one  => ['default_export1']
  23         }
  24     );
  25
  26     sub default_export1 {1}
  27     sub default_export2 {2}
  28
  29     sub with_meta1 (&) {
  30         my ( $meta, $code ) = @_;
  31         return $meta;
  32     }
  33 }
  34
  35 {
  36
  37     package UseAllGroup;
  38
  39     ExGroups1->import(':all_group');
  40
  41     ::can_ok( __PACKAGE__, 'with_meta1' );
  42     ::can_ok( __PACKAGE__, 'default_export1' );
  43     ::can_ok( __PACKAGE__, 'default_export2' );
  44     ::can_ok( __PACKAGE__, 'has' );
  45
  46     my $meta;
  47     eval q/$meta = with_meta1 { return 'coderef'; }/;
  48     ::is( $@, '', 'calling with_meta1 with prototype is not an error' );
  49     ::isa_ok( $meta, 'Moose::Meta::Class', 'with_meta first argument' );
  50     ::is(
  51         prototype( __PACKAGE__->can('with_meta1') ),
  52         prototype( ExGroups1->can('with_meta1') ),
  53         'using correct prototype on with_meta function'
  54     );
  55
  56     ExGroups1->unimport();
  57
  58     ::ok( !__PACKAGE__->can('with_meta1'),
  59         __PACKAGE__ . '::with_meta1() has been cleaned' );
  60     ::ok( !__PACKAGE__->can('default_export1'),
  61         __PACKAGE__ . '::default_export1() has been cleaned' );
  62     ::ok( !__PACKAGE__->can('default_export2'),
  63         __PACKAGE__ . '::default_export2() has been cleaned' );
  64     ::ok( !__PACKAGE__->can('has'),
  65         __PACKAGE__ . '::has() has been cleaned' );
  66 }
  67
  68 {
  69
  70     package UseJustOne;
  71
  72     ExGroups1->import(':just_one');
  73
  74     ::can_ok( __PACKAGE__, 'default_export1' );
  75     ::ok( !__PACKAGE__->can('default_export2'),
  76         __PACKAGE__ . '::default_export2() was not imported' );
  77     ::ok( !__PACKAGE__->can('has'),
  78         __PACKAGE__ . '::has() was not imported' );
  79
  80     ExGroups1->unimport();
  81
  82     ::ok( !__PACKAGE__->can('default_export1'),
  83         __PACKAGE__ . '::default_export1() has been cleared' );
  84 }
  85
  86 {
  87
  88     package ExGroups2;
  89     use Moose::Exporter;
  90
  91     Moose::Exporter->setup_import_methods(
  92         also        => ['ExGroups1'],
  93         as_is       => ['exgroups2_as_is'],
  94         with_caller => ['exgroups2_with_caller'],
  95         groups      => {
  96             default    => ['exgroups2_as_is'],
  97             code_group => \&generate_group,
  98             parent1    => [qw(:ExGroups1 :code_group)],
  99             parent2    => [qw(:all)]
 100         }
 101     );
 102
 103     sub exgroups2_as_is {3}
 104
 105     sub generate_group {
 106         my ( $caller, $group_name, $args, $context ) = @_;
 107
 108         ::is( $group_name, 'code_group',
 109             'original name is passed to group code' );
 110         ::is( $args->{install_as}, $caller . '_code',
 111             'group code arguments match caller' );
 112         ::is( $context->{from}, __PACKAGE__,
 113             'defined package name is passed to group code' );
 114
 115         return { $args->{install_as} => \&exported_by_group };
 116     }
 117
 118     sub exported_by_group (&) {
 119         my ( $caller, $coderef ) = @_;
 120         return $caller;
 121     }
 122 }
 123
 124 {
 125
 126     package UseDefault;
 127
 128     ExGroups2->import;
 129
 130     ::can_ok( __PACKAGE__, 'exgroups2_as_is' );
 131     ::ok( !__PACKAGE__->can('exgroups2_with_caller'),
 132         '"default" group is no longer "all"' );
 133 }
 134
 135 {
 136
 137     package UseCodeGroup;
 138
 139     ExGroups2->import( ':code_group',
 140         { install_as => ( my $export_name = __PACKAGE__ . '_code' ) } );
 141
 142     ::can_ok( __PACKAGE__, $export_name );
 143     ::ok( &UseCodeGroup_code() eq __PACKAGE__,
 144         'code group exports act like "with_caller" subs' );
 145     ::lives_ok(
 146         sub {
 147             UseCodeCodeGroup_code { return 'code block'; };
 148         },
 149         'code group exports keep their prototypes'
 150     );
 151
 152     ::ok( !__PACKAGE__->can('exgroups2_as_is'),
 153         'code group will not automatically export any symbols' );
 154
 155     ExGroups2->unimport;
 156
 157     ::ok(
 158         !__PACKAGE__->can($export_name),
 159         'dynamically-named '
 160             . __PACKAGE__
 161             . "::$export_name() has been cleared"
 162     );
 163 }
 164
 165 {
 166
 167     package UseParent1;
 168
 169     ExGroups2->import( ':parent1',
 170         { install_as => ( my $export_name = __PACKAGE__ . '_code' ) } );
 171
 172     ::can_ok( __PACKAGE__, $export_name );
 173     ::can_ok( __PACKAGE__, 'default_export1' );
 174     ::can_ok( __PACKAGE__, 'default_export2' );
 175     ::can_ok( __PACKAGE__, 'has' );
 176
 177     ExGroups2->unimport;
 178
 179     ::ok( !__PACKAGE__->can($export_name),
 180         __PACKAGE__ . "::$export_name() has been cleared" );
 181     ::ok( !__PACKAGE__->can('default_export1'),
 182         __PACKAGE__ . '::default_export1() has been cleaned' );
 183     ::ok( !__PACKAGE__->can('default_export2'),
 184         __PACKAGE__ . '::default_export2() has been cleaned' );
 185     ::ok( !__PACKAGE__->can('has'),
 186         __PACKAGE__ . '::has() has been cleaned' );
 187 }
 188
 189 {
 190
 191     package UseParent2;
 192
 193     ExGroups2->import( ':parent2',
 194         { install_as => ( my $export_name = __PACKAGE__ . '_code' ) } );
 195
 196     ::ok( !__PACKAGE__->can($export_name),
 197         '"all" group will not call code groups' );
 198     ::can_ok( __PACKAGE__, 'exgroups2_as_is' );
 199     ::can_ok( __PACKAGE__, 'exgroups2_with_caller' );
 200     ::can_ok( __PACKAGE__, 'default_export1' );
 201     ::can_ok( __PACKAGE__, 'has' );
 202
 203     ExGroups2->unimport;
 204
 205     ::ok( !__PACKAGE__->can('exgroups2_as_is'),
 206         __PACKAGE__ . '::exgroups2_as_is() has been cleaned' );
 207     ::ok( !__PACKAGE__->can('exgroups2_with_caller'),
 208         __PACKAGE__ . '::exgroups2_with_caller() has been cleaned' );
 209     ::ok( !__PACKAGE__->can('default_export1'),
 210         __PACKAGE__ . '::default_export1() has been cleaned' );
 211     ::ok( !__PACKAGE__->can('has'),
 212         __PACKAGE__ . '::has() has been cleaned' );
 213 }