t/810_with_moose/600_mouse_extends_moose.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More skip_all => '[TODO] a Moose class cannot extends a Mouse class';
   7 use Test::More;
   8
   9 use Mouse::Spec;
  10 BEGIN {
  11     eval{ require Moose && Moose->VERSION(Mouse::Spec->MooseVersion) };
  12     plan skip_all => "Moose $Mouse::Spec::MooseVersion required for this test" if $@;
  13 }
  14
  15 use Test::Exception;
  16
  17 {
  18     package Foo;
  19     use Moose;
  20
  21     has foo => (
  22         isa => "Int",
  23         is  => "rw",
  24     );
  25
  26     package Bar;
  27     use Mouse;
  28
  29     ::lives_ok { extends qw(Foo) } "extend Mouse class with Moose";
  30
  31     ::lives_ok {
  32         has bar => (
  33             isa => "Str",
  34             is  => "rw",
  35         );
  36     } "new attr in subclass";
  37
  38     package Gorch;
  39     use Mouse;
  40
  41     ::lives_ok { extends qw(Foo) } "extend Mouse class with Moose";
  42
  43     ::lives_ok {
  44         has '+foo' => (
  45             default => 3,
  46         );
  47     } "clone and inherit attr in subclass";
  48
  49     package Quxx;
  50     use Moose;
  51
  52     has quxx => (
  53         is => "rw",
  54         default => "lala",
  55     );
  56
  57     package Zork;
  58     use Mouse;
  59
  60     ::lives_ok { extends qw(Quxx) } "extend Mouse class with Moose";
  61
  62     has zork => (
  63         is => "rw",
  64         default => 42,
  65     );
  66 }
  67
  68 can_ok( Bar => "new" );
  69
  70 my $bar = eval { Bar->new };
  71
  72 ok( $bar, "got an object" );
  73 isa_ok( $bar, "Bar" );
  74 isa_ok( $bar, "Foo" );
  75
  76 can_ok( $bar, qw(foo bar) );
  77
  78 is( eval { $bar->foo }, undef, "no default value" );
  79 is( eval { $bar->bar }, undef, "no default value" );
  80
  81 lives_and {
  82     is_deeply(
  83         [ sort map { $_->name } Bar->meta->get_all_attributes ],
  84         [ sort qw(foo bar) ],
  85         "attributes",
  86     );
  87
  88     is( Gorch->new->foo, 3, "cloned and inherited attr's default" );
  89 };
  90
  91 can_ok( Zork => "new" );
  92
  93 lives_and {
  94     my $zork = eval { Zork->new };
  95
  96     ok( $zork, "got an object" );
  97     isa_ok( $zork, "Zork" );
  98     isa_ok( $zork, "Quxx" );
  99
 100     can_ok( $zork, qw(quxx zork) );
 101
 102     is( $bar->quxx, "lala", "default value" );
 103     is( $bar->zork, 42,     "default value" );
 104 };
 105
 106 lives_and {
 107     my $zork = eval { Zork->new( zork => "diff", quxx => "blah" ) };
 108
 109     ok( $zork, "got an object" );
 110     isa_ok( $zork, "Zork" );
 111     isa_ok( $zork, "Quxx" );
 112
 113     can_ok( $zork, qw(quxx zork) );
 114
 115     is( $bar->quxx, "blah", "constructor param" );
 116     is( $bar->zork, "diff", "constructor param" );
 117 };
 118
 119 done_testing;
 120 \0