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