X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F072_immutable_w_constructors.t;h=7ef79f097810a669547b4e3050c8e11b28aa1754;hb=d69fb6b34cf37d63bbed4d941ad809539299e218;hp=70a59d1a2c0c10a28d848d2e87c5ca1d28ccea6b;hpb=c23184fc39306590f9e481d76c199020a638bb28;p=gitmo%2FClass-MOP.git

diff --git a/t/072_immutable_w_constructors.t b/t/072_immutable_w_constructors.t
index 70a59d1..7ef79f0 100644
--- a/t/072_immutable_w_constructors.t
+++ b/t/072_immutable_w_constructors.t
@@ -1,239 +1,299 @@
-#!/usr/bin/perl
-
 use strict;
 use warnings;
 
-use Test::More tests => 73;
+use Test::More tests => 91;
 use Test::Exception;
 
-BEGIN {
-    use_ok('Class::MOP');
-    use_ok('Class::MOP::Immutable');    
+BEGIN {use Class::MOP;use Class::MOP::Immutable;
 }
 
 {
     package Foo;
-    
+
     use strict;
     use warnings;
     use metaclass;
-    
+
     __PACKAGE__->meta->add_attribute('bar' => (
         reader  => 'bar',
         default => 'BAR',
     ));
-    
+
     package Bar;
-    
+
     use strict;
     use warnings;
     use metaclass;
-    
+
     __PACKAGE__->meta->superclasses('Foo');
 
     __PACKAGE__->meta->add_attribute('baz' => (
         reader  => 'baz',
         default => sub { 'BAZ' },
-    ));    
-    
+    ));
+
     package Baz;
-    
+
     use strict;
     use warnings;
     use metaclass;
-    
+
     __PACKAGE__->meta->superclasses('Bar');
 
     __PACKAGE__->meta->add_attribute('bah' => (
         reader  => 'bah',
         default => 'BAH',
-    ));    
+    ));
+
+    package Buzz;
+
+    use strict;
+    use warnings;
+    use metaclass;
+
+
+    __PACKAGE__->meta->add_attribute('bar' => (
+        accessor  => 'bar',
+        predicate => 'has_bar',
+        clearer   => 'clear_bar',
+    ));
+
+    __PACKAGE__->meta->add_attribute('bah' => (
+        accessor  => 'bah',
+        predicate => 'has_bah',
+        clearer   => 'clear_bah',
+        default   => 'BAH'
+    ));
+
 }
 
 {
     my $meta = Foo->meta;
     is($meta->name, 'Foo', '... checking the Foo metaclass');
-    
+
     {
         my $bar_accessor = $meta->get_method('bar');
         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
-        isa_ok($bar_accessor, 'Class::MOP::Method');    
-    
-        ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');    
+        isa_ok($bar_accessor, 'Class::MOP::Method');
+
+        ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
     }
-    
-    ok(!$meta->is_immutable, '... our class is not immutable');    
+
+    ok(!$meta->is_immutable, '... our class is not immutable');
 
     lives_ok {
         $meta->make_immutable(
             inline_constructor => 1,
-            inline_accessors   => 0,            
+            inline_accessors   => 0,
         );
     } '... changed Foo to be immutable';
 
-    ok($meta->is_immutable, '... our class is now immutable');        
-    isa_ok($meta, 'Class::MOP::Class');    
-    
+    ok($meta->is_immutable, '... our class is now immutable');
+    isa_ok($meta, 'Class::MOP::Class');
+
     # they made a constructor for us :)
     can_ok('Foo', 'new');
-    
+
     {
         my $foo = Foo->new;
         isa_ok($foo, 'Foo');
         is($foo->bar, 'BAR', '... got the right default value');
     }
-    
+
     {
         my $foo = Foo->new(bar => 'BAZ');
         isa_ok($foo, 'Foo');
         is($foo->bar, 'BAZ', '... got the right parameter value');
-    }    
+    }
+
+    # NOTE:
+    # check that the constructor correctly handles inheritance
+    {
+        my $bar = Bar->new();
+        isa_ok($bar, 'Bar');
+        isa_ok($bar, 'Foo');
+        is($bar->bar, 'BAR', '... got the right inherited parameter value');
+        is($bar->baz, 'BAZ', '... got the right inherited parameter value');
+    }
 
     # check out accessors too
     {
         my $bar_accessor = $meta->get_method('bar');
         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
-        isa_ok($bar_accessor, 'Class::MOP::Method');    
-    
-        ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');    
+        isa_ok($bar_accessor, 'Class::MOP::Method');
+
+        ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
     }
 }
 
 {
     my $meta = Bar->meta;
     is($meta->name, 'Bar', '... checking the Bar metaclass');
-    
+
     {
         my $bar_accessor = $meta->find_method_by_name('bar');
         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
-        isa_ok($bar_accessor, 'Class::MOP::Method');    
-    
-        ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');  
-        
+        isa_ok($bar_accessor, 'Class::MOP::Method');
+
+        ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
+
         my $baz_accessor = $meta->get_method('baz');
         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
-        isa_ok($baz_accessor, 'Class::MOP::Method');    
-    
-        ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');          
+        isa_ok($baz_accessor, 'Class::MOP::Method');
+
+        ok(!$baz_accessor->is_inline, '... the baz accessor is not inlined');
     }
-    
-    ok(!$meta->is_immutable, '... our class is not immutable');    
+
+    ok(!$meta->is_immutable, '... our class is not immutable');
 
     lives_ok {
         $meta->make_immutable(
             inline_constructor => 1,
-            inline_accessors   => 1,     
+            inline_accessors   => 1,
         );
     } '... changed Bar to be immutable';
 
-    ok($meta->is_immutable, '... our class is now immutable');        
-    isa_ok($meta, 'Class::MOP::Class');    
-    
+    ok($meta->is_immutable, '... our class is now immutable');
+    isa_ok($meta, 'Class::MOP::Class');
+
     # they made a constructor for us :)
     can_ok('Bar', 'new');
-    
+
     {
         my $bar = Bar->new;
         isa_ok($bar, 'Bar');
         is($bar->bar, 'BAR', '... got the right default value');
-        is($bar->baz, 'BAZ', '... got the right default value');        
+        is($bar->baz, 'BAZ', '... got the right default value');
     }
-    
+
     {
         my $bar = Bar->new(bar => 'BAZ!', baz => 'BAR!');
         isa_ok($bar, 'Bar');
         is($bar->bar, 'BAZ!', '... got the right parameter value');
-        is($bar->baz, 'BAR!', '... got the right parameter value');        
-    }    
+        is($bar->baz, 'BAR!', '... got the right parameter value');
+    }
 
     # check out accessors too
     {
         my $bar_accessor = $meta->find_method_by_name('bar');
         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
-        isa_ok($bar_accessor, 'Class::MOP::Method');    
-    
-        ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');    
-        
+        isa_ok($bar_accessor, 'Class::MOP::Method');
+
+        ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
+
         my $baz_accessor = $meta->get_method('baz');
         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
-        isa_ok($baz_accessor, 'Class::MOP::Method');    
-    
-        ok($baz_accessor->is_inline, '... the baz accessor is not inlined');        
+        isa_ok($baz_accessor, 'Class::MOP::Method');
+
+        ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
     }
 }
 
 {
     my $meta = Baz->meta;
     is($meta->name, 'Baz', '... checking the Bar metaclass');
-    
+
     {
         my $bar_accessor = $meta->find_method_by_name('bar');
         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
-        isa_ok($bar_accessor, 'Class::MOP::Method');    
-    
-        ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');  
-        
+        isa_ok($bar_accessor, 'Class::MOP::Method');
+
+        ok(!$bar_accessor->is_inline, '... the bar accessor is not inlined');
+
         my $baz_accessor = $meta->find_method_by_name('baz');
         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
-        isa_ok($baz_accessor, 'Class::MOP::Method');    
-    
-        ok($baz_accessor->is_inline, '... the baz accessor is inlined');          
-        
+        isa_ok($baz_accessor, 'Class::MOP::Method');
+
+        ok($baz_accessor->is_inline, '... the baz accessor is inlined');
+
         my $bah_accessor = $meta->get_method('bah');
         isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
-        isa_ok($bah_accessor, 'Class::MOP::Method');    
-    
-        ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');        
+        isa_ok($bah_accessor, 'Class::MOP::Method');
+
+        ok(!$bah_accessor->is_inline, '... the baz accessor is not inlined');
     }
-    
-    ok(!$meta->is_immutable, '... our class is not immutable');    
+
+    ok(!$meta->is_immutable, '... our class is not immutable');
 
     lives_ok {
         $meta->make_immutable(
             inline_constructor => 0,
-            inline_accessors   => 1,     
+            inline_accessors   => 1,
         );
     } '... changed Bar to be immutable';
 
-    ok($meta->is_immutable, '... our class is now immutable');        
-    isa_ok($meta, 'Class::MOP::Class');    
-    
+    ok($meta->is_immutable, '... our class is now immutable');
+    isa_ok($meta, 'Class::MOP::Class');
+
     ok(!Baz->meta->has_method('new'), '... no constructor was made');
-    
+
     {
-        my $baz = Baz->meta->construct_instance;
+        my $baz = Baz->meta->new_object;
         isa_ok($baz, 'Bar');
         is($baz->bar, 'BAR', '... got the right default value');
-        is($baz->baz, 'BAZ', '... got the right default value');        
+        is($baz->baz, 'BAZ', '... got the right default value');
     }
-    
+
     {
-        my $baz = Baz->meta->construct_instance(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
+        my $baz = Baz->meta->new_object(bar => 'BAZ!', baz => 'BAR!', bah => 'BAH!');
         isa_ok($baz, 'Baz');
         is($baz->bar, 'BAZ!', '... got the right parameter value');
         is($baz->baz, 'BAR!', '... got the right parameter value');
-        is($baz->bah, 'BAH!', '... got the right parameter value');                
-    }    
+        is($baz->bah, 'BAH!', '... got the right parameter value');
+    }
 
     # check out accessors too
     {
         my $bar_accessor = $meta->find_method_by_name('bar');
         isa_ok($bar_accessor, 'Class::MOP::Method::Accessor');
-        isa_ok($bar_accessor, 'Class::MOP::Method');    
-    
-        ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');    
-        
+        isa_ok($bar_accessor, 'Class::MOP::Method');
+
+        ok(!$bar_accessor->is_inline, '... the bar accessor is still not inlined');
+
         my $baz_accessor = $meta->find_method_by_name('baz');
         isa_ok($baz_accessor, 'Class::MOP::Method::Accessor');
-        isa_ok($baz_accessor, 'Class::MOP::Method');    
-    
-        ok($baz_accessor->is_inline, '... the baz accessor is not inlined');  
+        isa_ok($baz_accessor, 'Class::MOP::Method');
+
+        ok($baz_accessor->is_inline, '... the baz accessor is not inlined');
 
         my $bah_accessor = $meta->get_method('bah');
         isa_ok($bah_accessor, 'Class::MOP::Method::Accessor');
-        isa_ok($bah_accessor, 'Class::MOP::Method');    
-    
-        ok($bah_accessor->is_inline, '... the baz accessor is not inlined');        
+        isa_ok($bah_accessor, 'Class::MOP::Method');
+
+        ok($bah_accessor->is_inline, '... the baz accessor is not inlined');
     }
 }
 
+
+{
+  my $buzz;
+  ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
+  ::ok(!$buzz->has_bar, '...bar is not set');
+  ::is($buzz->bar, undef, '...bar returns undef');
+  ::ok(!$buzz->has_bar, '...bar was not autovivified');
+
+  $buzz->bar(undef);
+  ::ok($buzz->has_bar, '...bar is set');
+  ::is($buzz->bar, undef, '...bar is undef');
+  $buzz->clear_bar;
+  ::ok(!$buzz->has_bar, '...bar is no longerset');
+
+  my $buzz2;
+  ::lives_ok { $buzz2 = Buzz->meta->new_object('bar' => undef) } '...Buzz instantiated successfully';
+  ::ok($buzz2->has_bar, '...bar is set');
+  ::is($buzz2->bar, undef, '...bar is undef');
+
+}
+
+{
+  my $buzz;
+  ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
+  ::ok($buzz->has_bah, '...bah is set');
+  ::is($buzz->bah, 'BAH', '...bah returns "BAH"' );
+
+  my $buzz2;
+  ::lives_ok { $buzz2 = Buzz->meta->new_object('bah' => undef) } '...Buzz instantiated successfully';
+  ::ok($buzz2->has_bah, '...bah is set');
+  ::is($buzz2->bah, undef, '...bah is undef');
+
+}