t/072_immutable_w_constructors.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More;
   5 use Test::Fatal;
   6
   7 use Class::MOP;
   8
   9
  10 {
  11     package Foo;
  12
  13     use strict;
  14     use warnings;
  15     use metaclass;
  16
  17     __PACKAGE__->meta->add_attribute('bar' => (
  18         reader  => 'bar',
  19         default => 'BAR',
  20     ));
  21
  22     package Bar;
  23
  24     use strict;
  25     use warnings;
  26     use metaclass;
  27
  28     __PACKAGE__->meta->superclasses('Foo');
  29
  30     __PACKAGE__->meta->add_attribute('baz' => (
  31         reader  => 'baz',
  32         default => sub { 'BAZ' },
  33     ));
  34
  35     package Baz;
  36
  37     use strict;
  38     use warnings;
  39     use metaclass;
  40
  41     __PACKAGE__->meta->superclasses('Bar');
  42
  43     __PACKAGE__->meta->add_attribute('bah' => (
  44         reader  => 'bah',
  45         default => 'BAH',
  46     ));
  47
  48     package Buzz;
  49
  50     use strict;
  51     use warnings;
  52     use metaclass;
  53
  54
  55     __PACKAGE__->meta->add_attribute('bar' => (
  56         accessor  => 'bar',
  57         predicate => 'has_bar',
  58         clearer   => 'clear_bar',
  59     ));
  60
  61     __PACKAGE__->meta->add_attribute('bah' => (
  62         accessor  => 'bah',
  63         predicate => 'has_bah',
  64         clearer   => 'clear_bah',
  65         default   => 'BAH'
  66     ));
  67
  68 }
  69
  70 {
  71     my $meta = Foo->meta;
  72     is($meta->name, 'Foo', '... checking the Foo metaclass');
  73
  74     {
  75         my $bar_accessor = $meta->get_method('bar');
  76         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
  77         isa_ok($bar_accessor, 'Class::MOP::Method');
  78
  79         ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
  80     }
  81
  82     ok(!$meta->is_immutable, '... our class is not immutable');
  83
  84     is( exception {
  85         $meta->make_immutable(
  86             inline_constructor => 1,
  87             inline_accessors   => 0,
  88         );
  89     }, undef, '... changed Foo to be immutable' );
  90
  91     ok($meta->is_immutable, '... our class is now immutable');
  92     isa_ok($meta, 'Class::MOP::Class');
  93
  94     # they made a constructor for us :)
  95     can_ok('Foo', 'new');
  96
  97     {
  98         my $foo = Foo->new;
  99         isa_ok($foo, 'Foo');
 100         is($foo->bar, 'BAR', '... got the right default value');
 101     }
 102
 103     {
 104         my $foo = Foo->new(bar => 'BAZ');
 105         isa_ok($foo, 'Foo');
 106         is($foo->bar, 'BAZ', '... got the right parameter value');
 107     }
 108
 109     # NOTE:
 110     # check that the constructor correctly handles inheritance
 111     {
 112         my $bar = Bar->new();
 113         isa_ok($bar, 'Bar');
 114         isa_ok($bar, 'Foo');
 115         is($bar->bar, 'BAR', '... got the right inherited parameter value');
 116         is($bar->baz, 'BAZ', '... got the right inherited parameter value');
 117     }
 118
 119     # check out accessors too
 120     {
 121         my $bar_accessor = $meta->get_method('bar');
 122         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 123         isa_ok($bar_accessor, 'Class::MOP::Method');
 124
 125         ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
 126     }
 127 }
 128
 129 {
 130     my $meta = Bar->meta;
 131     is($meta->name, 'Bar', '... checking the Bar metaclass');
 132
 133     {
 134         my $bar_accessor = $meta->find_method_by_name('bar');
 135         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 136         isa_ok($bar_accessor, 'Class::MOP::Method');
 137
 138         ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
 139
 140         my $baz_accessor = $meta->get_method('baz');
 141         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
 142         isa_ok($baz_accessor, 'Class::MOP::Method');
 143
 144         ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
 145     }
 146
 147     ok(!$meta->is_immutable, '... our class is not immutable');
 148
 149     is( exception {
 150         $meta->make_immutable(
 151             inline_constructor => 1,
 152             inline_accessors   => 1,
 153         );
 154     }, undef, '... changed Bar to be immutable' );
 155
 156     ok($meta->is_immutable, '... our class is now immutable');
 157     isa_ok($meta, 'Class::MOP::Class');
 158
 159     # they made a constructor for us :)
 160     can_ok('Bar', 'new');
 161
 162     {
 163         my $bar = Bar->new;
 164         isa_ok($bar, 'Bar');
 165         is($bar->bar, 'BAR', '... got the right default value');
 166         is($bar->baz, 'BAZ', '... got the right default value');
 167     }
 168
 169     {
 170         my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
 171         isa_ok($bar, 'Bar');
 172         is($bar->bar, 'BAZ!', '... got the right parameter value');
 173         is($bar->baz, 'BAR!', '... got the right parameter value');
 174     }
 175
 176     # check out accessors too
 177     {
 178         my $bar_accessor = $meta->find_method_by_name('bar');
 179         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 180         isa_ok($bar_accessor, 'Class::MOP::Method');
 181
 182         ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
 183
 184         my $baz_accessor = $meta->get_method('baz');
 185         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
 186         isa_ok($baz_accessor, 'Class::MOP::Method');
 187
 188         ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
 189     }
 190 }
 191
 192 {
 193     my $meta = Baz->meta;
 194     is($meta->name, 'Baz', '... checking the Bar metaclass');
 195
 196     {
 197         my $bar_accessor = $meta->find_method_by_name('bar');
 198         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 199         isa_ok($bar_accessor, 'Class::MOP::Method');
 200
 201         ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
 202
 203         my $baz_accessor = $meta->find_method_by_name('baz');
 204         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
 205         isa_ok($baz_accessor, 'Class::MOP::Method');
 206
 207         ok($baz_accessor->is_inline, '... the baz accessor is inlined');
 208
 209         my $bah_accessor = $meta->get_method('bah');
 210         isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
 211         isa_ok($bah_accessor, 'Class::MOP::Method');
 212
 213         ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
 214     }
 215
 216     ok(!$meta->is_immutable, '... our class is not immutable');
 217
 218     is( exception {
 219         $meta->make_immutable(
 220             inline_constructor => 0,
 221             inline_accessors   => 1,
 222         );
 223     }, undef, '... changed Bar to be immutable' );
 224
 225     ok($meta->is_immutable, '... our class is now immutable');
 226     isa_ok($meta, 'Class::MOP::Class');
 227
 228     ok(!Baz->meta->has_method('new'), '... no constructor was made');
 229
 230     {
 231         my $baz = Baz->meta->new_object;
 232         isa_ok($baz, 'Bar');
 233         is($baz->bar, 'BAR', '... got the right default value');
 234         is($baz->baz, 'BAZ', '... got the right default value');
 235     }
 236
 237     {
 238         my $baz = Baz->meta->new_object(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
 239         isa_ok($baz, 'Baz');
 240         is($baz->bar, 'BAZ!', '... got the right parameter value');
 241         is($baz->baz, 'BAR!', '... got the right parameter value');
 242         is($baz->bah, 'BAH!', '... got the right parameter value');
 243     }
 244
 245     # check out accessors too
 246     {
 247         my $bar_accessor = $meta->find_method_by_name('bar');
 248         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 249         isa_ok($bar_accessor, 'Class::MOP::Method');
 250
 251         ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
 252
 253         my $baz_accessor = $meta->find_method_by_name('baz');
 254         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
 255         isa_ok($baz_accessor, 'Class::MOP::Method');
 256
 257         ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
 258
 259         my $bah_accessor = $meta->get_method('bah');
 260         isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
 261         isa_ok($bah_accessor, 'Class::MOP::Method');
 262
 263         ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
 264     }
 265 }
 266
 267
 268 {
 269   my $buzz;
 270   ::is( ::exception { $buzz = Buzz->meta->new_object }, undef, '...Buzz instantiated successfully' );
 271   ::ok(!$buzz->has_bar, '...bar is not set');
 272   ::is($buzz->bar, undef, '...bar returns undef');
 273   ::ok(!$buzz->has_bar, '...bar was not autovivified');
 274
 275   $buzz->bar(undef);
 276   ::ok($buzz->has_bar, '...bar is set');
 277   ::is($buzz->bar, undef, '...bar is undef');
 278   $buzz->clear_bar;
 279   ::ok(!$buzz->has_bar, '...bar is no longerset');
 280
 281   my $buzz2;
 282   ::is( ::exception { $buzz2 = Buzz->meta->new_object('bar' => undef) }, undef, '...Buzz instantiated successfully' );
 283   ::ok($buzz2->has_bar, '...bar is set');
 284   ::is($buzz2->bar, undef, '...bar is undef');
 285
 286 }
 287
 288 {
 289   my $buzz;
 290   ::is( ::exception { $buzz = Buzz->meta->new_object }, undef, '...Buzz instantiated successfully' );
 291   ::ok($buzz->has_bah, '...bah is set');
 292   ::is($buzz->bah, 'BAH', '...bah returns "BAH"' );
 293
 294   my $buzz2;
 295   ::is( ::exception { $buzz2 = Buzz->meta->new_object('bah' => undef) }, undef, '...Buzz instantiated successfully' );
 296   ::ok($buzz2->has_bah, '...bah is set');
 297   ::is($buzz2->bah, undef, '...bah is undef');
 298
 299 }
 300
 301 done_testing;