From: Stevan Little <stevan.little@iinteractive.com>
Date: Thu, 2 Feb 2006 15:30:24 +0000 (+0000)
Subject: updating the test numbers and adding the CountingClass test
X-Git-Tag: 0_02~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1a7ebbb3e44301a39a8b5c57542ca8ae76a3e2d0;p=gitmo%2FClass-MOP.git

updating the test numbers and adding the CountingClass test
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index f77dc25..4c56ef7 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -21,6 +21,13 @@ sub import {
             Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) 
         };
     }
+    else {
+        my $pkg = caller();
+        no strict 'refs';
+        *{$pkg . '::' . $_[0]} = sub { 
+            Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) 
+        };        
+    }
 }
 
 ## ----------------------------------------------------------------------------
@@ -82,18 +89,6 @@ Class::MOP::Attribute->meta->add_method('new' => sub {
     bless $class->meta->construct_instance(name => $name, %options) => $class;
 });
 
-# NOTE: (meta-circularity)
-# This is how we "tie the knot" for the class
-# meta-objects. This is used to construct the
-# Class::MOP::Class instances after all the 
-# bootstrapping is complete.
-Class::MOP::Class->meta->add_method('construct_class_instance' => sub {
-    my ($class, $package_name) = @_;
-    (defined $package_name && $package_name)
-        || confess "You must pass a package name";      
-    bless Class::MOP::Class->meta->construct_instance(':pkg' => $package_name) => blessed($class) || $class        
-});
-
 1;
 
 __END__
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 9a83438..3832bef 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -34,17 +34,23 @@ sub meta { $_[0]->initialize($_[0]) }
     # NOTE: (meta-circularity) 
     # this is a special form of &construct_instance 
     # (see below), which is used to construct class
-    # meta-object instances. It will be replaces in 
-    # the bootstrap section in Class::MOP with one 
-    # which uses the normal &construct_instance.
+    # meta-object instances for any Class::MOP::* 
+    # class. All other classes will use the more 
+    # normal &construct_instance.
     sub construct_class_instance {
         my ($class, $package_name) = @_;
         (defined $package_name && $package_name)
-            || confess "You must pass a package name";        
-        bless { 
-            '$:pkg'   => $package_name, 
-            '%:attrs' => {} 
-        } => blessed($class) || $class        
+            || confess "You must pass a package name";    
+        $class = blessed($class) || $class;
+        if ($class =~ /^Class::MOP::/) {    
+            bless { 
+                '$:pkg'   => $package_name, 
+                '%:attrs' => {} 
+            } => $class;
+        }
+        else {
+            bless $class->meta->construct_instance(':pkg' => $package_name) => $class
+        }
     }
 }
 
diff --git a/t/000_load.t b/t/000_load.t
index 4836c63..b9311a2 100644
--- a/t/000_load.t
+++ b/t/000_load.t
@@ -3,10 +3,10 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 4;
 
 BEGIN {
-    use_ok('Class::MOP' => '-> this-is-ignored :)');
+    use_ok('Class::MOP');
     use_ok('Class::MOP::Class');
     use_ok('Class::MOP::Attribute');
     use_ok('Class::MOP::Method');            
diff --git a/t/001_basic.t b/t/001_basic.t
index b04bd54..55f443c 100644
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 19;
 use Test::Exception;
 
 BEGIN {
diff --git a/t/002_class_precedence_list.t b/t/002_class_precedence_list.t
index aa0d367..06142bd 100644
--- a/t/002_class_precedence_list.t
+++ b/t/002_class_precedence_list.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 6;
 
 BEGIN {
     use_ok('Class::MOP');   
diff --git a/t/003_methods.t b/t/003_methods.t
index 0bfe252..0353ba8 100644
--- a/t/003_methods.t
+++ b/t/003_methods.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 38;
 use Test::Exception;
 
 BEGIN {
diff --git a/t/004_advanced_methods.t b/t/004_advanced_methods.t
index f3a3d49..83efe42 100644
--- a/t/004_advanced_methods.t
+++ b/t/004_advanced_methods.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 9;
 use Test::Exception;
 
 BEGIN {
diff --git a/t/005_attributes.t b/t/005_attributes.t
index 80d38f7..0779a77 100644
--- a/t/005_attributes.t
+++ b/t/005_attributes.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 30;
 use Test::Exception;
 
 BEGIN { 
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index ebb51cd..67ced97 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 56;
 use Test::Exception;
 
 BEGIN {
diff --git a/t/011_create_class.t b/t/011_create_class.t
index 66cb130..008cfa3 100644
--- a/t/011_create_class.t
+++ b/t/011_create_class.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 27;
 use Test::Exception;
 
 BEGIN {
diff --git a/t/020_attribute.t b/t/020_attribute.t
index 3051fb6..d23820d 100644
--- a/t/020_attribute.t
+++ b/t/020_attribute.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 64;
 use Test::Exception;
 
 BEGIN {
diff --git a/t/030_method.t b/t/030_method.t
index 82b19bb..87ec1c5 100644
--- a/t/030_method.t
+++ b/t/030_method.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 1;
+use Test::More tests => 9;
 use Test::Exception;
 
 BEGIN {
diff --git a/t/101_CountingClass_test.t b/t/101_CountingClass_test.t
new file mode 100644
index 0000000..0029e5c
--- /dev/null
+++ b/t/101_CountingClass_test.t
@@ -0,0 +1,57 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+
+BEGIN { 
+    use_ok('Class::MOP');    
+    use_ok('t::lib::CountingClass');
+}
+
+=pod
+
+This is a trivial and contrived example of how to 
+make a metaclass which will count all the instances
+created. It is not meant to be anything more than 
+a simple demonstration of how to make a metaclass.
+
+=cut
+
+{
+    package Foo;
+    
+    sub meta { CountingClass->initialize($_[0]) }
+    sub new  {
+        my $class = shift;
+        bless $class->meta->construct_instance() => $class;
+    }
+    
+    package Bar;
+    
+    our @ISA = ('Foo');
+}
+
+is(Foo->meta->get_count(), 0, '... our Foo count is 0');
+is(Bar->meta->get_count(), 0, '... our Bar count is 0');
+
+my $foo = Foo->new();
+isa_ok($foo, 'Foo');
+
+is(Foo->meta->get_count(), 1, '... our Foo count is now 1');
+is(Bar->meta->get_count(), 0, '... our Bar count is still 0');
+
+my $bar = Bar->new();
+isa_ok($bar, 'Bar');
+
+is(Foo->meta->get_count(), 1, '... our Foo count is still 1');
+is(Bar->meta->get_count(), 1, '... our Bar count is now 1');
+
+for (2 .. 10) {
+    Foo->new();
+}
+
+is(Foo->meta->get_count(), 10, '... our Foo count is now 10');    
+is(Bar->meta->get_count(), 1, '... our Bar count is still 1');
+
diff --git a/t/lib/BinaryTree.pm b/t/lib/BinaryTree.pm
index 04c0e3f..7ba63d1 100644
--- a/t/lib/BinaryTree.pm
+++ b/t/lib/BinaryTree.pm
@@ -1,11 +1,11 @@
 
-use Class::MOP ':universal';
-
 package BinaryTree;
 
 use strict;
 use warnings;
 
+use Class::MOP 'meta';
+
 our $VERSION = '0.01';
 
 __PACKAGE__->meta->add_attribute(
diff --git a/t/lib/CountingClass.pm b/t/lib/CountingClass.pm
new file mode 100644
index 0000000..36935ff
--- /dev/null
+++ b/t/lib/CountingClass.pm
@@ -0,0 +1,26 @@
+
+package CountingClass;
+
+use strict;
+use warnings;
+
+use Class::MOP 'meta';
+
+our $VERSION = '0.01';
+
+__PACKAGE__->meta->superclasses('Class::MOP::Class');
+
+__PACKAGE__->meta->add_attribute(
+    Class::MOP::Attribute->new('$:count' => (
+        reader  => 'get_count',
+        default => 0
+    ))
+);
+
+sub construct_instance {
+    my ($class, %params) = @_;
+    $class->{'$:count'}++;
+    return $class->SUPER::construct_instance();
+}
+
+1;
\ No newline at end of file