t/basic.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 9;
   5
   6
   7 {
   8     package Standard;
   9
  10     use Moose;
  11
  12     has 'thing' => ( is => 'rw' );
  13 }
  14
  15 {
  16     package Stricter;
  17
  18     use MooseX::StrictConstructor;
  19
  20     has 'thing' => ( is => 'rw' );
  21 }
  22
  23 {
  24     package Subclass;
  25
  26     use MooseX::StrictConstructor;
  27
  28     extends 'Stricter';
  29
  30     has 'size' => ( is => 'rw' );
  31 }
  32
  33 {
  34     package Tricky;
  35
  36     use MooseX::StrictConstructor;
  37
  38     has 'thing' => ( is => 'rw' );
  39
  40     sub BUILD
  41     {
  42         my $self   = shift;
  43         my $params = shift;
  44
  45         delete $params->{spy};
  46     }
  47 }
  48
  49 {
  50     package Immutable;
  51
  52     use MooseX::StrictConstructor;
  53
  54     has 'thing' => ( is => 'rw' );
  55
  56     no Moose;
  57     __PACKAGE__->meta()->make_immutable();
  58 }
  59
  60 {
  61     package ImmutableTricky;
  62
  63     use MooseX::StrictConstructor;
  64
  65     has 'thing' => ( is => 'rw' );
  66
  67     sub BUILD
  68     {
  69         my $self   = shift;
  70         my $params = shift;
  71
  72         delete $params->{spy};
  73     }
  74
  75     no Moose;
  76     __PACKAGE__->meta()->make_immutable();
  77 }
  78
  79
  80 eval { Standard->new( thing => 1, bad => 99 ) };
  81 is( $@, '', 'standard Moose class ignores unknown params' );
  82
  83 eval { Stricter->new( thing => 1, bad => 99 ) };
  84 like( $@, qr/unknown attribute.+: bad/, 'strict constructor blows up on unknown params' );
  85
  86 eval { Tricky->new( thing => 1, spy => 99 ) };
  87 is( $@, '', 'can work around strict constructor by deleting params in BUILD()' );
  88
  89 eval { Tricky->new( thing => 1, agent => 99 ) };
  90 like( $@, qr/unknown attribute.+: agent/, 'Tricky still blows up on unknown params other than spy' );
  91
  92 eval { Subclass->new( thing => 1, bad => 99 ) };
  93 like( $@, qr/unknown attribute.+: bad/, 'subclass constructor blows up on unknown params' );
  94
  95 eval { Subclass->new( thing => 1, size => 'large' ) };
  96 is( $@, '', 'subclass constructor handles known attributes correctly' );
  97
  98 eval { Immutable->new( thing => 1, bad => 99 ) };
  99 like( $@, qr/unknown attribute.+: bad/,
 100       'strict constructor in immutable class blows up on unknown params' );
 101
 102 eval { ImmutableTricky->new( thing => 1, spy => 99 ) };
 103 is( $@, '',
 104     'immutable class can work around strict constructor by deleting params in BUILD()' );
 105
 106 eval { ImmutableTricky->new( thing => 1, agent => 99 ) };
 107 like( $@, qr/unknown attribute.+: agent/,
 108       'ImmutableTricky still blows up on unknown params other than spy' );