t/500_moose_extends_mouse.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 BEGIN {
   8     plan skip_all => "Moose 0.59 required for this test" unless eval { require Moose 0.59 };
   9     plan tests => 27;
  10 }
  11
  12 use Mouse::Util ':test';
  13
  14 {
  15     package Foo;
  16     use Mouse;
  17
  18     has foo => (
  19         isa => "Int",
  20         is  => "rw",
  21     );
  22
  23     package Bar;
  24     use Moose;
  25
  26     ::lives_ok { extends qw(Foo) } "extend Mouse class with Moose";
  27
  28     ::lives_ok {
  29         has bar => (
  30             isa => "Str",
  31             is  => "rw",
  32         );
  33     } "new attr in subclass";
  34
  35     package Gorch;
  36     use Moose;
  37
  38     ::lives_ok { extends qw(Foo) } "extend Mouse class with Moose";
  39
  40     {
  41         local our $TODO = "Moose not yet aware of Mouse meta";
  42         ::lives_ok {
  43             has '+foo' => (
  44                 default => 3,
  45             );
  46         } "clone and inherit attr in subclass";
  47     }
  48
  49     package Quxx;
  50     use Mouse;
  51
  52     has quxx => (
  53         is => "rw",
  54         default => "lala",
  55     );
  56
  57     package Zork;
  58     use Moose;
  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 {
  82     local $TODO = "Moose not yet aware of Mouse meta";
  83
  84
  85     is_deeply(
  86         [ sort map { $_->name } Bar->meta->compute_all_applicable_attributes ],
  87         [ sort qw(foo bar) ],
  88         "attributes",
  89     );
  90
  91     is( eval { Gorch->new->foo }, 3, "cloned and inherited attr's default" );
  92 }
  93
  94 can_ok( Zork => "new" );
  95
  96 {
  97     my $zork = eval { Zork->new };
  98
  99     ok( $zork, "got an object" );
 100     isa_ok( $zork, "Zork" );
 101     isa_ok( $zork, "Quxx" );
 102
 103     can_ok( $zork, qw(quxx zork) );
 104
 105     local $TODO = "Constructor needs to know default values of attrs from both";
 106     is( eval { $bar->quxx }, "lala", "default value" );
 107     is( eval { $bar->zork }, 42,     "default value" );
 108 }
 109
 110 {
 111     my $zork = eval { Zork->new( zork => "diff", quxx => "blah" ) };
 112
 113     ok( $zork, "got an object" );
 114     isa_ok( $zork, "Zork" );
 115     isa_ok( $zork, "Quxx" );
 116
 117     can_ok( $zork, qw(quxx zork) );
 118
 119     local $TODO = "Constructor needs to know init args of attrs from both";
 120     is( eval { $bar->quxx }, "blah", "constructor param" );
 121     is( eval { $bar->zork }, "diff", "constructor param" );
 122 }