t/022_moose_respects_base.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 7;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     use_ok('Moose');
  11 }
  12
  13 =pod
  14
  15 This test demonstrates that Moose will respect
  16 a previously set @ISA using use base, and not
  17 try to add Moose::Object to it.
  18
  19 However, this is extremely order sensitive as
  20 this test also demonstrates.
  21
  22 =cut
  23
  24 {
  25     package Foo;
  26     use strict;
  27     use warnings;
  28
  29     sub foo { 'Foo::foo' }
  30
  31     package Bar;
  32     use strict;
  33     use warnings;
  34
  35     use base 'Foo';
  36
  37     use Moose;
  38
  39     sub new { (shift)->meta->new_object(@_) }
  40
  41     package Baz;
  42     use strict;
  43     use warnings;
  44     use Moose;
  45     use base 'Foo';
  46 }
  47
  48 my $bar = Bar->new;
  49 isa_ok($bar, 'Bar');
  50 isa_ok($bar, 'Foo');
  51 ok(!$bar->isa('Moose::Object'), '... Bar is not Moose::Object subclass');
  52
  53 my $baz = Baz->new;
  54 isa_ok($baz, 'Baz');
  55 isa_ok($baz, 'Foo');
  56 isa_ok($baz, 'Moose::Object');
  57