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 generate_group {
  89         my ($caller, $group_name, $args, $context) = @_;
  90
  91         ::is($group_name, 'code_group', 'original name is passed to group code');
  92         ::is($args->{install_as}, $caller . '_code', 'group code arguments match caller');
  93         ::is($context->{from}, __PACKAGE__, 'defined package name is passed to group code');
  94
  95         return { $args->{install_as} => \&exported_by_group };
  96     }
  97
  98     sub exported_by_group (&) {
  99         my ($caller, $coderef) = @_;
 100         return $caller;
 101     }
 102 }
 103
 104 {
 105     package UseDefault;
 106
 107     ExGroups2->import;
 108
 109     ::can_ok( __PACKAGE__, 'exgroups2_as_is' );
 110     ::ok( ! __PACKAGE__->can('exgroups2_with_caller'), '"default" group is no longer "all"' );
 111 }
 112
 113 {
 114     package UseCodeGroup;
 115
 116     ExGroups2->import(':code_group', { install_as => (my $export_name = __PACKAGE__.'_code') });
 117
 118     ::can_ok( __PACKAGE__, $export_name );
 119     ::ok( &UseCodeGroup_code() eq __PACKAGE__, 'code group exports act like "with_caller" subs' );
 120     ::lives_ok(sub { UseCodeCodeGroup_code { return 'code block'; } }, 'code group exports keep their prototypes');
 121
 122     ::ok( ! __PACKAGE__->can('exgroups2_as_is'), 'code group will not automatically export any symbols' );
 123
 124     ExGroups2->unimport;
 125
 126     ::ok( ! __PACKAGE__->can($export_name),
 127         'dynamically-named '. __PACKAGE__."::$export_name() has been cleared" );
 128 }
 129
 130 {
 131     package UseParent1;
 132
 133     ExGroups2->import(':parent1', { install_as => (my $export_name = __PACKAGE__.'_code') });
 134
 135     ::can_ok( __PACKAGE__, $export_name );
 136     ::can_ok( __PACKAGE__, 'default_export1' );
 137     ::can_ok( __PACKAGE__, 'default_export2' );
 138     ::can_ok( __PACKAGE__, 'has' );
 139
 140     ExGroups2->unimport;
 141
 142     ::ok( ! __PACKAGE__->can($export_name), __PACKAGE__."::$export_name() has been cleared" );
 143     ::ok( ! __PACKAGE__->can('default_export1'), __PACKAGE__.'::default_export1() has been cleaned' );
 144     ::ok( ! __PACKAGE__->can('default_export2'), __PACKAGE__.'::default_export2() has been cleaned' );
 145     ::ok( ! __PACKAGE__->can('has'), __PACKAGE__.'::has() has been cleaned' );
 146 }
 147
 148 {
 149     package UseParent2;
 150
 151     ExGroups2->import(':parent2', { install_as => (my $export_name = __PACKAGE__.'_code') });
 152
 153     ::ok( ! __PACKAGE__->can($export_name), '"all" group will not call code groups' );
 154     ::can_ok( __PACKAGE__, 'exgroups2_as_is' );
 155     ::can_ok( __PACKAGE__, 'exgroups2_with_caller' );
 156     ::can_ok( __PACKAGE__, 'default_export1' );
 157     ::can_ok( __PACKAGE__, 'has' );
 158
 159     ExGroups2->unimport;
 160
 161     ::ok( ! __PACKAGE__->can('exgroups2_as_is'), __PACKAGE__.'::exgroups2_as_is() has been cleaned' );
 162     ::ok( ! __PACKAGE__->can('exgroups2_with_caller'), __PACKAGE__.'::exgroups2_with_caller() has been cleaned' );
 163     ::ok( ! __PACKAGE__->can('default_export1'), __PACKAGE__.'::default_export1() has been cleaned' );
 164     ::ok( ! __PACKAGE__->can('has'), __PACKAGE__.'::has() has been cleaned' );
 165 }
 166