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