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 base 'Foo';
  33     use Moose;
  34
  35     sub new { (shift)->meta->new_object(@_) }
  36
  37     package Baz;
  38     use Moose;
  39     use base 'Foo';
  40 }
  41
  42 my $bar = Bar->new;
  43 isa_ok($bar, 'Bar');
  44 isa_ok($bar, 'Foo');
  45 ok(!$bar->isa('Moose::Object'), '... Bar is not Moose::Object subclass');
  46
  47 my $baz = Baz->new;
  48 isa_ok($baz, 'Baz');
  49 isa_ok($baz, 'Foo');
  50 isa_ok($baz, 'Moose::Object');
  51