t/500_moose_extends_mouse.t

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