t/500_moose_extends_mouse.t

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