t/072_immutable_w_constructors.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 77;
   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
  53 {
  54     my $meta = Foo->meta;
  55     is($meta->name, 'Foo', '... checking the Foo metaclass');
  56
  57     {
  58         my $bar_accessor = $meta->get_method('bar');
  59         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
  60         isa_ok($bar_accessor, 'Class::MOP::Method');
  61
  62         ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
  63     }
  64
  65     ok(!$meta->is_immutable, '... our class is not immutable');
  66
  67     lives_ok {
  68         $meta->make_immutable(
  69             inline_constructor => 1,
  70             inline_accessors   => 0,
  71         );
  72     } '... changed Foo to be immutable';
  73
  74     ok($meta->is_immutable, '... our class is now immutable');
  75     isa_ok($meta, 'Class::MOP::Class');
  76
  77     # they made a constructor for us :)
  78     can_ok('Foo', 'new');
  79
  80     {
  81         my $foo = Foo->new;
  82         isa_ok($foo, 'Foo');
  83         is($foo->bar, 'BAR', '... got the right default value');
  84     }
  85
  86     {
  87         my $foo = Foo->new(bar => 'BAZ');
  88         isa_ok($foo, 'Foo');
  89         is($foo->bar, 'BAZ', '... got the right parameter value');
  90     }
  91
  92     # NOTE:
  93     # check that the constructor correctly handles inheritance
  94     {
  95         my $bar = Bar->new();
  96         isa_ok($bar, 'Bar');
  97         isa_ok($bar, 'Foo');
  98         is($bar->bar, 'BAR', '... got the right inherited parameter value');
  99         is($bar->baz, 'BAZ', '... got the right inherited parameter value');
 100     }
 101
 102     # check out accessors too
 103     {
 104         my $bar_accessor = $meta->get_method('bar');
 105         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 106         isa_ok($bar_accessor, 'Class::MOP::Method');
 107
 108         ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
 109     }
 110 }
 111
 112 {
 113     my $meta = Bar->meta;
 114     is($meta->name, 'Bar', '... checking the Bar metaclass');
 115
 116     {
 117         my $bar_accessor = $meta->find_method_by_name('bar');
 118         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 119         isa_ok($bar_accessor, 'Class::MOP::Method');
 120
 121         ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
 122
 123         my $baz_accessor = $meta->get_method('baz');
 124         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
 125         isa_ok($baz_accessor, 'Class::MOP::Method');
 126
 127         ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
 128     }
 129
 130     ok(!$meta->is_immutable, '... our class is not immutable');
 131
 132     lives_ok {
 133         $meta->make_immutable(
 134             inline_constructor => 1,
 135             inline_accessors   => 1,
 136         );
 137     } '... changed Bar to be immutable';
 138
 139     ok($meta->is_immutable, '... our class is now immutable');
 140     isa_ok($meta, 'Class::MOP::Class');
 141
 142     # they made a constructor for us :)
 143     can_ok('Bar', 'new');
 144
 145     {
 146         my $bar = Bar->new;
 147         isa_ok($bar, 'Bar');
 148         is($bar->bar, 'BAR', '... got the right default value');
 149         is($bar->baz, 'BAZ', '... got the right default value');
 150     }
 151
 152     {
 153         my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
 154         isa_ok($bar, 'Bar');
 155         is($bar->bar, 'BAZ!', '... got the right parameter value');
 156         is($bar->baz, 'BAR!', '... got the right parameter value');
 157     }
 158
 159     # check out accessors too
 160     {
 161         my $bar_accessor = $meta->find_method_by_name('bar');
 162         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 163         isa_ok($bar_accessor, 'Class::MOP::Method');
 164
 165         ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
 166
 167         my $baz_accessor = $meta->get_method('baz');
 168         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
 169         isa_ok($baz_accessor, 'Class::MOP::Method');
 170
 171         ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
 172     }
 173 }
 174
 175 {
 176     my $meta = Baz->meta;
 177     is($meta->name, 'Baz', '... checking the Bar metaclass');
 178
 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 not inlined');
 185
 186         my $baz_accessor = $meta->find_method_by_name('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 inlined');
 191
 192         my $bah_accessor = $meta->get_method('bah');
 193         isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
 194         isa_ok($bah_accessor, 'Class::MOP::Method');
 195
 196         ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
 197     }
 198
 199     ok(!$meta->is_immutable, '... our class is not immutable');
 200
 201     lives_ok {
 202         $meta->make_immutable(
 203             inline_constructor => 0,
 204             inline_accessors   => 1,
 205         );
 206     } '... changed Bar to be immutable';
 207
 208     ok($meta->is_immutable, '... our class is now immutable');
 209     isa_ok($meta, 'Class::MOP::Class');
 210
 211     ok(!Baz->meta->has_method('new'), '... no constructor was made');
 212
 213     {
 214         my $baz = Baz->meta->construct_instance;
 215         isa_ok($baz, 'Bar');
 216         is($baz->bar, 'BAR', '... got the right default value');
 217         is($baz->baz, 'BAZ', '... got the right default value');
 218     }
 219
 220     {
 221         my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
 222         isa_ok($baz, 'Baz');
 223         is($baz->bar, 'BAZ!', '... got the right parameter value');
 224         is($baz->baz, 'BAR!', '... got the right parameter value');
 225         is($baz->bah, 'BAH!', '... got the right parameter value');
 226     }
 227
 228     # check out accessors too
 229     {
 230         my $bar_accessor = $meta->find_method_by_name('bar');
 231         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 232         isa_ok($bar_accessor, 'Class::MOP::Method');
 233
 234         ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
 235
 236         my $baz_accessor = $meta->find_method_by_name('baz');
 237         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
 238         isa_ok($baz_accessor, 'Class::MOP::Method');
 239
 240         ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
 241
 242         my $bah_accessor = $meta->get_method('bah');
 243         isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
 244         isa_ok($bah_accessor, 'Class::MOP::Method');
 245
 246         ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
 247     }
 248 }
 249