t/072_immutable_w_constructors.t

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