From: Stevan Little <stevan.little@iinteractive.com>
Date: Tue, 14 Feb 2006 22:41:24 +0000 (+0000)
Subject: getting ready for a 0.07 release
X-Git-Tag: 0_10~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=222860635b059db73389c69475bccc62dfa753a4;hp=013b1897ada42ebdd970371868cc3679d3a49344;p=gitmo%2FClass-MOP.git

getting ready for a 0.07 release
---

diff --git a/Changes b/Changes
index 3ff423c..75cbf1b 100644
--- a/Changes
+++ b/Changes
@@ -1,13 +1,23 @@
 Revision history for Perl extension Class-MOP.
 
 0.07
-    - adding more tests
+    - adding more tests to get coverage up a little higher,
+      mostly testing errors and edge cases.
+      - test coverage is now at 99%
       
     * Class::MOP
       - no longer optionally exports to UNIVERSAL::meta or
         creates a custom metaclass generator, use the 
         metaclass pragma instead.
-      
+
+    * Class::MOP::Class  
+      - fixed a number of minor issues which came up in the 
+        error/edge-case tests
+        
+    * Class::MOP::Attribute 
+      - fixed a number of minor issues which came up in the 
+        error/edge-case tests        
+     
     * examples/
       - fixing the AttributesWithHistory example, it was broken.
 
diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 4c8da02..a3c6298 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -407,6 +407,23 @@ All complex software has bugs lurking in it, and this module is no
 exception. If you find a bug please either email me, or add the bug
 to cpan-RT.
 
+=head1 CODE COVERAGE
+
+I use L<Devel::Cover> to test the code coverage of my tests, below is the 
+L<Devel::Cover> report on this module's test suite.
+
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+ File                           stmt   bran   cond    sub    pod   time  total
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+ Class/MOP.pm                  100.0  100.0  100.0  100.0    n/a   21.4  100.0
+ Class/MOP/Attribute.pm        100.0  100.0   88.9  100.0  100.0   27.1   99.3
+ Class/MOP/Class.pm            100.0  100.0   93.7  100.0  100.0   44.8   99.1
+ Class/MOP/Method.pm           100.0  100.0   83.3  100.0  100.0    4.8   97.1
+ metaclass.pm                  100.0  100.0   80.0  100.0    n/a    1.9   97.3
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+ Total                         100.0  100.0   92.2  100.0  100.0  100.0   99.0
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+
 =head1 ACKNOWLEDGEMENTS
 
 =over 4
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 2baa6f3..b699f11 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -28,10 +28,8 @@ sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
     sub initialize {
         my $class        = shift;
         my $package_name = shift;
-        (defined $package_name && $package_name)
-            || confess "You must pass a package name";    
-        # make sure the package name is not blessed
-        $package_name = blessed($package_name) || $package_name;
+        (defined $package_name && $package_name && !blessed($package_name))
+            || confess "You must pass a package name and it cannot be blessed";    
         $class->construct_class_instance(':package' => $package_name, @_);
     }
     
@@ -252,8 +250,7 @@ sub add_method {
         
     no strict 'refs';
     no warnings 'redefine';
-#    *{$full_method_name} = subname $full_method_name => $method;
-    *{$full_method_name} = $method;
+    *{$full_method_name} = subname $full_method_name => $method;
 }
 
 sub alias_method {
@@ -401,7 +398,8 @@ sub get_attribute {
     (defined $attribute_name && $attribute_name)
         || confess "You must define an attribute name";
     return $self->get_attribute_map->{$attribute_name} 
-        if $self->has_attribute($attribute_name);    
+        if $self->has_attribute($attribute_name);   
+    return; 
 } 
 
 sub remove_attribute {
@@ -409,8 +407,8 @@ sub remove_attribute {
     (defined $attribute_name && $attribute_name)
         || confess "You must define an attribute name";
     my $removed_attribute = $self->get_attribute_map->{$attribute_name};    
-    delete $self->get_attribute_map->{$attribute_name} 
-        if defined $removed_attribute;        
+    return unless defined $removed_attribute;
+    delete $self->get_attribute_map->{$attribute_name};        
     $removed_attribute->remove_accessors();        
     $removed_attribute->detach_from_class();    
     return $removed_attribute;
diff --git a/lib/metaclass.pm b/lib/metaclass.pm
index 39fea4b..819bdac 100644
--- a/lib/metaclass.pm
+++ b/lib/metaclass.pm
@@ -4,9 +4,10 @@ package metaclass;
 use strict;
 use warnings;
 
-use Carp 'confess';
+use Carp         'confess';
+use Scalar::Util 'blessed';
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 use Class::MOP;
 
@@ -27,7 +28,7 @@ sub import {
         # since metaclass instances are 
         # singletons, this is not really a 
         # big deal anyway.
-        $metaclass->initialize($_[0] => %options)
+        $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
     });
 }
 
diff --git a/t/004_advanced_methods.t b/t/004_advanced_methods.t
index 83efe42..7ae9019 100644
--- a/t/004_advanced_methods.t
+++ b/t/004_advanced_methods.t
@@ -36,7 +36,6 @@ A more real-world example would be a nice addition :)
     package Baz;
     our @ISA = ('Bar');
     
-    sub BUILD { 'Baz::BUILD' }    
     sub baz { 'Baz::baz' }
     sub foo { 'Baz::foo' }           
     
@@ -94,11 +93,11 @@ is_deeply(
 
 is_deeply(
     [ sort { $a->{name} cmp $b->{name} } Class::MOP::Class->initialize('Baz')->compute_all_applicable_methods() ],
-    [
+    [   
         {
             name  => 'BUILD',
-            class => 'Baz',
-            code  => \&Baz::BUILD 
+            class => 'Bar',
+            code  => \&Bar::BUILD 
         },    
         {
             name  => 'bar',
@@ -215,11 +214,6 @@ is_deeply(
             name  => 'BUILD',
             class => 'Bar',
             code  => \&Bar::BUILD 
-        },    
-        {
-            name  => 'BUILD',
-            class => 'Baz',
-            code  => \&Baz::BUILD 
-        },        
+        },            
     ],
     '... got the right list of BUILD methods for Foo::Bar::Baz');
\ No newline at end of file
diff --git a/t/005_attributes.t b/t/005_attributes.t
index 4b5c747..d1ac414 100644
--- a/t/005_attributes.t
+++ b/t/005_attributes.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 33;
+use Test::More tests => 40;
 use Test::Exception;
 
 BEGIN { 
@@ -19,6 +19,8 @@ my $BAZ_ATTR = Class::MOP::Attribute->new('$baz' => (
     writer => 'set_baz',    
 ));
 
+my $BAR_ATTR_2 = Class::MOP::Attribute->new('$bar');
+
 {
     package Foo;
     use metaclass;
@@ -31,6 +33,14 @@ my $BAZ_ATTR = Class::MOP::Attribute->new('$baz' => (
     ::is($meta->get_attribute('$foo'), $FOO_ATTR, '... got the right attribute back for Foo');
     
     ::ok(!$meta->has_method('foo'), '... no accessor created');
+    
+    ::lives_ok {
+        $meta->add_attribute($BAR_ATTR_2);
+    } '... we added an attribute to Foo successfully';
+    ::ok($meta->has_attribute('$bar'), '... Foo has $bar attribute');
+    ::is($meta->get_attribute('$bar'), $BAR_ATTR_2, '... got the right attribute back for Foo'); 
+
+    ::ok(!$meta->has_method('bar'), '... no accessor created');
 }
 {
     package Bar;
@@ -44,7 +54,7 @@ my $BAZ_ATTR = Class::MOP::Attribute->new('$baz' => (
     ::is($meta->get_attribute('$bar'), $BAR_ATTR, '... got the right attribute back for Bar');
 
     ::ok($meta->has_method('bar'), '... an accessor has been created');
-    ::isa_ok($meta->get_method('bar'), 'Class::MOP::Attribute::Accessor');    
+    ::isa_ok($meta->get_method('bar'), 'Class::MOP::Attribute::Accessor');      
 }
 {
     package Baz;
@@ -89,6 +99,7 @@ my $BAZ_ATTR = Class::MOP::Attribute->new('$baz' => (
     is($attr, $BAZ_ATTR, '... got the right attribute back for Baz');           
     
     ok(!$meta->has_attribute('$baz'), '... Baz no longer has $baz attribute'); 
+    is($meta->get_attribute('$baz'), undef, '... Baz no longer has $baz attribute');     
 
     ok(!$meta->has_method('get_baz'), '... a reader has been removed');
     ok(!$meta->has_method('set_baz'), '... a writer has been removed');
@@ -121,13 +132,21 @@ my $BAZ_ATTR = Class::MOP::Attribute->new('$baz' => (
      is_deeply(
          [ sort { $a->name cmp $b->name } $meta->compute_all_applicable_attributes() ],
          [ 
+             $BAR_ATTR_2,
              $FOO_ATTR,                        
          ],
          '... got the right list of applicable attributes for Baz');
 
      is_deeply(
          [ map { $_->associated_class } sort { $a->name cmp $b->name } $meta->compute_all_applicable_attributes() ],
-         [ Foo->meta ],
+         [ Foo->meta, Foo->meta ],
          '... got the right list of associated classes from the applicable attributes for Baz');
 
+    # remove attribute which is not there
+    my $val;
+    lives_ok {
+        $val = $meta->remove_attribute('$blammo');
+    } '... attempted to remove the non-existent $blammo attribute';
+    is($val, undef, '... got the right value back (undef)');
+
 }
diff --git a/t/016_class_errors_and_edge_cases.t b/t/016_class_errors_and_edge_cases.t
index b9b3915..ec90053 100644
--- a/t/016_class_errors_and_edge_cases.t
+++ b/t/016_class_errors_and_edge_cases.t
@@ -3,9 +3,258 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 53;
 use Test::Exception;
 
 BEGIN {
     use_ok('Class::MOP');
-}
\ No newline at end of file
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->initialize();
+    } '... initialize requires a name parameter';
+    
+    dies_ok {
+        Class::MOP::Class->initialize('');
+    } '... initialize requires a name valid parameter';    
+
+    dies_ok {
+        Class::MOP::Class->initialize(bless {} => 'Foo');
+    } '... initialize requires an unblessed parameter'
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->construct_class_instance();
+    } '... construct_class_instance requires an :package parameter';
+    
+    dies_ok {
+        Class::MOP::Class->construct_class_instance(':package' => undef);
+    } '... construct_class_instance requires a defined :package parameter';     
+    
+    dies_ok {
+        Class::MOP::Class->construct_class_instance(':package' => '');
+    } '... construct_class_instance requires a valid :package parameter'; 
+}
+
+
+{
+    dies_ok {
+        Class::MOP::Class->create();
+    } '... create requires an package_name parameter';
+    
+    dies_ok {
+        Class::MOP::Class->create(undef);
+    } '... create requires a defined package_name parameter';    
+    
+    dies_ok {
+        Class::MOP::Class->create('');
+    } '... create requires a valid package_name parameter';    
+    
+    throws_ok {
+        Class::MOP::Class->create('+++');
+    } qr/^creation of \+\+\+ failed/, '... create requires a valid package_name parameter';    
+     
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->clone_object(1);
+    } '... can only clone instances';
+    
+    dies_ok {
+        Class::MOP::Class->clone_instance(1);
+    } '... can only clone instances';    
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->add_method();
+    } '... add_method dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->add_method('');
+    } '... add_method dies as expected';   
+
+    dies_ok {
+        Class::MOP::Class->add_method('foo' => 'foo');
+    } '... add_method dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->add_method('foo' => []);
+    } '... add_method dies as expected';     
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->alias_method();
+    } '... alias_method dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->alias_method('');
+    } '... alias_method dies as expected';   
+
+    dies_ok {
+        Class::MOP::Class->alias_method('foo' => 'foo');
+    } '... alias_method dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->alias_method('foo' => []);
+    } '... alias_method dies as expected';     
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->has_method();
+    } '... has_method dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->has_method('');
+    } '... has_method dies as expected';
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->get_method();
+    } '... get_method dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->get_method('');
+    } '... get_method dies as expected';
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->remove_method();
+    } '... remove_method dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->remove_method('');
+    } '... remove_method dies as expected';
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->find_all_methods_by_name();
+    } '... find_all_methods_by_name dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->find_all_methods_by_name('');
+    } '... find_all_methods_by_name dies as expected';
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->add_attribute(bless {} => 'Foo');
+    } '... add_attribute dies as expected';
+}
+
+
+{
+    dies_ok {
+        Class::MOP::Class->has_attribute();
+    } '... has_attribute dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->has_attribute('');
+    } '... has_attribute dies as expected';
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->get_attribute();
+    } '... get_attribute dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->get_attribute('');
+    } '... get_attribute dies as expected';
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->remove_attribute();
+    } '... remove_attribute dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->remove_attribute('');
+    } '... remove_attribute dies as expected';
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->add_package_variable();
+    } '... add_package_variable dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->add_package_variable('');
+    } '... add_package_variable dies as expected';
+    
+    dies_ok {
+        Class::MOP::Class->add_package_variable('foo');
+    } '... add_package_variable dies as expected';  
+    
+    dies_ok {
+        Class::MOP::Class->add_package_variable('&foo');
+    } '... add_package_variable dies as expected';      
+    
+    throws_ok {
+        Class::MOP::Class->meta->add_package_variable('@-');
+    } qr/^Could not create package variable \(\@\-\) because/, 
+      '... add_package_variable dies as expected';    
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->has_package_variable();
+    } '... has_package_variable dies as expected';
+
+    dies_ok {
+        Class::MOP::Class->has_package_variable('');
+    } '... has_package_variable dies as expected';
+
+    dies_ok {
+        Class::MOP::Class->has_package_variable('foo');
+    } '... has_package_variable dies as expected';  
+
+    dies_ok {
+        Class::MOP::Class->has_package_variable('&foo');
+    } '... has_package_variable dies as expected';    
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->get_package_variable();
+    } '... get_package_variable dies as expected';
+
+    dies_ok {
+        Class::MOP::Class->get_package_variable('');
+    } '... get_package_variable dies as expected';
+
+    dies_ok {
+        Class::MOP::Class->get_package_variable('foo');
+    } '... get_package_variable dies as expected';  
+
+    dies_ok {
+        Class::MOP::Class->get_package_variable('&foo');
+    } '... get_package_variable dies as expected';    
+}
+
+{
+    dies_ok {
+        Class::MOP::Class->remove_package_variable();
+    } '... remove_package_variable dies as expected';
+
+    dies_ok {
+        Class::MOP::Class->remove_package_variable('');
+    } '... remove_package_variable dies as expected';
+
+    dies_ok {
+        Class::MOP::Class->remove_package_variable('foo');
+    } '... remove_package_variable dies as expected';  
+
+    dies_ok {
+        Class::MOP::Class->remove_package_variable('&foo');
+    } '... remove_package_variable dies as expected';    
+}
+
diff --git a/t/020_attribute.t b/t/020_attribute.t
index a85579d..539bb51 100644
--- a/t/020_attribute.t
+++ b/t/020_attribute.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 52;
+use Test::More tests => 58;
 use Test::Exception;
 
 BEGIN {
@@ -113,3 +113,18 @@ BEGIN {
     
     is_deeply($attr, $attr_clone, '... but they are the same inside');       
 }
+
+{
+    my $attr = Class::MOP::Attribute->new('$foo');
+    isa_ok($attr, 'Class::MOP::Attribute');
+    
+    my $attr_clone = $attr->clone('name' => '$bar');
+    isa_ok($attr_clone, 'Class::MOP::Attribute');
+    isnt($attr, $attr_clone, '... but they are different instances');
+    
+    isnt($attr->name, $attr_clone->name, '... we changes the name parameter');
+    
+    is($attr->name, '$foo', '... $attr->name == $foo');
+    is($attr_clone->name, '$bar', '... $attr_clone->name == $bar');    
+}
+
diff --git a/t/030_method.t b/t/030_method.t
index de48851..c43cd42 100644
--- a/t/030_method.t
+++ b/t/030_method.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 8;
+use Test::More tests => 9;
 use Test::Exception;
 
 BEGIN {
@@ -11,6 +11,11 @@ BEGIN {
     use_ok('Class::MOP::Method');
 }
 
+{
+    my $method = Class::MOP::Method->wrap(sub { 1 });
+    is($method->meta, Class::MOP::Method->meta, '... instance and class both lead to the same meta');
+}
+
 my $meta = Class::MOP::Method->meta;
 isa_ok($meta, 'Class::MOP::Class');