t/072_immutable_w_constructors.t

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