t/001_mouse/068-strict-constructor.t

   1 #!perl
   2 use strict;
   3 use warnings;
   4
   5 use if 'Mouse' eq 'Moose',
   6     'Test::More' => skip_all => 'Moose does nots support strict constructor';
   7 use Test::More;
   8 use Test::Mouse;
   9 use Test::Exception;
  10
  11 {
  12     package MyClass;
  13     use Mouse;
  14
  15     has foo => (
  16         is => 'rw',
  17     );
  18
  19     has bar => (
  20         is => 'rw',
  21         init_arg => undef,
  22     );
  23
  24     has baz => (
  25         is      => 'rw',
  26         default => 42,
  27     );
  28
  29     __PACKAGE__->meta->strict_constructor(1);
  30 }
  31 {
  32     package MySubClass;
  33     use Mouse;
  34     extends 'MyClass';
  35 }
  36
  37 with_immutable sub {
  38     lives_and {
  39         my $o = MyClass->new(foo => 1);
  40         isa_ok($o, 'MyClass');
  41         is $o->baz, 42;
  42     } 'correc use of the constructor';
  43
  44     lives_and {
  45         my $o = MyClass->new(foo => 1, baz => 10);
  46         isa_ok($o, 'MyClass');
  47         is $o->baz, 10;
  48     } 'correc use of the constructor';
  49
  50
  51     throws_ok {
  52         MyClass->new(foo => 1, hoge => 42);
  53     } qr/\b hoge \b/xms;
  54
  55     throws_ok {
  56         MyClass->new(foo => 1, bar => 42);
  57     } qr/\b bar \b/xms, "init_arg => undef";
  58
  59
  60     eval {
  61         MyClass->new(aaa => 1, bbb => 2, ccc => 3);
  62     };
  63     like $@, qr/\b aaa \b/xms;
  64     like $@, qr/\b bbb \b/xms;
  65     like $@, qr/\b ccc \b/xms;
  66
  67     eval {
  68         MySubClass->new(aaa => 1, bbb => 2, ccc => 3);
  69     };
  70     like $@, qr/\b aaa \b/xms;
  71     like $@, qr/\b bbb \b/xms;
  72     like $@, qr/\b ccc \b/xms;
  73 }, qw(MyClass MySubClass);
  74
  75 done_testing;