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