t/072_immutable_w_constructors.t

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