t/basic.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 15;
   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 Moose;
  19     use MooseX::StrictConstructor;
  20
  21     has 'thing' => ( is => 'rw' );
  22 }
  23
  24 {
  25     package Subclass;
  26
  27     use Moose;
  28     use MooseX::StrictConstructor;
  29
  30     extends 'Stricter';
  31
  32     has 'size' => ( is => 'rw' );
  33 }
  34
  35 {
  36     package Tricky;
  37
  38     use Moose;
  39     use MooseX::StrictConstructor;
  40
  41     has 'thing' => ( is => 'rw' );
  42
  43     sub BUILD
  44     {
  45         my $self   = shift;
  46         my $params = shift;
  47
  48         delete $params->{spy};
  49     }
  50 }
  51
  52 {
  53     package InitArg;
  54
  55     use Moose;
  56     use MooseX::StrictConstructor;
  57
  58     has 'thing' => ( is => 'rw', 'init_arg' => 'other' );
  59     has 'size'  => ( is => 'rw', 'init_arg' => undef );
  60 }
  61
  62 {
  63     package ImmutableInitArg;
  64
  65     use Moose;
  66     use MooseX::StrictConstructor;
  67
  68     has 'thing' => ( is => 'rw', 'init_arg' => 'other' );
  69     has 'size'  => ( is => 'rw', 'init_arg' => undef );
  70
  71     no Moose;
  72     __PACKAGE__->meta()->make_immutable();
  73 }
  74
  75 {
  76     package Immutable;
  77
  78     use Moose;
  79     use MooseX::StrictConstructor;
  80
  81     has 'thing' => ( is => 'rw' );
  82
  83     no Moose;
  84     __PACKAGE__->meta()->make_immutable();
  85 }
  86
  87 {
  88     package ImmutableTricky;
  89
  90     use Moose;
  91     use MooseX::StrictConstructor;
  92
  93     has 'thing' => ( is => 'rw' );
  94
  95     sub BUILD
  96     {
  97         my $self   = shift;
  98         my $params = shift;
  99
 100         delete $params->{spy};
 101     }
 102
 103     no Moose;
 104     __PACKAGE__->meta()->make_immutable();
 105 }
 106
 107
 108 eval { Standard->new( thing => 1, bad => 99 ) };
 109 is( $@, '', 'standard Moose class ignores unknown params' );
 110
 111 eval { Stricter->new( thing => 1, bad => 99 ) };
 112 like( $@, qr/unknown attribute.+: bad/, 'strict constructor blows up on unknown params' );
 113
 114 eval { Subclass->new( thing => 1, size => 'large' ) };
 115 is( $@, '', 'subclass constructor handles known attributes correctly' );
 116
 117 eval { Tricky->new( thing => 1, spy => 99 ) };
 118 is( $@, '', 'can work around strict constructor by deleting params in BUILD()' );
 119
 120 eval { Tricky->new( thing => 1, agent => 99 ) };
 121 like( $@, qr/unknown attribute.+: agent/, 'Tricky still blows up on unknown params other than spy' );
 122
 123 eval { Subclass->new( thing => 1, bad => 99 ) };
 124 like( $@, qr/unknown attribute.+: bad/, 'subclass constructor blows up on unknown params' );
 125
 126 eval { InitArg->new( thing => 1 ) };
 127 like( $@, qr/unknown attribute.+: thing/,
 128       'InitArg blows up with attribute name' );
 129
 130 eval { InitArg->new( size => 1 ) };
 131 like( $@, qr/unknown attribute.+: size/,
 132       'InitArg blows up when given attribute with undef init_arg' );
 133
 134 eval { InitArg->new( other => 1 ) };
 135 is( $@, '',
 136     'InitArg works when given proper init_arg' );
 137
 138 eval { ImmutableInitArg->new( thing => 1 ) };
 139 like( $@, qr/unknown attribute.+: thing/,
 140       'ImmutableInitArg blows up with attribute name' );
 141
 142 eval { ImmutableInitArg->new( size => 1 ) };
 143 like( $@, qr/unknown attribute.+: size/,
 144       'ImmutableInitArg blows up when given attribute with undef init_arg' );
 145
 146 eval { ImmutableInitArg->new( other => 1 ) };
 147 is( $@, '',
 148     'ImmutableInitArg works when given proper init_arg' );
 149
 150 eval { Immutable->new( thing => 1, bad => 99 ) };
 151 like( $@, qr/unknown attribute.+: bad/,
 152       'strict constructor in immutable class blows up on unknown params' );
 153
 154 eval { ImmutableTricky->new( thing => 1, spy => 99 ) };
 155 is( $@, '',
 156     'immutable class can work around strict constructor by deleting params in BUILD()' );
 157
 158 eval { ImmutableTricky->new( thing => 1, agent => 99 ) };
 159 like( $@, qr/unknown attribute.+: agent/,
 160       'ImmutableTricky still blows up on unknown params other than spy' );