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