tests and changelog

diff --git a/Changes b/Changes
index 7806341..41d0d9e 100644 (file)
--- a/Changes
+++ b/Changes
@@ -9,9 +9,22 @@ Revision history for Perl extension Class-MOP.
 
     * Class::MOP::Attribute
       - Add support for the 'builder' attribute (groditi)
+      - Make predicates check for the existence of a value, not whether 
+        it is defined
+
+    * Class::MOP::Instance
+      - Make predicates check for the existence of a value, not whether 
+        it is defined
+
+    * Class::MOP::Method::Constructor
+      - Update inlined methods for builder and predicate changes  
 
     *t/
       - Alter tests (005, 014 020, 021) for new builder addition
+      - Tests for new predicate behavior (and corrections to old tests) 
+
+    *examples/
+      - Update ArrayRef based class example to work with predicate changes
 
 0.43
     * Class::MOP::Method::Accessor 

diff --git a/t/005_attributes.t b/t/005_attributes.t
index 40cd712..62d54f4 100644 (file)
--- a/t/005_attributes.t
+++ b/t/005_attributes.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 54;
+use Test::More tests => 71;
 use Test::Exception;
 
 BEGIN {
@@ -183,6 +183,31 @@ is($BAZ_ATTR->name, '$baz', '... got the attributes name correctly');
     } '... we added an attribute to Buzz successfully';
 
     ::lives_ok {
+        $meta->add_attribute(
+            Class::MOP::Attribute->new(
+                 '$bar' => (
+                            accessor  => 'bar',
+                            predicate => 'has_bar',
+                            clearer   => 'clear_bar',
+                           )
+                )
+        );
+    } '... we added an attribute to Buzz successfully';
+
+    ::lives_ok {
+        $meta->add_attribute(
+            Class::MOP::Attribute->new(
+                 '$bah' => (
+                            accessor  => 'bah',
+                            predicate => 'has_bah',
+                            clearer   => 'clear_bah',
+                            default   => 'BAH',
+                           )
+                )
+        );
+    } '... we added an attribute to Buzz successfully';
+
+    ::lives_ok {
         $meta->add_method(build_foo => sub{ blessed shift; });
     } '... we added a method to Buzz successfully';
 }
@@ -190,5 +215,33 @@ is($BAZ_ATTR->name, '$baz', '... got the attributes name correctly');
 {
   my $buzz;
   ::lives_ok { $buzz = Buzz->meta->new_object } '...Buzz instantiated successfully';
-  ::is($buzz->foo, 'Buzz', 'foo builder works as expected');
+  ::is($buzz->foo, 'Buzz', '...foo builder works as expected');
+  ::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');
+
 }

diff --git a/t/072_immutable_w_constructors.t b/t/072_immutable_w_constructors.t
index cfa7d77..cc9c929 100644 (file)
--- a/t/072_immutable_w_constructors.t
+++ b/t/072_immutable_w_constructors.t
@@ -3,247 +3,301 @@
 use strict;
 use warnings;
 
-use Test::More tests => 77;
+use Test::More tests => 93;
 use Test::Exception;
 
 BEGIN {
     use_ok('Class::MOP');
-    use_ok('Class::MOP::Immutable');    
+    use_ok('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');        
+        isa_ok($bar, 'Foo');
         is($bar->bar, 'BAR', '... got the right inherited parameter value');
-        is($bar->baz, 'BAZ', '... 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;
         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!');
         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');
+
+}