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