t/072_immutable_w_constructors.t

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