From: Stevan Little <stevan.little@iinteractive.com>
Date: Fri, 10 Feb 2006 22:50:47 +0000 (+0000)
Subject: getting close to a 0.07 release
X-Git-Tag: 0_10~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=aa448b163f4882fc3e4b92a1c1f22e3c9ad9f933;p=gitmo%2FClass-MOP.git

getting close to a 0.07 release
---

diff --git a/Build.PL b/Build.PL
index 65d3e29..023fd21 100644
--- a/Build.PL
+++ b/Build.PL
@@ -10,7 +10,6 @@ my $build = Module::Build->new(
         'Sub::Name'    => '0.02',
         'Carp'         => '0.01',
         'B'            => '1.09',
-        'B::Deparse'   => '0.70',
         'Clone'        => '0.18',
         'SUPER'        => '1.11',
     },
diff --git a/Changes b/Changes
index 7460150..5508877 100644
--- a/Changes
+++ b/Changes
@@ -2,8 +2,17 @@ Revision history for Perl extension Class-MOP.
 
 0.07
     - adding more tests
+        - test for compatability with Class::C3
     - added SUPER as a dependency (because we need runtime
-      dispatching of SUPER calls for traits)
+      dispatching of SUPER calls for mixins)
+      
+    * Class::MOP
+      - no longer optionally exports to UNIVERSAL::meta or
+        creates a custom metaclass generator, use the 
+        metaclass pragma instead.
+      
+    * Class::MOP::Class
+      - adding in &mixin method to do Scala style mixins
 
 0.06 Thurs Feb. 9, 2006
     * metaclass
diff --git a/examples/AttributesWithHistory.pod b/examples/AttributesWithHistory.pod
index 95c4688..50f855b 100644
--- a/examples/AttributesWithHistory.pod
+++ b/examples/AttributesWithHistory.pod
@@ -80,8 +80,6 @@ AttributesWithHistory - An example attribute metaclass which keeps a history of
   
   package Foo;
   
-  use Class::MOP 'meta';
-  
   Foo->meta->add_attribute(AttributesWithHistory->new('foo' => (
       accessor         => 'foo',
       history_accessor => 'get_foo_history',
diff --git a/examples/ClassEncapsulatedAttributes.pod b/examples/ClassEncapsulatedAttributes.pod
index 80bf6bb..ff486ad 100644
--- a/examples/ClassEncapsulatedAttributes.pod
+++ b/examples/ClassEncapsulatedAttributes.pod
@@ -22,7 +22,7 @@ sub construct_instance {
     foreach my $current_class ($class->class_precedence_list()) {
         $instance->{$current_class} = {} 
             unless exists $instance->{$current_class};
-        my $meta = $class->initialize($current_class);
+        my $meta = $current_class->meta;
         foreach my $attr_name ($meta->get_attribute_list()) {
             my $attr = $meta->get_attribute($attr_name);
             # if the attr has an init_arg, use that, otherwise,
diff --git a/examples/Perl6Attribute.pod b/examples/Perl6Attribute.pod
index 930c6cd..2daffca 100644
--- a/examples/Perl6Attribute.pod
+++ b/examples/Perl6Attribute.pod
@@ -39,8 +39,6 @@ Perl6Attribute - An example attribute metaclass for Perl 6 style attributes
 
   package Foo;
   
-  use Class::MOP 'meta';
-  
   Foo->meta->add_attribute(Perl6Attribute->new('$.foo'));
   Foo->meta->add_attribute(Perl6Attribute->new('@.bar'));    
   Foo->meta->add_attribute(Perl6Attribute->new('%.baz'));    
diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 932c623..4c8da02 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -4,9 +4,8 @@ package Class::MOP;
 use strict;
 use warnings;
 
-use Scalar::Util 'blessed';
 use Carp         'confess';
-use SUPER         ();
+use Scalar::Util ();
 
 use Class::MOP::Class;
 use Class::MOP::Attribute;
@@ -14,22 +13,16 @@ use Class::MOP::Method;
 
 our $VERSION = '0.07';
 
-sub import {
-    shift;
-    return unless @_;
-    if ($_[0] eq ':universal') {
-        *UNIVERSAL::meta = sub { 
-            Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) 
-        };
-    }
-    else {
-        my $pkg = caller();
-        no strict 'refs';
-        *{$pkg . '::' . $_[0]} = sub { 
-            Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) 
-        };        
-    }
-}
+## ----------------------------------------------------------------------------
+## Setting up our environment ...
+## ----------------------------------------------------------------------------
+## Class::MOP needs to have a few things in the global perl environment so 
+## that it can operate effectively. Those things are done here.
+## ----------------------------------------------------------------------------
+
+# so that mixins can have runtime 
+# dispatched SUPER calls
+use SUPER ();
 
 ## ----------------------------------------------------------------------------
 ## Bootstrapping 
@@ -296,6 +289,14 @@ are interested in why this is an issue see the paper
 I<Uniform and safe metaclass composition> linked to in the 
 L<SEE ALSO> section of this document.
 
+=head2 Using custom metaclasses
+
+Always use the metaclass pragma when using a custom metaclass, this 
+will ensure the proper initialization order and not accidentely 
+create an incorrect type of metaclass for you. This is a very rare 
+problem, and one which can only occur if you are doing deep metaclass 
+programming. So in other words, don't worry about it.
+
 =head1 PROTOCOLS
 
 The protocol is divided into 3 main sub-protocols:
diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index dbdc2dc..1dfc3b3 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -7,11 +7,11 @@ use warnings;
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
 
-our $VERSION = '0.03';
+our $VERSION = '0.04';
 
 sub meta { 
     require Class::MOP::Class;
-    Class::MOP::Class->initialize($_[0]) 
+    Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
 }
 
 # NOTE: (meta-circularity)
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 9995dec..28f1923 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -12,9 +12,9 @@ use Clone         ();
 
 our $VERSION = '0.03';
 
-# Self-introspection
+# Self-introspection 
 
-sub meta { Class::MOP::Class->initialize($_[0]) }
+sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]) }
 
 # Creation
 
@@ -101,6 +101,11 @@ sub create {
     eval $code;
     confess "creation of $package_name failed : $@" if $@;    
     my $meta = $class->initialize($package_name);
+    
+    $meta->add_method('meta' => sub { 
+        Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
+    });
+    
     $meta->superclasses(@{$options{superclasses}})
         if exists $options{superclasses};
     # NOTE:
@@ -358,7 +363,7 @@ sub find_all_methods_by_name {
         next if $seen_class{$class};
         $seen_class{$class}++;
         # fetch the meta-class ...
-        my $meta = $self->initialize($class);
+        my $meta = $self->initialize($class);;
         push @methods => {
             name  => $method_name, 
             class => $class,
@@ -493,22 +498,19 @@ sub remove_package_variable {
 
 sub mixin {
     my ($self, $mixin) = @_;
-    $mixin = $self->initialize($mixin) unless blessed($mixin);
+    $mixin = $self->initialize($mixin) 
+        unless blessed($mixin);
     
-    my @attributes = map { $mixin->get_attribute($_)->clone() } 
-                     $mixin->get_attribute_list;
-    my %methods    = map  { 
-                         my $method = $mixin->get_method($_);
-                         if (blessed($method) && $method->isa('Class::MOP::Attribute::Accessor')) {
-                             ();
-                         }
-                         else {
-                             ($_ => $method)
-                         }
-                     } $mixin->get_method_list;    
-
-    # test the superclass thing detailed in the test
+    my @attributes = map { 
+        $mixin->get_attribute($_)->clone() 
+    } $mixin->get_attribute_list;                     
     
+    my %methods = map  { 
+        my $method = $mixin->get_method($_);
+        (blessed($method) && $method->isa('Class::MOP::Attribute::Accessor'))
+            ? () : ($_ => $method)
+    } $mixin->get_method_list;    
+
     foreach my $attr (@attributes) {
         $self->add_attribute($attr) 
             unless $self->has_attribute($attr->name);
@@ -534,11 +536,6 @@ Class::MOP::Class - Class Meta Object
 
   # use this for introspection ...
   
-  package Foo;
-  sub meta { Class::MOP::Class->initialize(__PACKAGE__) }
-  
-  # elsewhere in the code ...
-  
   # add a method to Foo ...
   Foo->meta->add_method('bar' => sub { ... })
   
diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index 75205b2..0df47d0 100644
--- a/lib/Class/MOP/Method.pm
+++ b/lib/Class/MOP/Method.pm
@@ -5,13 +5,13 @@ use strict;
 use warnings;
 
 use Carp         'confess';
-use Scalar::Util 'reftype';
+use Scalar::Util 'reftype', 'blessed';
 
 our $VERSION = '0.01';
 
 sub meta { 
     require Class::MOP::Class;
-    Class::MOP::Class->initialize($_[0]) 
+    Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
 }
 
 sub wrap { 
diff --git a/t/001_basic.t b/t/001_basic.t
index 55f443c..6eec2d7 100644
--- a/t/001_basic.t
+++ b/t/001_basic.t
@@ -13,16 +13,17 @@ BEGIN {
 
 {   
     package Foo;
+    use metaclass;
     our $VERSION = '0.01';
     
     package Bar;
     our @ISA = ('Foo');
 }
 
-my $Foo = Class::MOP::Class->initialize('Foo');
+my $Foo = Foo->meta;
 isa_ok($Foo, 'Class::MOP::Class');
 
-my $Bar = Class::MOP::Class->initialize('Bar');
+my $Bar = Bar->meta;
 isa_ok($Bar, 'Class::MOP::Class');
 
 is($Foo->name, 'Foo', '... Foo->name == Foo');
@@ -55,7 +56,7 @@ my $Baz = Class::MOP::Class->create(
                 superclasses => [ 'Bar' ]
             ));
 isa_ok($Baz, 'Class::MOP::Class');
-is(Class::MOP::Class->initialize('Baz'), $Baz, '... our metaclasses are singletons');
+is(Baz->meta, $Baz, '... our metaclasses are singletons');
 
 is($Baz->name, 'Baz', '... Baz->name == Baz');
 is($Baz->version, '0.10', '... Baz->version == 0.10');
diff --git a/t/002_class_precedence_list.t b/t/002_class_precedence_list.t
index 06142bd..c9b84d3 100644
--- a/t/002_class_precedence_list.t
+++ b/t/002_class_precedence_list.t
@@ -22,6 +22,7 @@ B   C
 
 {
     package My::A;
+    use metaclass;
     package My::B;
     our @ISA = ('My::A');
     package My::C;
@@ -31,7 +32,7 @@ B   C
 }
 
 is_deeply(
-    [ Class::MOP::Class->initialize('My::D')->class_precedence_list ], 
+    [ My::D->meta->class_precedence_list ], 
     [ 'My::D', 'My::B', 'My::A', 'My::C', 'My::A' ], 
     '... My::D->meta->class_precedence_list == (D B A C A)');
 
@@ -47,6 +48,7 @@ is_deeply(
 
 {
     package My::2::A;
+    use metaclass;    
     our @ISA = ('My::2::C');
         
     package My::2::B;
@@ -56,7 +58,7 @@ is_deeply(
     our @ISA = ('My::2::B');           
 }
 
-eval { Class::MOP::Class->initialize('My::2::B')->class_precedence_list };
+eval { My::2::B->meta->class_precedence_list };
 ok($@, '... recursive inheritance breaks correctly :)');
 
 =pod
@@ -72,6 +74,7 @@ ok($@, '... recursive inheritance breaks correctly :)');
 
 {
     package My::3::A;
+    use metaclass;    
     package My::3::B;
     our @ISA = ('My::3::A');
     package My::3::C;
@@ -81,7 +84,7 @@ ok($@, '... recursive inheritance breaks correctly :)');
 }
 
 is_deeply(
-    [ Class::MOP::Class->initialize('My::3::D')->class_precedence_list ], 
+    [ My::3::D->meta->class_precedence_list ], 
     [ 'My::3::D', 'My::3::B', 'My::3::A', 'My::3::C', 'My::3::A', 'My::3::B', 'My::3::A' ], 
     '... My::3::D->meta->class_precedence_list == (D B A C A B A)');
 
@@ -97,6 +100,7 @@ my @CLASS_PRECEDENCE_LIST;
 
 {
     package Foo;
+    use metaclass;    
     
     sub CPL { push @CLASS_PRECEDENCE_LIST => 'Foo' }    
     
@@ -109,6 +113,7 @@ my @CLASS_PRECEDENCE_LIST;
     }       
     
     package Baz;
+    use metaclass;    
     our @ISA = ('Bar');
     
     sub CPL { 
@@ -137,7 +142,7 @@ my @CLASS_PRECEDENCE_LIST;
 Foo::Bar::Baz->CPL();
 
 is_deeply(
-    [ Class::MOP::Class->initialize('Foo::Bar::Baz')->class_precedence_list ], 
+    [ Foo::Bar::Baz->meta->class_precedence_list ], 
     [ @CLASS_PRECEDENCE_LIST ], 
     '... Foo::Bar::Baz->meta->class_precedence_list == @CLASS_PRECEDENCE_LIST');
 
diff --git a/t/003_methods.t b/t/003_methods.t
index cc24f0c..19b242a 100644
--- a/t/003_methods.t
+++ b/t/003_methods.t
@@ -161,7 +161,7 @@ is(Bar->foo, 'Bar::foo v2', '... Bar->foo == "Bar::foo v2"');
 
 is_deeply(
     [ sort $Bar->get_method_list ],
-    [ qw(bar foo) ],
+    [ qw(bar foo meta) ],
     '... got the right method list for Bar');  
     
 is_deeply(
@@ -195,6 +195,11 @@ is_deeply(
             class => 'Bar',
             code  => $Bar->get_method('foo')            
         },        
+        {
+            name  => 'meta',
+            class => 'Bar',
+            code  => $Bar->get_method('meta')            
+        }        
     ],
     '... got the right list of applicable methods for Bar');
 
diff --git a/t/005_attributes.t b/t/005_attributes.t
index 9615c0b..4b5c747 100644
--- a/t/005_attributes.t
+++ b/t/005_attributes.t
@@ -7,7 +7,7 @@ use Test::More tests => 33;
 use Test::Exception;
 
 BEGIN { 
-    use_ok('Class::MOP', ':universal'); 
+    use_ok('Class::MOP'); 
 }
 
 my $FOO_ATTR = Class::MOP::Attribute->new('$foo');
@@ -21,6 +21,7 @@ my $BAZ_ATTR = Class::MOP::Attribute->new('$baz' => (
 
 {
     package Foo;
+    use metaclass;
 
     my $meta = Foo->meta;
     ::lives_ok {
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index dea1f47..5a98408 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 115;
+use Test::More tests => 119;
 use Test::Exception;
 
 BEGIN {
@@ -29,13 +29,15 @@ my @methods = qw(
     
     superclasses class_precedence_list
     
-    has_method get_method add_method remove_method 
+    has_method get_method add_method remove_method alias_method
     get_method_list compute_all_applicable_methods find_all_methods_by_name
     
     has_attribute get_attribute add_attribute remove_attribute
     get_attribute_list get_attribute_map compute_all_applicable_attributes
     
     add_package_variable get_package_variable has_package_variable remove_package_variable
+    
+    mixin
     );
     
 is_deeply([ sort @methods ], [ sort $meta->get_method_list ], '... got the correct method list');
diff --git a/t/011_create_class.t b/t/011_create_class.t
index 008cfa3..b102d1b 100644
--- a/t/011_create_class.t
+++ b/t/011_create_class.t
@@ -7,7 +7,7 @@ use Test::More tests => 27;
 use Test::Exception;
 
 BEGIN {
-    use_ok('Class::MOP', ':universal');        
+    use_ok('Class::MOP');        
 }
 
 my $Point = Class::MOP::Class->create('Point' => '0.01' => (
diff --git a/t/012_package_variables.t b/t/012_package_variables.t
index 4fdb678..1f8b1f4 100644
--- a/t/012_package_variables.t
+++ b/t/012_package_variables.t
@@ -7,11 +7,12 @@ use Test::More tests => 34;
 use Test::Exception;
 
 BEGIN {
-    use_ok('Class::MOP', ':universal');        
+    use_ok('Class::MOP');        
 }
 
 {
     package Foo;
+    use metaclass;
 }
 
 ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet');
diff --git a/t/013_add_attribute_alternate.t b/t/013_add_attribute_alternate.t
index 8b168c6..03cd2df 100644
--- a/t/013_add_attribute_alternate.t
+++ b/t/013_add_attribute_alternate.t
@@ -7,11 +7,12 @@ use Test::More tests => 27;
 use Test::Exception;
 
 BEGIN {
-    use_ok('Class::MOP', ':universal');        
+    use_ok('Class::MOP');        
 }
 
 {
     package Point;
+    use metaclass;
 
     Point->meta->add_attribute('$.x' => (
         reader   => 'x',
diff --git a/t/014_attribute_introspection.t b/t/014_attribute_introspection.t
index d0c9ba9..2fb3acb 100644
--- a/t/014_attribute_introspection.t
+++ b/t/014_attribute_introspection.t
@@ -15,7 +15,7 @@ BEGIN {
     isa_ok($meta, 'Class::MOP::Class');
     
     my @methods = qw(
-        meta 
+        meta
         new clone
         name
         has_accessor  accessor
diff --git a/t/030_method.t b/t/030_method.t
index 87ec1c5..de48851 100644
--- a/t/030_method.t
+++ b/t/030_method.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 9;
+use Test::More tests => 8;
 use Test::Exception;
 
 BEGIN {
@@ -20,7 +20,6 @@ isa_ok($meta, 'Class::MOP::Class');
     isa_ok($meta, 'Class::MOP::Class');
     
     foreach my $method_name (qw(
-        meta 
         wrap
         )) {
         ok($meta->has_method($method_name), '... Class::MOP::Method->has_method(' . $method_name . ')');
diff --git a/t/050_class_mixin_composition.t b/t/050_class_mixin_composition.t
index 5b8234a..56e65ee 100644
--- a/t/050_class_mixin_composition.t
+++ b/t/050_class_mixin_composition.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More no_plan => 4;
+use Test::More tests => 4;
 
 =pod
 
@@ -24,7 +24,7 @@ code above is well-formed.
   }
   
   class ColoredPoint2D(u: Int, v: Int, c: String) extends Point2D(u, v) {
-    var color = c;
+    val color = c;
     def setColor(newCol: String): Unit = color = newCol;
     override def toString() = super.toString() + ", col = " + color;
   }
@@ -110,3 +110,5 @@ isa_ok($colored_point_3d, 'Point2D');
 is($colored_point_3d->toString(),
    'x = 1, y = 2, z = 3, col = blue',
    '... got the right toString method');
+
+
diff --git a/t/104_AttributesWithHistory_test.t b/t/104_AttributesWithHistory_test.t
index 8542ef0..c83c950 100644
--- a/t/104_AttributesWithHistory_test.t
+++ b/t/104_AttributesWithHistory_test.t
@@ -13,8 +13,7 @@ BEGIN {
 
 {
     package Foo;
-    
-    use Class::MOP 'meta';
+    use metaclass;
     
     Foo->meta->add_attribute(AttributesWithHistory->new('foo' => (
         accessor         => 'foo',