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 BEGIN {
   9     eval "use Test::Output;";
  10     plan skip_all => "Test::Output is required for this test" if $@;
  11 }
  12
  13
  14 {
  15     package HasOwnImmutable;
  16
  17     use Moose;
  18
  19     no Moose;
  20
  21     ::stderr_is( sub { eval q[sub make_immutable { return 'foo' }] },
  22                   '',
  23                   'no warning when defining our own make_immutable sub' );
  24 }
  25
  26 {
  27     is( HasOwnImmutable->make_immutable(), 'foo',
  28         'HasOwnImmutable->make_immutable does not get overwritten' );
  29 }
  30
  31 {
  32     package MooseX::Empty;
  33
  34     use Moose ();
  35     Moose::Exporter->setup_import_methods( also => 'Moose' );
  36 }
  37
  38 {
  39     package WantsMoose;
  40
  41     MooseX::Empty->import();
  42
  43     sub foo { 1 }
  44
  45     ::can_ok( 'WantsMoose', 'has' );
  46     ::can_ok( 'WantsMoose', 'with' );
  47     ::can_ok( 'WantsMoose', 'foo' );
  48
  49     MooseX::Empty->unimport();
  50 }
  51
  52 {
  53     # Note: it's important that these methods be out of scope _now_,
  54     # after unimport was called. We tried a
  55     # namespace::clean(0.08)-based solution, but had to abandon it
  56     # because it cleans the namespace _later_ (when the file scope
  57     # ends).
  58     ok( ! WantsMoose->can('has'),  'WantsMoose::has() has been cleaned' );
  59     ok( ! WantsMoose->can('with'), 'WantsMoose::with() has been cleaned' );
  60     can_ok( 'WantsMoose', 'foo' );
  61
  62     # This makes sure that Moose->init_meta() happens properly
  63     isa_ok( WantsMoose->meta(), 'Moose::Meta::Class' );
  64     isa_ok( WantsMoose->new(), 'Moose::Object' );
  65
  66 }
  67
  68 {
  69     package MooseX::Sugar;
  70
  71     use Moose ();
  72
  73     sub wrapped1 {
  74         my $meta = shift;
  75         return $meta->name . ' called wrapped1';
  76     }
  77
  78     Moose::Exporter->setup_import_methods(
  79         with_meta => ['wrapped1'],
  80         also      => 'Moose',
  81     );
  82 }
  83
  84 {
  85     package WantsSugar;
  86
  87     MooseX::Sugar->import();
  88
  89     sub foo { 1 }
  90
  91     ::can_ok( 'WantsSugar', 'has' );
  92     ::can_ok( 'WantsSugar', 'with' );
  93     ::can_ok( 'WantsSugar', 'wrapped1' );
  94     ::can_ok( 'WantsSugar', 'foo' );
  95     ::is( wrapped1(), 'WantsSugar called wrapped1',
  96           'wrapped1 identifies the caller correctly' );
  97
  98     MooseX::Sugar->unimport();
  99 }
 100
 101 {
 102     ok( ! WantsSugar->can('has'),  'WantsSugar::has() has been cleaned' );
 103     ok( ! WantsSugar->can('with'), 'WantsSugar::with() has been cleaned' );
 104     ok( ! WantsSugar->can('wrapped1'), 'WantsSugar::wrapped1() has been cleaned' );
 105     can_ok( 'WantsSugar', 'foo' );
 106 }
 107
 108 {
 109     package MooseX::MoreSugar;
 110
 111     use Moose ();
 112
 113     sub wrapped2 {
 114         my $caller = shift;
 115         return $caller . ' called wrapped2';
 116     }
 117
 118     sub as_is1 {
 119         return 'as_is1';
 120     }
 121
 122     Moose::Exporter->setup_import_methods(
 123         with_caller => ['wrapped2'],
 124         as_is       => ['as_is1'],
 125         also        => 'MooseX::Sugar',
 126     );
 127 }
 128
 129 {
 130     package WantsMoreSugar;
 131
 132     MooseX::MoreSugar->import();
 133
 134     sub foo { 1 }
 135
 136     ::can_ok( 'WantsMoreSugar', 'has' );
 137     ::can_ok( 'WantsMoreSugar', 'with' );
 138     ::can_ok( 'WantsMoreSugar', 'wrapped1' );
 139     ::can_ok( 'WantsMoreSugar', 'wrapped2' );
 140     ::can_ok( 'WantsMoreSugar', 'as_is1' );
 141     ::can_ok( 'WantsMoreSugar', 'foo' );
 142     ::is( wrapped1(), 'WantsMoreSugar called wrapped1',
 143           'wrapped1 identifies the caller correctly' );
 144     ::is( wrapped2(), 'WantsMoreSugar called wrapped2',
 145           'wrapped2 identifies the caller correctly' );
 146     ::is( as_is1(), 'as_is1',
 147           'as_is1 works as expected' );
 148
 149     MooseX::MoreSugar->unimport();
 150 }
 151
 152 {
 153     ok( ! WantsMoreSugar->can('has'),  'WantsMoreSugar::has() has been cleaned' );
 154     ok( ! WantsMoreSugar->can('with'), 'WantsMoreSugar::with() has been cleaned' );
 155     ok( ! WantsMoreSugar->can('wrapped1'), 'WantsMoreSugar::wrapped1() has been cleaned' );
 156     ok( ! WantsMoreSugar->can('wrapped2'), 'WantsMoreSugar::wrapped2() has been cleaned' );
 157     ok( ! WantsMoreSugar->can('as_is1'), 'WantsMoreSugar::as_is1() has been cleaned' );
 158     can_ok( 'WantsMoreSugar', 'foo' );
 159 }
 160
 161 {
 162     package My::Metaclass;
 163     use Moose;
 164     BEGIN { extends 'Moose::Meta::Class' }
 165
 166     package My::Object;
 167     use Moose;
 168     BEGIN { extends 'Moose::Object' }
 169
 170     package HasInitMeta;
 171
 172     use Moose ();
 173
 174     sub init_meta {
 175         shift;
 176         return Moose->init_meta( @_,
 177                                  metaclass  => 'My::Metaclass',
 178                                  base_class => 'My::Object',
 179                                );
 180     }
 181
 182     Moose::Exporter->setup_import_methods( also => 'Moose' );
 183 }
 184
 185 {
 186     package NewMeta;
 187
 188     HasInitMeta->import();
 189 }
 190
 191 {
 192     isa_ok( NewMeta->meta(), 'My::Metaclass' );
 193     isa_ok( NewMeta->new(), 'My::Object' );
 194 }
 195
 196 {
 197     package MooseX::CircularAlso;
 198
 199     use Moose ();
 200
 201     ::dies_ok(
 202         sub {
 203             Moose::Exporter->setup_import_methods(
 204                 also => [ 'Moose', 'MooseX::CircularAlso' ],
 205             );
 206         },
 207         'a circular reference in also dies with an error'
 208     );
 209
 210     ::like(
 211         $@,
 212         qr/\QCircular reference in 'also' parameter to Moose::Exporter between MooseX::CircularAlso and MooseX::CircularAlso/,
 213         'got the expected error from circular reference in also'
 214     );
 215 }
 216
 217 {
 218     package MooseX::NoAlso;
 219
 220     use Moose ();
 221
 222     ::dies_ok(
 223         sub {
 224             Moose::Exporter->setup_import_methods(
 225                 also => [ 'NoSuchThing' ],
 226             );
 227         },
 228         'a package which does not use Moose::Exporter in also dies with an error'
 229     );
 230
 231     ::like(
 232         $@,
 233         qr/\QPackage in also (NoSuchThing) does not seem to use Moose::Exporter (is it loaded?) at /,
 234         'got the expected error from a reference in also to a package which is not loaded'
 235     );
 236 }
 237
 238 {
 239     package MooseX::NotExporter;
 240
 241     use Moose ();
 242
 243     ::dies_ok(
 244         sub {
 245             Moose::Exporter->setup_import_methods(
 246                 also => [ 'Moose::Meta::Method' ],
 247             );
 248         },
 249         'a package which does not use Moose::Exporter in also dies with an error'
 250     );
 251
 252     ::like(
 253         $@,
 254         qr/\QPackage in also (Moose::Meta::Method) does not seem to use Moose::Exporter at /,
 255         'got the expected error from a reference in also to a package which does not use Moose::Exporter'
 256     );
 257 }
 258
 259 {
 260     package MooseX::OverridingSugar;
 261
 262     use Moose ();
 263
 264     sub has {
 265         my $caller = shift;
 266         return $caller . ' called has';
 267     }
 268
 269     Moose::Exporter->setup_import_methods(
 270         with_caller => ['has'],
 271         also        => 'Moose',
 272     );
 273 }
 274
 275 {
 276     package WantsOverridingSugar;
 277
 278     MooseX::OverridingSugar->import();
 279
 280     ::can_ok( 'WantsOverridingSugar', 'has' );
 281     ::can_ok( 'WantsOverridingSugar', 'with' );
 282     ::is( has('foo'), 'WantsOverridingSugar called has',
 283           'has from MooseX::OverridingSugar is called, not has from Moose' );
 284
 285     MooseX::OverridingSugar->unimport();
 286 }
 287
 288 {
 289     ok( ! WantsSugar->can('has'),  'WantsSugar::has() has been cleaned' );
 290     ok( ! WantsSugar->can('with'), 'WantsSugar::with() has been cleaned' );
 291 }
 292
 293 {
 294     package NonExistentExport;
 295
 296     use Moose ();
 297
 298     ::stderr_like {
 299         Moose::Exporter->setup_import_methods(
 300             also => ['Moose'],
 301             with_caller => ['does_not_exist'],
 302         );
 303     } qr/^Trying to export undefined sub NonExistentExport::does_not_exist/,
 304       "warns when a non-existent method is requested to be exported";
 305 }
 306
 307 {
 308     package WantsNonExistentExport;
 309
 310     NonExistentExport->import;
 311
 312     ::ok(!__PACKAGE__->can('does_not_exist'),
 313          "undefined subs do not get exported");
 314 }
 315
 316 {
 317     package AllOptions;
 318     use Moose ();
 319     use Moose::Exporter;
 320
 321     Moose::Exporter->setup_import_methods(
 322         also        => ['Moose'],
 323         with_meta   => [ 'with_meta1', 'with_meta2' ],
 324         with_caller => [ 'with_caller1', 'with_caller2' ],
 325         as_is       => ['as_is1'],
 326     );
 327
 328     sub with_caller1 {
 329         return @_;
 330     }
 331
 332     sub with_caller2 (&) {
 333         return @_;
 334     }
 335
 336     sub as_is1 {2}
 337
 338     sub with_meta1 {
 339         return @_;
 340     }
 341
 342     sub with_meta2 (&) {
 343         return @_;
 344     }
 345 }
 346
 347 {
 348     package UseAllOptions;
 349
 350     AllOptions->import();
 351 }
 352
 353 {
 354     can_ok( 'UseAllOptions', $_ )
 355         for qw( with_meta1 with_meta2 with_caller1 with_caller2 as_is1 );
 356
 357     {
 358         my ( $caller, $arg1 ) = UseAllOptions::with_caller1(42);
 359         is( $caller, 'UseAllOptions', 'with_caller wrapped sub gets the right caller' );
 360         is( $arg1, 42, 'with_caller wrapped sub returns argument it was passed' );
 361     }
 362
 363     {
 364         my ( $meta, $arg1 ) = UseAllOptions::with_meta1(42);
 365         isa_ok( $meta, 'Moose::Meta::Class', 'with_meta first argument' );
 366         is( $arg1, 42, 'with_meta1 returns argument it was passed' );
 367     }
 368
 369     is(
 370         prototype( UseAllOptions->can('with_caller2') ),
 371         prototype( AllOptions->can('with_caller2') ),
 372         'using correct prototype on with_meta function'
 373     );
 374
 375     is(
 376         prototype( UseAllOptions->can('with_meta2') ),
 377         prototype( AllOptions->can('with_meta2') ),
 378         'using correct prototype on with_meta function'
 379     );
 380 }
 381
 382 {
 383     package UseAllOptions;
 384     AllOptions->unimport();
 385 }
 386
 387 {
 388     ok( ! UseAllOptions->can($_), "UseAllOptions::$_ has been unimported" )
 389         for qw( with_meta1 with_meta2 with_caller1 with_caller2 as_is1 );
 390 }
 391
 392 done_testing;