t/040-existing-subclass.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5
   6 BEGIN {
   7     eval "use Test::Output;";
   8     plan skip_all => "Test::Output is required for this test" if $@;
   9     plan tests => 3;
  10 }
  11
  12 do {
  13     package Parent;
  14     sub new { bless {}, shift }
  15
  16     package Child;
  17     BEGIN { our @ISA = 'Parent' }
  18     use Mouse;
  19 };
  20
  21 TODO: {
  22     local $TODO = "Mouse doesn't track enough context";
  23     stderr_is(
  24         sub { Child->meta->make_immutable },
  25         "Not inlining a constructor for Child since it is not inheriting the default Mouse::Object constructor\n",
  26         'Mouse warns when it would have blown away the inherited constructor',
  27     );
  28 }
  29
  30 do {
  31     package Foo;
  32     use Mouse;
  33
  34     __PACKAGE__->meta->make_immutable;
  35
  36     package Bar;
  37     use Mouse;
  38     extends 'Foo';
  39
  40 };
  41
  42 stderr_is(
  43     sub { Bar->meta->make_immutable },
  44     "",
  45     'Mouse does not warn about inlining a constructor when the superclass inlined a constructor',
  46 );
  47
  48 do {
  49     package Baz;
  50
  51     package Quux;
  52     BEGIN { our @ISA = 'Baz' }
  53     use Mouse;
  54
  55     __PACKAGE__->meta->make_immutable;
  56 };
  57
  58 ok(Quux->new);
  59