t/050_metaclasses/012_moose_exporter.t

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