r5557 - in /packages/libclass-mop-perl/trunk: ./ debian/ lib/ lib/Class/ lib/Class/MOP/ lib/Class/MOP/Method/ t/ t/lib/ t/lib/MyMetaClass/

eloy at users.alioth.debian.org eloy at users.alioth.debian.org
Fri Jun 1 08:31:31 UTC 2007


Author: eloy
Date: Fri Jun  1 08:31:31 2007
New Revision: 5557

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=5557
Log:
new upstream version

Added:
    packages/libclass-mop-perl/trunk/t/019_anon_class_keep_alive.t
      - copied unchanged from r5556, packages/libclass-mop-perl/branches/upstream/current/t/019_anon_class_keep_alive.t
    packages/libclass-mop-perl/trunk/t/045_metaclass_loads_classes.t
      - copied unchanged from r5556, packages/libclass-mop-perl/branches/upstream/current/t/045_metaclass_loads_classes.t
    packages/libclass-mop-perl/trunk/t/301_RT_27329_fix.t
      - copied unchanged from r5556, packages/libclass-mop-perl/branches/upstream/current/t/301_RT_27329_fix.t
    packages/libclass-mop-perl/trunk/t/lib/MyMetaClass/
      - copied from r5556, packages/libclass-mop-perl/branches/upstream/current/t/lib/MyMetaClass/
    packages/libclass-mop-perl/trunk/t/lib/MyMetaClass.pm
      - copied unchanged from r5556, packages/libclass-mop-perl/branches/upstream/current/t/lib/MyMetaClass.pm
Modified:
    packages/libclass-mop-perl/trunk/Changes
    packages/libclass-mop-perl/trunk/MANIFEST
    packages/libclass-mop-perl/trunk/META.yml
    packages/libclass-mop-perl/trunk/README
    packages/libclass-mop-perl/trunk/debian/changelog
    packages/libclass-mop-perl/trunk/lib/Class/MOP.pm
    packages/libclass-mop-perl/trunk/lib/Class/MOP/Attribute.pm
    packages/libclass-mop-perl/trunk/lib/Class/MOP/Class.pm
    packages/libclass-mop-perl/trunk/lib/Class/MOP/Method.pm
    packages/libclass-mop-perl/trunk/lib/Class/MOP/Method/Wrapped.pm
    packages/libclass-mop-perl/trunk/lib/Class/MOP/Module.pm
    packages/libclass-mop-perl/trunk/lib/Class/MOP/Package.pm
    packages/libclass-mop-perl/trunk/lib/metaclass.pm
    packages/libclass-mop-perl/trunk/t/002_class_precedence_list.t
    packages/libclass-mop-perl/trunk/t/003_methods.t
    packages/libclass-mop-perl/trunk/t/005_attributes.t
    packages/libclass-mop-perl/trunk/t/006_new_and_clone_metaclasses.t
    packages/libclass-mop-perl/trunk/t/014_attribute_introspection.t
    packages/libclass-mop-perl/trunk/t/018_anon_class.t
    packages/libclass-mop-perl/trunk/t/200_Class_C3_compatibility.t

Modified: packages/libclass-mop-perl/trunk/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/Changes?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/Changes (original)
+++ packages/libclass-mop-perl/trunk/Changes Fri Jun  1 08:31:31 2007
@@ -1,4 +1,35 @@
 Revision history for Perl extension Class-MOP.
+
+0.38 Thurs. May 31, 2007
+    ~~ More documentation updates ~~
+    
+    * Class::MOP::Package
+      - we now deal with stub methods properly
+        - added tests for this
+      - fixed some tests failing on 5.9.5 (thanks blblack)
+        
+    * Class::MOP::Attribute
+      - added get_read_method and get_write_method
+        thanks to groditi for this code, tests 
+        and docs.
+        - added tests and POD for this
+    
+    * Class::MOP::Class
+      - fixed RT issue #27329, clone object now 
+        handles undef values correctly.
+        - added tests for this
+      - Corrected anon-class handling so that they 
+        will not get reaped when instances still 
+        exist which need to reference them. This is 
+        the correct behavior, hopefully this is an 
+        obscure enough feature that there are not too 
+        many work arounds out in the wild.
+        - added tests for this by groditi   
+        - updated docs to explain this
+
+    * metaclass
+      - load custom metaclasses automatically (thanks groditi)
+        - added tests for this behavior
 
 0.37 Sat. March 10, 2007
     ~~ Many, many documentation updates ~~

Modified: packages/libclass-mop-perl/trunk/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/MANIFEST?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/MANIFEST (original)
+++ packages/libclass-mop-perl/trunk/MANIFEST Fri Jun  1 08:31:31 2007
@@ -1,7 +1,7 @@
 Build.PL
 Changes
+META.yml
 Makefile.PL
-META.yml
 MANIFEST
 MANIFEST.SKIP
 README
@@ -43,6 +43,7 @@
 t/016_class_errors_and_edge_cases.t
 t/017_add_method_modifier.t
 t/018_anon_class.t
+t/019_anon_class_keep_alive.t
 t/020_attribute.t
 t/021_attribute_errors_and_edge_cases.t
 t/022_attribute_duplication.t
@@ -53,6 +54,7 @@
 t/042_metaclass_incompatibility_dynamic.t
 t/043_instance_metaclass_incompatibility.t
 t/044_instance_metaclass_incompatibility_dynamic.t
+t/045_metaclass_loads_classes.t
 t/050_scala_style_mixin_composition.t
 t/060_instance.t
 t/061_instance_inline.t
@@ -72,6 +74,11 @@
 t/108_ArrayBasedStorage_test.t
 t/200_Class_C3_compatibility.t
 t/300_random_eval_bug.t
+t/301_RT_27329_fix.t
 t/pod.t
 t/pod_coverage.t
 t/lib/BinaryTree.pm
+t/lib/MyMetaClass.pm
+t/lib/MyMetaClass/Attribute.pm
+t/lib/MyMetaClass/Instance.pm
+t/lib/MyMetaClass/Method.pm

Modified: packages/libclass-mop-perl/trunk/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/META.yml?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/META.yml (original)
+++ packages/libclass-mop-perl/trunk/META.yml Fri Jun  1 08:31:31 2007
@@ -1,9 +1,8 @@
 ---
 name: Class-MOP
-version: 0.37
+version: 0.38
 author:
   - 'Stevan Little E<lt>stevan at iinteractive.comE<gt>'
-  - 'Yuval Kogman E<lt>nothingmuch at woobling.comE<gt>'
 abstract: A Meta Object Protocol for Perl 5
 license: perl
 resources:
@@ -20,13 +19,13 @@
 provides:
   Class::MOP:
     file: lib/Class/MOP.pm
-    version: 0.37
+    version: 0.38
   Class::MOP::Attribute:
     file: lib/Class/MOP/Attribute.pm
-    version: 0.14
+    version: 0.15
   Class::MOP::Class:
     file: lib/Class/MOP/Class.pm
-    version: 0.21
+    version: 0.22
   Class::MOP::Immutable:
     file: lib/Class/MOP/Immutable.pm
     version: 0.01
@@ -53,10 +52,10 @@
     version: 0.02
   Class::MOP::Package:
     file: lib/Class/MOP/Package.pm
-    version: 0.05
+    version: 0.06
   metaclass:
     file: lib/metaclass.pm
-    version: 0.03
+    version: 0.04
 generated_by: Module::Build version 0.2805
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.2.html

Modified: packages/libclass-mop-perl/trunk/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/README?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/README (original)
+++ packages/libclass-mop-perl/trunk/README Fri Jun  1 08:31:31 2007
@@ -1,4 +1,4 @@
-Class::MOP version 0.37
+Class::MOP version 0.38
 ===========================
 
 See the individual module documentation for more information

Modified: packages/libclass-mop-perl/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/debian/changelog?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/debian/changelog (original)
+++ packages/libclass-mop-perl/trunk/debian/changelog Fri Jun  1 08:31:31 2007
@@ -1,3 +1,9 @@
+libclass-mop-perl (0.38-1) unstable; urgency=low
+
+  * New upstream release
+
+ -- Krzysztof Krzyzaniak (eloy) <eloy at debian.org>  Fri, 01 Jun 2007 10:30:42 +0200
+
 libclass-mop-perl (0.37-1) unstable; urgency=low
 
   * New upstream release

Modified: packages/libclass-mop-perl/trunk/lib/Class/MOP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/lib/Class/MOP.pm?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/lib/Class/MOP.pm (original)
+++ packages/libclass-mop-perl/trunk/lib/Class/MOP.pm Fri Jun  1 08:31:31 2007
@@ -13,7 +13,7 @@
 
 use Class::MOP::Immutable;
 
-our $VERSION   = '0.37';
+our $VERSION   = '0.38';
 our $AUTHORITY = 'cpan:STEVAN';
 
 {
@@ -835,28 +835,6 @@
 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                   97.7  100.0   88.9   94.7  100.0    3.2   96.6
- Class/MOP/Attribute.pm         75.5   77.9   82.4   88.3  100.0    4.0   81.5
- Class/MOP/Class.pm             96.9   88.8   72.1   98.2  100.0   35.8   91.4
- Class/MOP/Class/Immutable.pm   88.2   60.0    n/a   95.5  100.0    0.5   84.6
- Class/MOP/Instance.pm          86.4   75.0   33.3   86.2  100.0    1.2   87.5
- Class/MOP/Method.pm            97.5   75.0   61.5   80.6  100.0   12.7   89.7
- Class/MOP/Module.pm           100.0    n/a   55.6  100.0  100.0    0.1   90.7
- Class/MOP/Object.pm            73.3    n/a   20.0   80.0  100.0    0.1   66.7
- Class/MOP/Package.pm           94.6   71.7   33.3  100.0  100.0   42.2   87.0
- metaclass.pm                  100.0  100.0   83.3  100.0    n/a    0.2   97.7
- ---------------------------- ------ ------ ------ ------ ------ ------ ------
- Total                          91.3   80.4   69.8   91.9  100.0  100.0   88.1
- ---------------------------- ------ ------ ------ ------ ------ ------ ------
-
 =head1 ACKNOWLEDGEMENTS
 
 =over 4
@@ -871,7 +849,15 @@
 
 Stevan Little E<lt>stevan at iinteractive.comE<gt>
 
-Yuval Kogman E<lt>nothingmuch at woobling.comE<gt>
+B<with contributions from:>
+
+Brandon (blblack) Black
+
+Guillermo (groditi) Roditi
+
+Rob (robkinyon) Kinyon
+
+Yuval (nothingmuch) Kogman
 
 =head1 COPYRIGHT AND LICENSE
 

Modified: packages/libclass-mop-perl/trunk/lib/Class/MOP/Attribute.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/lib/Class/MOP/Attribute.pm?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/lib/Class/MOP/Attribute.pm (original)
+++ packages/libclass-mop-perl/trunk/lib/Class/MOP/Attribute.pm Fri Jun  1 08:31:31 2007
@@ -9,7 +9,7 @@
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
 
-our $VERSION   = '0.14';
+our $VERSION   = '0.15';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Object';
@@ -116,6 +116,9 @@
 # end bootstrapped away method section.
 # (all methods below here are kept intact)
 
+sub get_read_method  { $_[0]->reader || $_[0]->accessor }
+sub get_write_method { $_[0]->writer || $_[0]->accessor }
+
 sub is_default_a_coderef { 
     ('CODE' eq (reftype($_[0]->{'$!default'} || $_[0]->{default}) || ''))    
 }
@@ -515,6 +518,14 @@
 Returns a list of slots required by the attribute. This is usually 
 just one, which is the name of the attribute.
 
+=item B<get_read_method>
+
+=item B<get_write_method>
+
+Return the name of a method suitable for reading / writing the value of the
+attribute in the associated class. Suitable for use whether C<reader> and
+C<writer> or C<accessor> was used.
+
 =back
 
 =head2 Informational predicates
@@ -637,8 +648,6 @@
 
 Stevan Little E<lt>stevan at iinteractive.comE<gt>
 
-Yuval Kogman E<lt>nothingmuch at woobling.comE<gt>
-
 =head1 COPYRIGHT AND LICENSE
 
 Copyright 2006, 2007 by Infinity Interactive, Inc.

Modified: packages/libclass-mop-perl/trunk/lib/Class/MOP/Class.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/lib/Class/MOP/Class.pm?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/lib/Class/MOP/Class.pm (original)
+++ packages/libclass-mop-perl/trunk/lib/Class/MOP/Class.pm Fri Jun  1 08:31:31 2007
@@ -13,7 +13,7 @@
 use Sub::Name    'subname';
 use B            'svref_2object';
 
-our $VERSION   = '0.21';
+our $VERSION   = '0.22';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Module';
@@ -313,6 +313,18 @@
     foreach my $attr ($class->compute_all_applicable_attributes()) {
         $attr->initialize_instance_slot($meta_instance, $instance, \%params);
     }
+    # NOTE: 
+    # this will only work for a HASH instance type
+    if ($class->is_anon_class) {
+        (reftype($instance) eq 'HASH')
+            || confess "Currently only HASH based instances are supported with instance of anon-classes";
+        # NOTE:
+        # At some point we should make this official
+        # as a reserved slot name, but right now I am 
+        # going to keep it here.
+        # my $RESERVED_MOP_SLOT = '__MOP__';
+        $instance->{'__MOP__'} = $class;
+    }
     return $instance;
 }
 
@@ -344,7 +356,7 @@
     my $meta_instance = $class->get_meta_instance();
     my $clone = $meta_instance->clone_instance($instance);     
     foreach my $attr ($class->compute_all_applicable_attributes()) {
-        if ($params{$attr->init_arg}) {
+        if (exists $params{$attr->init_arg}) {
             $meta_instance->set_slot_value($clone, $attr->name, $params{$attr->init_arg});                    
         }
     }       
@@ -420,7 +432,7 @@
             $method = $self->find_next_method_by_name($method_name);
             # die if it does not exist
             (defined $method)
-                || confess "The method '$method_name' is not found in the inherience hierarchy for class " . $self->name;
+                || confess "The method '$method_name' is not found in the inheritance hierarchy for class " . $self->name;
             # and now make sure to wrap it 
             # even if it is already wrapped
             # because we need a new sub ref
@@ -864,6 +876,16 @@
 it does not need a C<$package_name>. Instead it will create a suitably 
 unique package name for you to stash things into.
 
+On very important distinction is that anon classes are destroyed once 
+the metaclass they are attached to goes out of scope. In the DESTROY 
+method, the created package will be removed from the symbol table. 
+
+It is also worth noting that any instances created with an anon-class
+will keep a special reference to the anon-meta which will prevent the 
+anon-class from going out of scope until all instances of it have also 
+been destroyed. This however only works for HASH based instance types, 
+as we use a special reserved slot (C<__MOP__>) to store this. 
+
 =item B<initialize ($package_name, %options)>
 
 This initializes and returns returns a B<Class::MOP::Class> object 
@@ -1319,8 +1341,6 @@
 
 Stevan Little E<lt>stevan at iinteractive.comE<gt>
 
-Yuval Kogman E<lt>nothingmuch at woobling.comE<gt>
-
 =head1 COPYRIGHT AND LICENSE
 
 Copyright 2006, 2007 by Infinity Interactive, Inc.

Modified: packages/libclass-mop-perl/trunk/lib/Class/MOP/Method.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/lib/Class/MOP/Method.pm?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/lib/Class/MOP/Method.pm (original)
+++ packages/libclass-mop-perl/trunk/lib/Class/MOP/Method.pm Fri Jun  1 08:31:31 2007
@@ -129,8 +129,6 @@
 
 Stevan Little E<lt>stevan at iinteractive.comE<gt>
 
-Yuval Kogman E<lt>nothingmuch at woobling.comE<gt>
-
 =head1 COPYRIGHT AND LICENSE
 
 Copyright 2006, 2007 by Infinity Interactive, Inc.

Modified: packages/libclass-mop-perl/trunk/lib/Class/MOP/Method/Wrapped.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/lib/Class/MOP/Method/Wrapped.pm?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/lib/Class/MOP/Method/Wrapped.pm (original)
+++ packages/libclass-mop-perl/trunk/lib/Class/MOP/Method/Wrapped.pm Fri Jun  1 08:31:31 2007
@@ -179,8 +179,6 @@
 
 Stevan Little E<lt>stevan at iinteractive.comE<gt>
 
-Yuval Kogman E<lt>nothingmuch at woobling.comE<gt>
-
 =head1 COPYRIGHT AND LICENSE
 
 Copyright 2006, 2007 by Infinity Interactive, Inc.

Modified: packages/libclass-mop-perl/trunk/lib/Class/MOP/Module.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/lib/Class/MOP/Module.pm?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/lib/Class/MOP/Module.pm (original)
+++ packages/libclass-mop-perl/trunk/lib/Class/MOP/Module.pm Fri Jun  1 08:31:31 2007
@@ -77,8 +77,6 @@
 
 Stevan Little E<lt>stevan at iinteractive.comE<gt>
 
-Yuval Kogman E<lt>nothingmuch at woobling.comE<gt>
-
 =head1 COPYRIGHT AND LICENSE
 
 Copyright 2006, 2007 by Infinity Interactive, Inc.

Modified: packages/libclass-mop-perl/trunk/lib/Class/MOP/Package.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/lib/Class/MOP/Package.pm?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/lib/Class/MOP/Package.pm (original)
+++ packages/libclass-mop-perl/trunk/lib/Class/MOP/Package.pm Fri Jun  1 08:31:31 2007
@@ -7,7 +7,7 @@
 use Scalar::Util 'blessed';
 use Carp         'confess';
 
-our $VERSION   = '0.05';
+our $VERSION   = '0.06';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Object';
@@ -195,6 +195,8 @@
     my $namespace = $self->namespace;
     return grep { 
         defined(*{$namespace->{$_}}{$type_filter}) 
+    } grep {
+        ref(\$namespace->{$_}) eq 'GLOB'   
     } keys %{$namespace};
 }
 
@@ -272,8 +274,6 @@
 
 Stevan Little E<lt>stevan at iinteractive.comE<gt>
 
-Yuval Kogman E<lt>nothingmuch at woobling.comE<gt>
-
 =head1 COPYRIGHT AND LICENSE
 
 Copyright 2006, 2007 by Infinity Interactive, Inc.

Modified: packages/libclass-mop-perl/trunk/lib/metaclass.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/lib/metaclass.pm?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/lib/metaclass.pm (original)
+++ packages/libclass-mop-perl/trunk/lib/metaclass.pm Fri Jun  1 08:31:31 2007
@@ -7,7 +7,7 @@
 use Carp         'confess';
 use Scalar::Util 'blessed';
 
-our $VERSION   = '0.03';
+our $VERSION   = '0.04';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Class::MOP;
@@ -20,19 +20,24 @@
     }
     else {
         $metaclass = shift;
+        #make sure the custom metaclass gets loaded
+        Class::MOP::load_class($metaclass);
         ($metaclass->isa('Class::MOP::Class'))
             || confess "The metaclass ($metaclass) must be derived from Class::MOP::Class";
     }
     my %options = @_;
+    #make sure the custom metaclasses get loaded
+    map{ Class::MOP::load_class($options{$_}) }
+      grep{ /^(attribute|method|instance)_metaclass/ } keys %options;
     my $package = caller();
-    
+
     # create a meta object so we can install &meta
     my $meta = $metaclass->initialize($package => %options);
     $meta->add_method('meta' => sub {
-        # we must re-initialize so that it 
-        # works as expected in subclasses, 
-        # since metaclass instances are 
-        # singletons, this is not really a 
+        # we must re-initialize so that it
+        # works as expected in subclasses,
+        # since metaclass instances are
+        # singletons, this is not really a
         # big deal anyway.
         $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
     });
@@ -53,17 +58,17 @@
   package MyClass;
 
   # use Class::MOP::Class
-  use metaclass; 
+  use metaclass;
 
   # ... or use a custom metaclass
   use metaclass 'MyMetaClass';
-  
-  # ... or use a custom metaclass  
+
+  # ... or use a custom metaclass
   # and custom attribute and method
   # metaclasses
   use metaclass 'MyMetaClass' => (
       'attribute_metaclass' => 'MyAttributeMetaClass',
-      'method_metaclass'    => 'MyMethodMetaClass',    
+      'method_metaclass'    => 'MyMethodMetaClass',
   );
 
   # ... or just specify custom attribute
@@ -71,20 +76,18 @@
   # is the assumed metaclass
   use metaclass (
       'attribute_metaclass' => 'MyAttributeMetaClass',
-      'method_metaclass'    => 'MyMethodMetaClass',    
+      'method_metaclass'    => 'MyMethodMetaClass',
   );
 
 =head1 DESCRIPTION
 
-This is a pragma to make it easier to use a specific metaclass 
-and a set of custom attribute and method metaclasses. It also 
-installs a C<meta> method to your class as well. 
+This is a pragma to make it easier to use a specific metaclass
+and a set of custom attribute and method metaclasses. It also
+installs a C<meta> method to your class as well.
 
 =head1 AUTHORS
 
 Stevan Little E<lt>stevan at iinteractive.comE<gt>
-
-Yuval Kogman E<lt>nothingmuch at woobling.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
@@ -93,6 +96,6 @@
 L<http://www.iinteractive.com>
 
 This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself. 
+it under the same terms as Perl itself.
 
 =cut

Modified: packages/libclass-mop-perl/trunk/t/002_class_precedence_list.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/002_class_precedence_list.t?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/002_class_precedence_list.t (original)
+++ packages/libclass-mop-perl/trunk/t/002_class_precedence_list.t Fri Jun  1 08:31:31 2007
@@ -46,19 +46,24 @@
 
 =cut
 
-{
-    package My::2::A;
-    use metaclass;    
-    our @ISA = ('My::2::C');
+# 5.9.5+ dies at the moment of
+# recursive @ISA definition, not later when
+# you try to use the @ISAs.
+eval {
+    {
+        package My::2::A;
+        use metaclass;    
+        our @ISA = ('My::2::C');
         
-    package My::2::B;
-    our @ISA = ('My::2::A');
+        package My::2::B;
+        our @ISA = ('My::2::A');
     
-    package My::2::C;
-    our @ISA = ('My::2::B');           
-}
+        package My::2::C;
+        our @ISA = ('My::2::B');           
+    }
 
-eval { My::2::B->meta->class_precedence_list };
+    My::2::B->meta->class_precedence_list
+};
 ok($@, '... recursive inheritance breaks correctly :)');
 
 =pod

Modified: packages/libclass-mop-perl/trunk/t/003_methods.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/003_methods.t?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/003_methods.t (original)
+++ packages/libclass-mop-perl/trunk/t/003_methods.t Fri Jun  1 08:31:31 2007
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 64;
+use Test::More tests => 66;
 use Test::Exception;
 
 use Scalar::Util qw/reftype/;
@@ -21,6 +21,9 @@
     # import a sub
     use Scalar::Util 'blessed'; 
     
+    sub pie;
+    sub cake ();
+
     use constant FOO_CONSTANT => 'Foo-CONSTANT';
     
     # define a sub in package
@@ -55,6 +58,9 @@
 }
 
 my $Foo = Class::MOP::Class->initialize('Foo');
+
+ok(!$Foo->has_method('pie'), '... got the method stub pie');
+ok(!$Foo->has_method('cake'), '... got the constant method stub cake');
 
 my $foo = sub { 'Foo::foo' };
 
@@ -110,7 +116,7 @@
     isa_ok($Foo->get_method($method_name), 'Class::MOP::Method');
     {
         no strict 'refs';
-        is($Foo->get_method($method_name)->body, \&{'Foo::' . $method_name}, '... body matches CODE ref in package');
+        is($Foo->get_method($method_name)->body, \&{'Foo::' . $method_name}, '... body matches CODE ref in package for ' . $method_name);
     }
 }
 

Modified: packages/libclass-mop-perl/trunk/t/005_attributes.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/005_attributes.t?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/005_attributes.t (original)
+++ packages/libclass-mop-perl/trunk/t/005_attributes.t Fri Jun  1 08:31:31 2007
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 43;
+use Test::More tests => 47;
 use Test::Exception;
 
 BEGIN { 
@@ -53,6 +53,10 @@
     ::ok($meta->has_attribute('$bar'), '... Bar has $bar attribute');
     ::is($meta->get_attribute('$bar'), $BAR_ATTR, '... got the right attribute back for Bar');
 
+    my $attr = $meta->get_attribute('$bar');
+    ::is($attr->get_read_method,  'bar', '... got the right read method for Bar');
+    ::is($attr->get_write_method, 'bar', '... got the right write method for Bar');
+
     ::ok($meta->has_method('bar'), '... an accessor has been created');
     ::isa_ok($meta->get_method('bar'), 'Class::MOP::Method::Accessor');      
 }
@@ -66,6 +70,10 @@
     } '... we added an attribute to Baz successfully';
     ::ok($meta->has_attribute('$baz'), '... Baz has $baz attribute');    
     ::is($meta->get_attribute('$baz'), $BAZ_ATTR, '... got the right attribute back for Baz');
+
+    my $attr = $meta->get_attribute('$baz');
+    ::is($attr->get_read_method,  'get_baz', '... got the right read method for Baz');
+    ::is($attr->get_write_method, 'set_baz', '... got the right write method for Baz');
 
     ::ok($meta->has_method('get_baz'), '... a reader has been created');
     ::ok($meta->has_method('set_baz'), '... a writer has been created');

Modified: packages/libclass-mop-perl/trunk/t/006_new_and_clone_metaclasses.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/006_new_and_clone_metaclasses.t?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/006_new_and_clone_metaclasses.t (original)
+++ packages/libclass-mop-perl/trunk/t/006_new_and_clone_metaclasses.t Fri Jun  1 08:31:31 2007
@@ -2,6 +2,9 @@
 
 use strict;
 use warnings;
+
+use FindBin;
+use File::Spec::Functions;
 
 use Test::More tests => 36;
 use Test::Exception;
@@ -9,6 +12,8 @@
 BEGIN {
     use_ok('Class::MOP');
 }
+
+use lib catdir($FindBin::Bin, 'lib');
 
 # make sure the Class::MOP::Class->meta does the right thing
 
@@ -21,7 +26,7 @@
 
 my $cloned_meta = $meta->clone_object($meta);
 isa_ok($cloned_meta, 'Class::MOP::Class');
-is($cloned_meta, $meta, '... it creates the singleton even if you try to clone it');    
+is($cloned_meta, $meta, '... it creates the singleton even if you try to clone it');
 
 # make sure other metaclasses do the right thing
 
@@ -35,13 +40,8 @@
 
 is($meta->new_object('package' => 'Foo'), $foo_meta, '... got the right Foo->meta singleton');
 is($meta->clone_object($foo_meta), $foo_meta, '... cloning got the right Foo->meta singleton');
-    
+
 # make sure subclassed of Class::MOP::Class do the right thing
-
-{
-    package MyMetaClass;
-    use base 'Class::MOP::Class';
-}
 
 my $my_meta = MyMetaClass->meta;
 isa_ok($my_meta, 'Class::MOP::Class');
@@ -67,7 +67,7 @@
 
 $bar_meta->superclasses('Foo');
 
-# check with MyMetaClass 
+# check with MyMetaClass
 
 {
     package Baz;
@@ -106,14 +106,14 @@
 
 dies_ok {
     $foo_meta->clone_object($meta);
-} '... this dies as expected';  
+} '... this dies as expected';
 
 # test stuff
 
 {
     package FooBar;
     use metaclass;
-    
+
     FooBar->meta->add_attribute('test');
 }
 
@@ -124,7 +124,7 @@
 isa_ok($attr_clone, 'Class::MOP::Attribute');
 
 isnt($attr, $attr_clone, '... we successfully cloned our attributes');
-is($attr->associated_class, 
-   $attr_clone->associated_class, 
+is($attr->associated_class,
+   $attr_clone->associated_class,
    '... we successfully did not clone our associated metaclass');
 

Modified: packages/libclass-mop-perl/trunk/t/014_attribute_introspection.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/014_attribute_introspection.t?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/014_attribute_introspection.t (original)
+++ packages/libclass-mop-perl/trunk/t/014_attribute_introspection.t Fri Jun  1 08:31:31 2007
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 49;
+use Test::More tests => 51;
 use Test::Exception;
 
 BEGIN {
@@ -27,8 +27,8 @@
         
         name
         has_accessor  accessor
-        has_writer    writer
-        has_reader    reader
+        has_writer    writer     get_write_method
+        has_reader    reader     get_read_method
         has_predicate predicate
         has_clearer   clearer
         has_init_arg  init_arg

Modified: packages/libclass-mop-perl/trunk/t/018_anon_class.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/018_anon_class.t?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/018_anon_class.t (original)
+++ packages/libclass-mop-perl/trunk/t/018_anon_class.t Fri Jun  1 08:31:31 2007
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 24;
+use Test::More tests => 19;
 use Test::Exception;
 
 BEGIN {
@@ -20,71 +20,53 @@
 }
 
 my $anon_class_id;
-my $instance;
 {
-    my $anon_class = Class::MOP::Class->create_anon_class();
-    isa_ok($anon_class, 'Class::MOP::Class');
+    my $instance;
+    {
+        my $anon_class = Class::MOP::Class->create_anon_class();
+        isa_ok($anon_class, 'Class::MOP::Class');
     
-    ($anon_class_id) = ($anon_class->name =~ /Class::MOP::Class::__ANON__::SERIAL::(\d+)/);
+        ($anon_class_id) = ($anon_class->name =~ /Class::MOP::Class::__ANON__::SERIAL::(\d+)/);
     
-    ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package exists');
-    like($anon_class->name, qr/Class::MOP::Class::__ANON__::SERIAL::[0-9]+/, '... got an anon class package name');
+        ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package exists');
+        like($anon_class->name, qr/Class::MOP::Class::__ANON__::SERIAL::[0-9]+/, '... got an anon class package name');
 
-    is_deeply(
-        [$anon_class->superclasses],
-        [],
-        '... got an empty superclass list');
-    lives_ok {
-        $anon_class->superclasses('Foo');
-    } '... can add a superclass to anon class';
-    is_deeply(
-        [$anon_class->superclasses],
-        [ 'Foo' ],
-        '... got the right superclass list');
+        is_deeply(
+            [$anon_class->superclasses],
+            [],
+            '... got an empty superclass list');
+        lives_ok {
+            $anon_class->superclasses('Foo');
+        } '... can add a superclass to anon class';
+        is_deeply(
+            [$anon_class->superclasses],
+            [ 'Foo' ],
+            '... got the right superclass list');
 
-    ok(!$anon_class->has_method('foo'), '... no foo method');
-    lives_ok {
-        $anon_class->add_method('foo' => sub { "__ANON__::foo" });
-    } '... added a method to my anon-class';
-    ok($anon_class->has_method('foo'), '... we have a foo method now');  
+        ok(!$anon_class->has_method('foo'), '... no foo method');
+        lives_ok {
+            $anon_class->add_method('foo' => sub { "__ANON__::foo" });
+        } '... added a method to my anon-class';
+        ok($anon_class->has_method('foo'), '... we have a foo method now');  
 
-    $instance = $anon_class->new_object();
-    isa_ok($instance, $anon_class->name);  
-    isa_ok($instance, 'Foo');    
+        $instance = $anon_class->new_object();
+        isa_ok($instance, $anon_class->name);  
+        isa_ok($instance, 'Foo');    
 
-    is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method');
-    is($instance->bar, 'Foo::bar', '... got the right return value of our bar method');    
+        is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method');
+        is($instance->bar, 'Foo::bar', '... got the right return value of our bar method');    
+    }
+
+    ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package still exists');
 }
 
 ok(!exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package no longer exists');
 
-# the superclass relationship actually 
-# still exists for the instance ...
-isa_ok($instance, 'Foo');
-
-# and oddly enough we can still 
-# call methods on our instance
-can_ok($instance, 'foo');
-can_ok($instance, 'bar');
-
-is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method');
-is($instance->bar, 'Foo::bar', '... got the right return value of our bar method');
-
 # but it breaks down when we try to create another one ...
 
-my $instance_2 = bless {} => ref($instance);
-isa_ok($instance_2, ref($instance));
+my $instance_2 = bless {} => ('Class::MOP::Class::__ANON__::SERIAL::' . $anon_class_id);
+isa_ok($instance_2, ('Class::MOP::Class::__ANON__::SERIAL::' . $anon_class_id));
 ok(!$instance_2->isa('Foo'), '... but the new instance is not a Foo');
 ok(!$instance_2->can('foo'), '... and it can no longer call the foo method');
 
-# NOTE:
-# I bumped this test up to 100_000 instances, and 
-# still got not conflicts. If your application needs
-# more than that, your probably mst
 
-my %conflicts;
-foreach my $i (1 .. 100) {
-    $conflicts{ Class::MOP::Class->create_anon_class()->name } = undef;
-}
-is(scalar(keys %conflicts), 100, '... got as many classes as I would expect');
-

Modified: packages/libclass-mop-perl/trunk/t/200_Class_C3_compatibility.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/200_Class_C3_compatibility.t?rev=5557&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/200_Class_C3_compatibility.t (original)
+++ packages/libclass-mop-perl/trunk/t/200_Class_C3_compatibility.t Fri Jun  1 08:31:31 2007
@@ -56,8 +56,12 @@
 
 ok(Diamond_A->meta->has_method('hello'), '... A has a method hello');
 ok(!Diamond_B->meta->has_method('hello'), '... B does not have a method hello');
-ok(defined &Diamond_B::hello, '... B does have an alias to the method hello');    
 
 ok(Diamond_C->meta->has_method('hello'), '... C has a method hello');
 ok(!Diamond_D->meta->has_method('hello'), '... D does not have a method hello');
-ok(defined &Diamond_D::hello, '... D does have an alias to the method hello');    
+
+SKIP: {
+    skip "C3 does not make aliases on 5.9.5+", 2 if $] > 5.009_004;
+    ok(defined &Diamond_B::hello, '... B does have an alias to the method hello');
+    ok(defined &Diamond_D::hello, '... D does have an alias to the method hello');
+}




More information about the Pkg-perl-cvs-commits mailing list