t/basic.t

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