t/050_metaclasses/012_moose_exporter.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 38;
   7 use Test::Exception;
   8
   9 # All the BEGIN blocks are necessary to emulate the behavior of
  10 # loading modules via use and the similar compile-time effect of "no
  11 # ..."
  12 {
  13     package MooseX::Empty;
  14
  15     use Moose ();
  16     BEGIN { Moose::Exporter->build_import_methods( also => 'Moose' ); }
  17 }
  18
  19 {
  20     package WantsMoose;
  21
  22     BEGIN { MooseX::Empty->import(); }
  23
  24     sub foo { 1 }
  25
  26     BEGIN {
  27         ::can_ok( 'WantsMoose', 'has' );
  28         ::can_ok( 'WantsMoose', 'with' );
  29         ::can_ok( 'WantsMoose', 'foo' );
  30     }
  31
  32     BEGIN{ MooseX::Empty->unimport();}
  33 }
  34
  35 {
  36     ok( ! WantsMoose->can('has'),  'WantsMoose::has() has been cleaned' );
  37     ok( ! WantsMoose->can('with'), 'WantsMoose::with() has been cleaned' );
  38     can_ok( 'WantsMoose', 'foo' );
  39
  40     # This makes sure that Moose->init_meta() happens properly
  41     isa_ok( WantsMoose->meta(), 'Moose::Meta::Class' );
  42     isa_ok( WantsMoose->new(), 'Moose::Object' );
  43
  44 }
  45
  46 {
  47     package MooseX::Sugar;
  48
  49     use Moose ();
  50
  51     sub wrapped1 {
  52         my $caller = shift;
  53         return $caller . ' called wrapped1';
  54     }
  55
  56     BEGIN {
  57         Moose::Exporter->build_import_methods(
  58             with_caller => ['wrapped1'],
  59             also        => 'Moose',
  60         );
  61     }
  62 }
  63
  64 {
  65     package WantsSugar;
  66
  67     BEGIN { MooseX::Sugar->import() }
  68
  69     sub foo { 1 }
  70
  71     BEGIN {
  72         ::can_ok( 'WantsSugar', 'has' );
  73         ::can_ok( 'WantsSugar', 'with' );
  74         ::can_ok( 'WantsSugar', 'wrapped1' );
  75         ::can_ok( 'WantsSugar', 'foo' );
  76         ::is( wrapped1(), 'WantsSugar called wrapped1',
  77               'wrapped1 identifies the caller correctly' );
  78     }
  79
  80     BEGIN{ MooseX::Sugar->unimport();}
  81 }
  82
  83 {
  84     ok( ! WantsSugar->can('has'),  'WantsSugar::has() has been cleaned' );
  85     ok( ! WantsSugar->can('with'), 'WantsSugar::with() has been cleaned' );
  86     ok( ! WantsSugar->can('wrapped1'), 'WantsSugar::wrapped1() has been cleaned' );
  87     can_ok( 'WantsSugar', 'foo' );
  88 }
  89
  90 {
  91     package MooseX::MoreSugar;
  92
  93     use Moose ();
  94
  95     sub wrapped2 {
  96         my $caller = shift;
  97         return $caller . ' called wrapped2';
  98     }
  99
 100     sub as_is1 {
 101         return 'as_is1';
 102     }
 103
 104     BEGIN {
 105         Moose::Exporter->build_import_methods(
 106             with_caller => ['wrapped2'],
 107             as_is       => ['as_is1'],
 108             also        => 'MooseX::Sugar',
 109         );
 110     }
 111 }
 112
 113 {
 114     package WantsMoreSugar;
 115
 116     BEGIN { MooseX::MoreSugar->import() }
 117
 118     sub foo { 1 }
 119
 120     BEGIN {
 121         ::can_ok( 'WantsMoreSugar', 'has' );
 122         ::can_ok( 'WantsMoreSugar', 'with' );
 123         ::can_ok( 'WantsMoreSugar', 'wrapped1' );
 124         ::can_ok( 'WantsMoreSugar', 'wrapped2' );
 125         ::can_ok( 'WantsMoreSugar', 'as_is1' );
 126         ::can_ok( 'WantsMoreSugar', 'foo' );
 127         ::is( wrapped1(), 'WantsMoreSugar called wrapped1',
 128               'wrapped1 identifies the caller correctly' );
 129         ::is( wrapped2(), 'WantsMoreSugar called wrapped2',
 130               'wrapped2 identifies the caller correctly' );
 131         ::is( as_is1(), 'as_is1',
 132               'as_is1 works as expected' );
 133     }
 134
 135     BEGIN{ MooseX::MoreSugar->unimport();}
 136 }
 137
 138 {
 139     ok( ! WantsMoreSugar->can('has'),  'WantsMoreSugar::has() has been cleaned' );
 140     ok( ! WantsMoreSugar->can('with'), 'WantsMoreSugar::with() has been cleaned' );
 141     ok( ! WantsMoreSugar->can('wrapped1'), 'WantsMoreSugar::wrapped1() has been cleaned' );
 142     ok( ! WantsMoreSugar->can('wrapped2'), 'WantsMoreSugar::wrapped2() has been cleaned' );
 143     ok( ! WantsMoreSugar->can('as_is1'), 'WantsMoreSugar::as_is1() has been cleaned' );
 144     can_ok( 'WantsMoreSugar', 'foo' );
 145 }
 146
 147 {
 148     package My::Metaclass;
 149     use Moose;
 150     BEGIN { extends 'Moose::Meta::Class' }
 151
 152     package My::Object;
 153     use Moose;
 154     BEGIN { extends 'Moose::Object' }
 155
 156     package HasInitMeta;
 157
 158     use Moose ();
 159
 160     sub init_meta {
 161         shift;
 162         return Moose->init_meta( @_,
 163                                  metaclass  => 'My::Metaclass',
 164                                  base_class => 'My::Object',
 165                                );
 166     }
 167
 168     BEGIN { Moose::Exporter->build_import_methods( also => 'Moose' ); }
 169 }
 170
 171 {
 172     package NewMeta;
 173
 174     BEGIN { HasInitMeta->import() }
 175 }
 176
 177 {
 178     isa_ok( NewMeta->meta(), 'My::Metaclass' );
 179     isa_ok( NewMeta->new(), 'My::Object' );
 180 }
 181
 182 {
 183     package MooseX::CircularAlso;
 184
 185     use Moose ();
 186
 187     ::dies_ok(
 188         sub {
 189             Moose::Exporter->build_import_methods(
 190                 also => [ 'Moose', 'MooseX::CircularAlso' ],
 191             );
 192         },
 193         'a circular reference in also dies with an error'
 194     );
 195
 196     ::like(
 197         $@,
 198         qr/\QCircular reference in also parameter to MooseX::Exporter between MooseX::CircularAlso and MooseX::CircularAlso/,
 199         'got the expected error from circular reference in also'
 200     );
 201 }
 202
 203 {
 204     package MooseX::CircularAlso;
 205
 206     use Moose ();
 207
 208     ::dies_ok(
 209         sub {
 210             Moose::Exporter->build_import_methods(
 211                 also => [ 'NoSuchThing' ],
 212             );
 213         },
 214         'a package which does not use Moose::Exporter in also dies with an error'
 215     );
 216
 217     ::like(
 218         $@,
 219         qr/\QPackage in also (NoSuchThing) does not seem to use MooseX::Exporter/,
 220         'got the expected error from a reference in also to a package which does not use Moose::Exporter'
 221     );
 222 }