t/060_compat/002_moose_respects_base.t

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