t/072_immutable_w_constructors.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 73;
   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     # check out accessors too
  93     {
  94         my $bar_accessor = $meta->get_method('bar');
  95         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
  96         isa_ok($bar_accessor, 'Class::MOP::Method');
  97
  98         ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
  99     }
 100 }
 101
 102 {
 103     my $meta = Bar->meta;
 104     is($meta->name, 'Bar', '... checking the Bar metaclass');
 105
 106     {
 107         my $bar_accessor = $meta->find_method_by_name('bar');
 108         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 109         isa_ok($bar_accessor, 'Class::MOP::Method');
 110
 111         ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
 112
 113         my $baz_accessor = $meta->get_method('baz');
 114         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
 115         isa_ok($baz_accessor, 'Class::MOP::Method');
 116
 117         ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
 118     }
 119
 120     ok(!$meta->is_immutable, '... our class is not immutable');
 121
 122     lives_ok {
 123         $meta->make_immutable(
 124             inline_constructor => 1,
 125             inline_accessors   => 1,
 126         );
 127     } '... changed Bar to be immutable';
 128
 129     ok($meta->is_immutable, '... our class is now immutable');
 130     isa_ok($meta, 'Class::MOP::Class');
 131
 132     # they made a constructor for us :)
 133     can_ok('Bar', 'new');
 134
 135     {
 136         my $bar = Bar->new;
 137         isa_ok($bar, 'Bar');
 138         is($bar->bar, 'BAR', '... got the right default value');
 139         is($bar->baz, 'BAZ', '... got the right default value');
 140     }
 141
 142     {
 143         my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
 144         isa_ok($bar, 'Bar');
 145         is($bar->bar, 'BAZ!', '... got the right parameter value');
 146         is($bar->baz, 'BAR!', '... got the right parameter value');
 147     }
 148
 149     # check out accessors too
 150     {
 151         my $bar_accessor = $meta->find_method_by_name('bar');
 152         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 153         isa_ok($bar_accessor, 'Class::MOP::Method');
 154
 155         ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
 156
 157         my $baz_accessor = $meta->get_method('baz');
 158         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
 159         isa_ok($baz_accessor, 'Class::MOP::Method');
 160
 161         ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
 162     }
 163 }
 164
 165 {
 166     my $meta = Baz->meta;
 167     is($meta->name, 'Baz', '... checking the Bar metaclass');
 168
 169     {
 170         my $bar_accessor = $meta->find_method_by_name('bar');
 171         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 172         isa_ok($bar_accessor, 'Class::MOP::Method');
 173
 174         ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
 175
 176         my $baz_accessor = $meta->find_method_by_name('baz');
 177         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
 178         isa_ok($baz_accessor, 'Class::MOP::Method');
 179
 180         ok($baz_accessor->is_inline, '... the baz accessor is inlined');
 181
 182         my $bah_accessor = $meta->get_method('bah');
 183         isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
 184         isa_ok($bah_accessor, 'Class::MOP::Method');
 185
 186         ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
 187     }
 188
 189     ok(!$meta->is_immutable, '... our class is not immutable');
 190
 191     lives_ok {
 192         $meta->make_immutable(
 193             inline_constructor => 0,
 194             inline_accessors   => 1,
 195         );
 196     } '... changed Bar to be immutable';
 197
 198     ok($meta->is_immutable, '... our class is now immutable');
 199     isa_ok($meta, 'Class::MOP::Class');
 200
 201     ok(!Baz->meta->has_method('new'), '... no constructor was made');
 202
 203     {
 204         my $baz = Baz->meta->construct_instance;
 205         isa_ok($baz, 'Bar');
 206         is($baz->bar, 'BAR', '... got the right default value');
 207         is($baz->baz, 'BAZ', '... got the right default value');
 208     }
 209
 210     {
 211         my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
 212         isa_ok($baz, 'Baz');
 213         is($baz->bar, 'BAZ!', '... got the right parameter value');
 214         is($baz->baz, 'BAR!', '... got the right parameter value');
 215         is($baz->bah, 'BAH!', '... got the right parameter value');
 216     }
 217
 218     # check out accessors too
 219     {
 220         my $bar_accessor = $meta->find_method_by_name('bar');
 221         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
 222         isa_ok($bar_accessor, 'Class::MOP::Method');
 223
 224         ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
 225
 226         my $baz_accessor = $meta->find_method_by_name('baz');
 227         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
 228         isa_ok($baz_accessor, 'Class::MOP::Method');
 229
 230         ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
 231
 232         my $bah_accessor = $meta->get_method('bah');
 233         isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
 234         isa_ok($bah_accessor, 'Class::MOP::Method');
 235
 236         ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
 237     }
 238 }
 239