t/metaclasses/moose_exporter.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Fatal;
   8 use Test::Moose;
   9
  10 use Test::Requires {
  11     'Test::Output' => '0.01', # skip all if not installed
  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->name;
 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_meta => ['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     ::like(
 202         ::exception{ Moose::Exporter->setup_import_methods(
 203                 also => [ 'Moose', 'MooseX::CircularAlso' ],
 204             );
 205             },
 206         qr/\QCircular reference in 'also' parameter to Moose::Exporter between MooseX::CircularAlso and MooseX::CircularAlso/,
 207         'a circular reference in also dies with an error'
 208     );
 209 }
 210
 211 {
 212     package MooseX::NoAlso;
 213
 214     use Moose ();
 215
 216     ::like(
 217         ::exception{ Moose::Exporter->setup_import_methods(
 218                 also => ['NoSuchThing'],
 219             );
 220             },
 221         qr/\QPackage in also (NoSuchThing) does not seem to use Moose::Exporter (is it loaded?) at /,
 222         'a package which does not use Moose::Exporter in also dies with an error'
 223     );
 224 }
 225
 226 {
 227     package MooseX::NotExporter;
 228
 229     use Moose ();
 230
 231     ::like(
 232         ::exception{ Moose::Exporter->setup_import_methods(
 233                 also => ['Moose::Meta::Method'],
 234             );
 235             },
 236         qr/\QPackage in also (Moose::Meta::Method) does not seem to use Moose::Exporter at /,
 237         'a package which does not use Moose::Exporter in also dies with an error'
 238     );
 239 }
 240
 241 {
 242     package MooseX::OverridingSugar;
 243
 244     use Moose ();
 245
 246     sub has {
 247         my $caller = shift->name;
 248         return $caller . ' called has';
 249     }
 250
 251     Moose::Exporter->setup_import_methods(
 252         with_meta => ['has'],
 253         also      => 'Moose',
 254     );
 255 }
 256
 257 {
 258     package WantsOverridingSugar;
 259
 260     MooseX::OverridingSugar->import();
 261
 262     ::can_ok( 'WantsOverridingSugar', 'has' );
 263     ::can_ok( 'WantsOverridingSugar', 'with' );
 264     ::is( has('foo'), 'WantsOverridingSugar called has',
 265           'has from MooseX::OverridingSugar is called, not has from Moose' );
 266
 267     MooseX::OverridingSugar->unimport();
 268 }
 269
 270 {
 271     ok( ! WantsOverridingSugar->can('has'),  'WantsSugar::has() has been cleaned' );
 272     ok( ! WantsOverridingSugar->can('with'), 'WantsSugar::with() has been cleaned' );
 273 }
 274
 275 {
 276     package MooseX::OverridingSugar::PassThru;
 277
 278     sub with {
 279         my $caller = shift->name;
 280         return $caller . ' called with';
 281     }
 282
 283     Moose::Exporter->setup_import_methods(
 284         with_meta => ['with'],
 285         also      => 'MooseX::OverridingSugar',
 286     );
 287 }
 288
 289 {
 290
 291     package WantsOverridingSugar::PassThru;
 292
 293     MooseX::OverridingSugar::PassThru->import();
 294
 295     ::can_ok( 'WantsOverridingSugar::PassThru', 'has' );
 296     ::can_ok( 'WantsOverridingSugar::PassThru', 'with' );
 297     ::is(
 298         has('foo'),
 299         'WantsOverridingSugar::PassThru called has',
 300         'has from MooseX::OverridingSugar is called, not has from Moose'
 301     );
 302
 303     ::is(
 304         with('foo'),
 305         'WantsOverridingSugar::PassThru called with',
 306         'with from MooseX::OverridingSugar::PassThru is called, not has from Moose'
 307     );
 308
 309
 310     MooseX::OverridingSugar::PassThru->unimport();
 311 }
 312
 313 {
 314     ok( ! WantsOverridingSugar::PassThru->can('has'),  'WantsOverridingSugar::PassThru::has() has been cleaned' );
 315     ok( ! WantsOverridingSugar::PassThru->can('with'), 'WantsOverridingSugar::PassThru::with() has been cleaned' );
 316 }
 317
 318 {
 319
 320     package NonExistentExport;
 321
 322     use Moose ();
 323
 324     ::stderr_like {
 325         Moose::Exporter->setup_import_methods(
 326             also => ['Moose'],
 327             with_meta => ['does_not_exist'],
 328         );
 329     } qr/^Trying to export undefined sub NonExistentExport::does_not_exist/,
 330       "warns when a non-existent method is requested to be exported";
 331 }
 332
 333 {
 334     package WantsNonExistentExport;
 335
 336     NonExistentExport->import;
 337
 338     ::ok(!__PACKAGE__->can('does_not_exist'),
 339          "undefined subs do not get exported");
 340 }
 341
 342 {
 343     package AllOptions;
 344     use Moose ();
 345     use Moose::Deprecated -api_version => '0.88';
 346     use Moose::Exporter;
 347
 348     Moose::Exporter->setup_import_methods(
 349         also        => ['Moose'],
 350         with_meta   => [ 'with_meta1', 'with_meta2' ],
 351         with_caller => [ 'with_caller1', 'with_caller2' ],
 352         as_is       => ['as_is1'],
 353     );
 354
 355     sub with_caller1 {
 356         return @_;
 357     }
 358
 359     sub with_caller2 (&) {
 360         return @_;
 361     }
 362
 363     sub as_is1 {2}
 364
 365     sub with_meta1 {
 366         return @_;
 367     }
 368
 369     sub with_meta2 (&) {
 370         return @_;
 371     }
 372 }
 373
 374 {
 375     package UseAllOptions;
 376
 377     AllOptions->import();
 378 }
 379
 380 {
 381     can_ok( 'UseAllOptions', $_ )
 382         for qw( with_meta1 with_meta2 with_caller1 with_caller2 as_is1 );
 383
 384     {
 385         my ( $caller, $arg1 ) = UseAllOptions::with_caller1(42);
 386         is( $caller, 'UseAllOptions', 'with_caller wrapped sub gets the right caller' );
 387         is( $arg1, 42, 'with_caller wrapped sub returns argument it was passed' );
 388     }
 389
 390     {
 391         my ( $meta, $arg1 ) = UseAllOptions::with_meta1(42);
 392         isa_ok( $meta, 'Moose::Meta::Class', 'with_meta first argument' );
 393         is( $arg1, 42, 'with_meta1 returns argument it was passed' );
 394     }
 395
 396     is(
 397         prototype( UseAllOptions->can('with_caller2') ),
 398         prototype( AllOptions->can('with_caller2') ),
 399         'using correct prototype on with_meta function'
 400     );
 401
 402     is(
 403         prototype( UseAllOptions->can('with_meta2') ),
 404         prototype( AllOptions->can('with_meta2') ),
 405         'using correct prototype on with_meta function'
 406     );
 407 }
 408
 409 {
 410     package UseAllOptions;
 411     AllOptions->unimport();
 412 }
 413
 414 {
 415     ok( ! UseAllOptions->can($_), "UseAllOptions::$_ has been unimported" )
 416         for qw( with_meta1 with_meta2 with_caller1 with_caller2 as_is1 );
 417 }
 418
 419 {
 420     package InitMetaError;
 421     use Moose::Exporter;
 422     use Moose ();
 423     Moose::Exporter->setup_import_methods(also => ['Moose']);
 424     sub init_meta {
 425         my $package = shift;
 426         my %options = @_;
 427         Moose->init_meta(%options, metaclass => 'Not::Loaded');
 428     }
 429 }
 430
 431 {
 432     package InitMetaError::Role;
 433     use Moose::Exporter;
 434     use Moose::Role ();
 435     Moose::Exporter->setup_import_methods(also => ['Moose::Role']);
 436     sub init_meta {
 437         my $package = shift;
 438         my %options = @_;
 439         Moose::Role->init_meta(%options, metaclass => 'Not::Loaded');
 440     }
 441 }
 442
 443 {
 444     package WantsInvalidMetaclass;
 445     ::like(
 446         ::exception { InitMetaError->import },
 447         qr/The Metaclass Not::Loaded must be loaded\. \(Perhaps you forgot to 'use Not::Loaded'\?\)/,
 448         "error when wanting a nonexistent metaclass"
 449     );
 450 }
 451
 452 {
 453     package WantsInvalidMetaclass::Role;
 454     ::like(
 455         ::exception { InitMetaError::Role->import },
 456         qr/The Metaclass Not::Loaded must be loaded\. \(Perhaps you forgot to 'use Not::Loaded'\?\)/,
 457         "error when wanting a nonexistent metaclass"
 458     );
 459 }
 460
 461 {
 462     my @init_metas_called;
 463
 464     BEGIN {
 465         package MultiLevelExporter1;
 466         use Moose::Exporter;
 467
 468         sub foo  { 1 }
 469         sub bar  { 1 }
 470         sub baz  { 1 }
 471         sub quux { 1 }
 472
 473         Moose::Exporter->setup_import_methods(
 474             with_meta => [qw(foo bar baz quux)],
 475         );
 476
 477         sub init_meta {
 478             push @init_metas_called, 1;
 479         }
 480
 481         $INC{'MultiLevelExporter1.pm'} = __FILE__;
 482     }
 483
 484     BEGIN {
 485         package MultiLevelExporter2;
 486         use Moose::Exporter;
 487
 488         sub bar  { 2 }
 489         sub baz  { 2 }
 490         sub quux { 2 }
 491
 492         Moose::Exporter->setup_import_methods(
 493             also      => ['MultiLevelExporter1'],
 494             with_meta => [qw(bar baz quux)],
 495         );
 496
 497         sub init_meta {
 498             push @init_metas_called, 2;
 499         }
 500
 501         $INC{'MultiLevelExporter2.pm'} = __FILE__;
 502     }
 503
 504     BEGIN {
 505         package MultiLevelExporter3;
 506         use Moose::Exporter;
 507
 508         sub baz  { 3 }
 509         sub quux { 3 }
 510
 511         Moose::Exporter->setup_import_methods(
 512             also      => ['MultiLevelExporter2'],
 513             with_meta => [qw(baz quux)],
 514         );
 515
 516         sub init_meta {
 517             push @init_metas_called, 3;
 518         }
 519
 520         $INC{'MultiLevelExporter3.pm'} = __FILE__;
 521     }
 522
 523     BEGIN {
 524         package MultiLevelExporter4;
 525         use Moose::Exporter;
 526
 527         sub quux { 4 }
 528
 529         Moose::Exporter->setup_import_methods(
 530             also      => ['MultiLevelExporter3'],
 531             with_meta => [qw(quux)],
 532         );
 533
 534         sub init_meta {
 535             push @init_metas_called, 4;
 536         }
 537
 538         $INC{'MultiLevelExporter4.pm'} = __FILE__;
 539     }
 540
 541     BEGIN { @init_metas_called = () }
 542     {
 543         package UsesMulti1;
 544         use Moose;
 545         use MultiLevelExporter1;
 546         ::is(foo(), 1);
 547         ::is(bar(), 1);
 548         ::is(baz(), 1);
 549         ::is(quux(), 1);
 550     }
 551     use Data::Dumper;
 552     BEGIN { is_deeply(\@init_metas_called, [ 1 ]) || diag(Dumper(\@init_metas_called)) }
 553
 554     BEGIN { @init_metas_called = () }
 555     {
 556         package UsesMulti2;
 557         use Moose;
 558         use MultiLevelExporter2;
 559         ::is(foo(), 1);
 560         ::is(bar(), 2);
 561         ::is(baz(), 2);
 562         ::is(quux(), 2);
 563     }
 564     BEGIN { is_deeply(\@init_metas_called, [ 2, 1 ]) || diag(Dumper(\@init_metas_called)) }
 565
 566     BEGIN { @init_metas_called = () }
 567     {
 568         package UsesMulti3;
 569         use Moose;
 570         use MultiLevelExporter3;
 571         ::is(foo(), 1);
 572         ::is(bar(), 2);
 573         ::is(baz(), 3);
 574         ::is(quux(), 3);
 575     }
 576     BEGIN { is_deeply(\@init_metas_called, [ 3, 2, 1 ]) || diag(Dumper(\@init_metas_called)) }
 577
 578     BEGIN { @init_metas_called = () }
 579     {
 580         package UsesMulti4;
 581         use Moose;
 582         use MultiLevelExporter4;
 583         ::is(foo(), 1);
 584         ::is(bar(), 2);
 585         ::is(baz(), 3);
 586         ::is(quux(), 4);
 587     }
 588     BEGIN { is_deeply(\@init_metas_called, [ 4, 3, 2, 1 ]) || diag(Dumper(\@init_metas_called)) }
 589 }
 590
 591 # Using "also => [ 'MooseX::UsesAlsoMoose', 'MooseX::SomethingElse' ]" should
 592 # continue to work. The init_meta order needs to be MooseX::CurrentExporter,
 593 # MooseX::UsesAlsoMoose, Moose, MooseX::SomethingElse. This is a pretty ugly
 594 # and messed up use case, but necessary until we come up with a better way to
 595 # do it.
 596
 597 {
 598     my @init_metas_called;
 599
 600     BEGIN {
 601         package AlsoTest::Role1;
 602         use Moose::Role;
 603
 604         $INC{'AlsoTest/Role1.pm'} = __FILE__;
 605     }
 606
 607     BEGIN {
 608         package AlsoTest1;
 609         use Moose::Exporter;
 610
 611         Moose::Exporter->setup_import_methods(
 612             also => [ 'Moose' ],
 613         );
 614
 615         sub init_meta {
 616             shift;
 617             my %opts = @_;
 618             ::ok(!Class::MOP::class_of($opts{for_class}));
 619             push @init_metas_called, 1;
 620         }
 621
 622         $INC{'AlsoTest1.pm'} = __FILE__;
 623     }
 624
 625     BEGIN {
 626         package AlsoTest2;
 627         use Moose::Exporter;
 628         use Moose::Util::MetaRole ();
 629
 630         Moose::Exporter->setup_import_methods;
 631
 632         sub init_meta {
 633             shift;
 634             my %opts = @_;
 635             ::ok(Class::MOP::class_of($opts{for_class}));
 636             Moose::Util::MetaRole::apply_metaroles(
 637                 for => $opts{for_class},
 638                 class_metaroles => {
 639                     class => ['AlsoTest::Role1'],
 640                 },
 641             );
 642             push @init_metas_called, 2;
 643         }
 644
 645         $INC{'AlsoTest2.pm'} = __FILE__;
 646     }
 647
 648     BEGIN {
 649         package AlsoTest3;
 650         use Moose::Exporter;
 651
 652         Moose::Exporter->setup_import_methods(
 653             also => [ 'AlsoTest1', 'AlsoTest2' ],
 654         );
 655
 656         sub init_meta {
 657             shift;
 658             my %opts = @_;
 659             ::ok(!Class::MOP::class_of($opts{for_class}));
 660             push @init_metas_called, 3;
 661         }
 662
 663         $INC{'AlsoTest3.pm'} = __FILE__;
 664     }
 665
 666     BEGIN { @init_metas_called = () }
 667     {
 668         package UsesAlsoTest3;
 669         use AlsoTest3;
 670     }
 671     use Data::Dumper;
 672     BEGIN {
 673         is_deeply(\@init_metas_called, [ 3, 1, 2 ])
 674             || diag(Dumper(\@init_metas_called));
 675         isa_ok(Class::MOP::class_of('UsesAlsoTest3'), 'Moose::Meta::Class');
 676         does_ok(Class::MOP::class_of('UsesAlsoTest3'), 'AlsoTest::Role1');
 677     }
 678
 679 }
 680
 681 done_testing;