t/050_metaclasses/012_moose_exporter.t

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