t/basic.t

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