r2627 - in /packages/libclass-mop-perl/trunk: ./ debian/ examples/
lib/Class/ lib/Class/MOP/ t/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Mon Apr 24 12:04:50 UTC 2006
Author: eloy
Date: Mon Apr 24 12:04:49 2006
New Revision: 2627
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=2627
Log:
eloy: new upstream version
Added:
packages/libclass-mop-perl/trunk/t/018_anon_class.t
- copied unchanged from r2626, packages/libclass-mop-perl/branches/upstream/current/t/018_anon_class.t
Modified:
packages/libclass-mop-perl/trunk/Build.PL
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/examples/ClassEncapsulatedAttributes.pod
packages/libclass-mop-perl/trunk/examples/InsideOutClass.pod
packages/libclass-mop-perl/trunk/examples/LazyClass.pod
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/t/000_load.t
packages/libclass-mop-perl/trunk/t/001_basic.t
packages/libclass-mop-perl/trunk/t/004_advanced_methods.t
packages/libclass-mop-perl/trunk/t/010_self_introspection.t
packages/libclass-mop-perl/trunk/t/014_attribute_introspection.t
packages/libclass-mop-perl/trunk/t/030_method.t
packages/libclass-mop-perl/trunk/t/102_InsideOutClass_test.t
packages/libclass-mop-perl/trunk/t/106_LazyClass_test.t
Modified: packages/libclass-mop-perl/trunk/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/Build.PL?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/Build.PL (original)
+++ packages/libclass-mop-perl/trunk/Build.PL Mon Apr 24 12:04:49 2006
@@ -11,8 +11,7 @@
'Carp' => '0.01',
'B' => '0',
},
- optional => {
- },
+ optional => {},
build_requires => {
'Test::More' => '0.47',
'Test::Exception' => '0.21',
Modified: packages/libclass-mop-perl/trunk/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/Changes?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/Changes (original)
+++ packages/libclass-mop-perl/trunk/Changes Mon Apr 24 12:04:49 2006
@@ -1,4 +1,24 @@
Revision history for Perl extension Class-MOP.
+
+0.25 Thurs. April 20, 2006
+ * Class::MOP::Class
+ - added create_anon_class for creating anonymous classes
+ - added tests for this
+ - added get_all_metaclasses, get_all_metaclass_names
+ and get_all_metaclass_instances method to allow
+ access to all the cached metaclass objects.
+ - attribute slot initialization is now the responsibility
+ of the attribute itself, and construct_instance now
+ delegates appropriately
+
+ * Class::MOP::Attribute
+ - attribute slot initialization is now the responsibility
+ of the attribute itself, so we added a method for it
+ called initialize_instance_slot
+
+ * examples/
+ - adjusted all the examples to use the new attribute
+ initialize_instance_slot method
0.24 Tues. April 11, 2006
* Class::MOP::Class
@@ -16,7 +36,6 @@
to them basically)
- added tests for this
- adjusted all /example files to comply
-
0.22 Mon. March 20, 2006
* Class::MOP::Class
Modified: packages/libclass-mop-perl/trunk/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/MANIFEST?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/MANIFEST (original)
+++ packages/libclass-mop-perl/trunk/MANIFEST Mon Apr 24 12:04:49 2006
@@ -32,6 +32,7 @@
t/015_metaclass_inheritance.t
t/016_class_errors_and_edge_cases.t
t/017_add_method_modifier.t
+t/018_anon_class.t
t/020_attribute.t
t/021_attribute_errors_and_edge_cases.t
t/030_method.t
Modified: packages/libclass-mop-perl/trunk/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/META.yml?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/META.yml (original)
+++ packages/libclass-mop-perl/trunk/META.yml Mon Apr 24 12:04:49 2006
@@ -1,6 +1,6 @@
---
name: Class-MOP
-version: 0.24
+version: 0.25
author:
- Stevan Little E<lt>stevan at iinteractive.comE<gt>
abstract: A Meta Object Protocol for Perl 5
@@ -17,16 +17,16 @@
provides:
Class::MOP:
file: lib/Class/MOP.pm
- version: 0.24
+ version: 0.25
Class::MOP::Attribute:
file: lib/Class/MOP/Attribute.pm
- version: 0.05
+ version: 0.06
Class::MOP::Attribute::Accessor:
file: lib/Class/MOP/Attribute.pm
- version: 0.05
+ version: 0.06
Class::MOP::Class:
file: lib/Class/MOP/Class.pm
- version: 0.10
+ version: 0.12
Class::MOP::Method:
file: lib/Class/MOP/Method.pm
version: 0.02
Modified: packages/libclass-mop-perl/trunk/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/README?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/README (original)
+++ packages/libclass-mop-perl/trunk/README Mon Apr 24 12:04:49 2006
@@ -1,4 +1,4 @@
-Class::MOP version 0.24
+Class::MOP version 0.25
===========================
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=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/debian/changelog (original)
+++ packages/libclass-mop-perl/trunk/debian/changelog Mon Apr 24 12:04:49 2006
@@ -1,6 +1,12 @@
+libclass-mop-perl (0.25-1) unstable; urgency=low
+
+ * New upstream release (closes: #363685)
+
+ -- Krzysztof Krzyzaniak (eloy) <eloy at debian.org> Mon, 24 Apr 2006 14:03:49 +0200
+
libclass-mop-perl (0.24-1) unstable; urgency=low
- * New upstream release (closes: #363685)
+ * New upstream release
-- Krzysztof Krzyzaniak (eloy) <eloy at debian.org> Thu, 20 Apr 2006 13:13:45 +0200
Modified: packages/libclass-mop-perl/trunk/examples/ClassEncapsulatedAttributes.pod
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/examples/ClassEncapsulatedAttributes.pod?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/examples/ClassEncapsulatedAttributes.pod (original)
+++ packages/libclass-mop-perl/trunk/examples/ClassEncapsulatedAttributes.pod Mon Apr 24 12:04:49 2006
@@ -5,7 +5,7 @@
use strict;
use warnings;
-our $VERSION = '0.04';
+our $VERSION = '0.05';
use base 'Class::MOP::Class';
@@ -25,21 +25,7 @@
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,
- # use the attributes name itself as the init_arg
- my $init_arg = $attr->init_arg();
- # try to fetch the init arg from the %params ...
- my $val;
- $val = $params{$current_class}->{$init_arg}
- if exists $params{$current_class} &&
- exists ${$params{$current_class}}{$init_arg};
- # if nothing was in the %params, we can use the
- # attribute's default value (if it has one)
- if (!defined $val && $attr->has_default) {
- $val = $attr->default($instance);
- }
- # now add this to the instance structure
- $instance->{$current_class}->{$attr_name} = $val;
+ $attr->initialize_instance_slot($meta, $instance, \%params);
}
}
return $instance;
@@ -51,9 +37,28 @@
use strict;
use warnings;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
use base 'Class::MOP::Attribute';
+
+sub initialize_instance_slot {
+ my ($self, $class, $instance, $params) = @_;
+ # if the attr has an init_arg, use that, otherwise,
+ # use the attributes name itself as the init_arg
+ my $init_arg = $self->init_arg();
+ # try to fetch the init arg from the %params ...
+ my $val;
+ $val = $params->{$class->name}->{$init_arg}
+ if exists $params->{$class->name} &&
+ exists ${$params->{$class->name}}{$init_arg};
+ # if nothing was in the %params, we can use the
+ # attribute's default value (if it has one)
+ if (!defined $val && $self->has_default) {
+ $val = $self->default($instance);
+ }
+ # now add this to the instance structure
+ $instance->{$class->name}->{$self->name} = $val;
+}
sub generate_accessor_method {
my ($self, $attr_name) = @_;
Modified: packages/libclass-mop-perl/trunk/examples/InsideOutClass.pod
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/examples/InsideOutClass.pod?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/examples/InsideOutClass.pod (original)
+++ packages/libclass-mop-perl/trunk/examples/InsideOutClass.pod Mon Apr 24 12:04:49 2006
@@ -1,38 +1,4 @@
-package # hide the package from PAUSE
- InsideOutClass;
-
-use strict;
-use warnings;
-
-our $VERSION = '0.04';
-
-use Scalar::Util 'refaddr';
-
-use base 'Class::MOP::Class';
-
-sub construct_instance {
- my ($class, %params) = @_;
- # create a scalar ref to use as
- # the inside-out instance
- my $instance = \(my $var);
- foreach my $attr ($class->compute_all_applicable_attributes()) {
- # if the attr has an init_arg, use that, otherwise,
- # use the attributes name itself as the init_arg
- my $init_arg = $attr->init_arg();
- # try to fetch the init arg from the %params ...
- my $val;
- $val = $params{$init_arg} if exists $params{$init_arg};
- # if nothing was in the %params, we can use the
- # attribute's default value (if it has one)
- if (!defined $val && $attr->has_default) {
- $val = $attr->default($instance);
- }
- # now add this to the instance structure
- $class->get_package_variable('%' . $attr->name)->{ refaddr($instance) } = $val;
- }
- return $instance;
-}
package # hide the package from PAUSE
InsideOutClass::Attribute;
@@ -40,12 +6,29 @@
use strict;
use warnings;
-our $VERSION = '0.04';
+our $VERSION = '0.05';
use Carp 'confess';
use Scalar::Util 'refaddr';
use base 'Class::MOP::Attribute';
+
+sub initialize_instance_slot {
+ my ($self, $class, $instance, $params) = @_;
+ # if the attr has an init_arg, use that, otherwise,
+ # use the attributes name itself as the init_arg
+ my $init_arg = $self->init_arg();
+ # try to fetch the init arg from the %params ...
+ my $val;
+ $val = $params->{$init_arg} if exists $params->{$init_arg};
+ # if nothing was in the %params, we can use the
+ # attribute's default value (if it has one)
+ if (!defined $val && $self->has_default) {
+ $val = $self->default($instance);
+ }
+ # now add this to the instance structure
+ $class->get_package_variable('%' . $self->name)->{ refaddr($instance) } = $val;
+}
sub generate_accessor_method {
my ($self, $attr_name) = @_;
@@ -94,7 +77,7 @@
package Foo;
- use metaclass 'InsideOutClass' => (
+ use metaclass 'Class::MOP::Class' => (
# tell our metaclass to use the
# InsideOut attribute metclass
# to construct all it's attributes
@@ -119,19 +102,12 @@
class technique. What follows is a brief explaination of the code
found in this module.
-First step is to subclass B<Class::MOP::Class> and override the
-C<construct_instance> method. The default C<construct_instance>
-will create a HASH reference using the parameters and attribute
-default values. Since inside-out objects don't use HASH refs, and
-use package variables instead, we need to write code to handle
-this difference.
-
-The next step is to create the subclass of B<Class::MOP::Attribute>
-and override the method generation code. This requires overloading
-C<generate_accessor_method>, C<generate_reader_method>,
-C<generate_writer_method> and C<generate_predicate_method>. All
-other aspects are taken care of with the existing B<Class::MOP::Attribute>
-infastructure.
+We must create a subclass of B<Class::MOP::Attribute> and override
+the instance initialization and method generation code. This requires
+overloading C<initialize_instance_slot>, C<generate_accessor_method>,
+C<generate_reader_method>, C<generate_writer_method> and
+C<generate_predicate_method>. All other aspects are taken care of with
+the existing B<Class::MOP::Attribute> infastructure.
And that is pretty much all. Of course I am ignoring need for
inside-out objects to be C<DESTROY>-ed, and some other details as
Modified: packages/libclass-mop-perl/trunk/examples/LazyClass.pod
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/examples/LazyClass.pod?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/examples/LazyClass.pod (original)
+++ packages/libclass-mop-perl/trunk/examples/LazyClass.pod Mon Apr 24 12:04:49 2006
@@ -1,30 +1,3 @@
-
-package # hide the package from PAUSE
- LazyClass;
-
-use strict;
-use warnings;
-
-our $VERSION = '0.02';
-
-use base 'Class::MOP::Class';
-
-sub construct_instance {
- my ($class, %params) = @_;
- my $instance = {};
- foreach my $attr ($class->compute_all_applicable_attributes()) {
- # if the attr has an init_arg, use that, otherwise,
- # use the attributes name itself as the init_arg
- my $init_arg = $attr->init_arg();
- # try to fetch the init arg from the %params ...
- my $val;
- $val = $params{$init_arg} if exists $params{$init_arg};
- # now add this to the instance structure
- # only if we have found a value at all
- $instance->{$attr->name} = $val if defined $val;
- }
- return $instance;
-}
package # hide the package from PAUSE
LazyClass::Attribute;
@@ -34,9 +7,23 @@
use Carp 'confess';
-our $VERSION = '0.02';
+our $VERSION = '0.03';
use base 'Class::MOP::Attribute';
+
+sub initialize_instance_slot {
+ my ($self, $class, $instance, $params) = @_;
+ # if the attr has an init_arg, use that, otherwise,
+ # use the attributes name itself as the init_arg
+ my $init_arg = $self->init_arg();
+ # try to fetch the init arg from the %params ...
+ my $val;
+ $val = $params->{$init_arg} if exists $params->{$init_arg};
+ # now add this to the instance structure
+ # only if we have found a value at all
+ $instance->{$self->name} = $val if defined $val;
+}
+
sub generate_accessor_method {
my ($self, $attr_name) = @_;
@@ -80,7 +67,7 @@
package BinaryTree;
- use metaclass 'LazyClass' => (
+ use metaclass 'Class::MOP::Class' => (
':attribute_metaclass' => 'LazyClass::Attribute'
);
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=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/lib/Class/MOP.pm (original)
+++ packages/libclass-mop-perl/trunk/lib/Class/MOP.pm Mon Apr 24 12:04:49 2006
@@ -11,7 +11,7 @@
use Class::MOP::Attribute;
use Class::MOP::Method;
-our $VERSION = '0.24';
+our $VERSION = '0.25';
## ----------------------------------------------------------------------------
## Setting up our environment ...
@@ -406,13 +406,13 @@
---------------------------- ------ ------ ------ ------ ------ ------ ------
File stmt bran cond sub pod time total
---------------------------- ------ ------ ------ ------ ------ ------ ------
- Class/MOP.pm 100.0 100.0 100.0 100.0 n/a 21.4 100.0
- Class/MOP/Attribute.pm 100.0 100.0 88.9 100.0 100.0 27.1 99.3
- Class/MOP/Class.pm 100.0 100.0 93.7 100.0 100.0 44.8 99.1
- Class/MOP/Method.pm 100.0 100.0 83.3 100.0 100.0 4.8 97.1
- metaclass.pm 100.0 100.0 80.0 100.0 n/a 1.9 97.3
+ Class/MOP.pm 100.0 100.0 100.0 100.0 n/a 9.6 100.0
+ Class/MOP/Attribute.pm 100.0 100.0 91.7 73.8 100.0 28.4 92.1
+ Class/MOP/Class.pm 100.0 93.5 82.3 98.2 100.0 56.6 95.7
+ Class/MOP/Method.pm 100.0 64.3 52.9 80.0 100.0 3.5 85.3
+ metaclass.pm 100.0 100.0 80.0 100.0 n/a 1.9 97.4
---------------------------- ------ ------ ------ ------ ------ ------ ------
- Total 100.0 100.0 92.2 100.0 100.0 100.0 99.0
+ Total 100.0 90.8 79.7 86.2 100.0 100.0 93.6
---------------------------- ------ ------ ------ ------ ------ ------ ------
=head1 ACKNOWLEDGEMENTS
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=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/lib/Class/MOP/Attribute.pm (original)
+++ packages/libclass-mop-perl/trunk/lib/Class/MOP/Attribute.pm Mon Apr 24 12:04:49 2006
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'reftype', 'weaken';
-our $VERSION = '0.05';
+our $VERSION = '0.06';
sub meta {
require Class::MOP::Class;
@@ -60,6 +60,20 @@
return bless { %{$self}, %options } => blessed($self);
}
+sub initialize_instance_slot {
+ my ($self, $class, $instance, $params) = @_;
+ my $init_arg = $self->init_arg();
+ # try to fetch the init arg from the %params ...
+ my $val;
+ $val = $params->{$init_arg} if exists $params->{$init_arg};
+ # if nothing was in the %params, we can use the
+ # attribute's default value (if it has one)
+ if (!defined $val && $self->has_default) {
+ $val = $self->default($instance);
+ }
+ $instance->{$self->name} = $val;
+}
+
# NOTE:
# the next bunch of methods will get bootstrapped
# away in the Class::MOP bootstrapping section
@@ -263,8 +277,6 @@
C<%options> are contained added as key-value pairs. Acceptable keys
are as follows:
-=item B<clone (%options)>
-
=over 4
=item I<init_arg>
@@ -375,6 +387,10 @@
=back
+=item B<clone (%options)>
+
+=item B<initialize_instance_slot ($instance, $params)>
+
=back
=head2 Informational
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=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/lib/Class/MOP/Class.pm (original)
+++ packages/libclass-mop-perl/trunk/lib/Class/MOP/Class.pm Mon Apr 24 12:04:49 2006
@@ -9,7 +9,7 @@
use Sub::Name 'subname';
use B 'svref_2object';
-our $VERSION = '0.10';
+our $VERSION = '0.12';
# Self-introspection
@@ -22,7 +22,13 @@
# there is no need to worry about destruction though
# because they should die only when the program dies.
# After all, do package definitions even get reaped?
- my %METAS;
+ my %METAS;
+
+ # means of accessing all the metaclasses that have
+ # been initialized thus far (for mugwumps obj browser)
+ sub get_all_metaclasses { %METAS }
+ sub get_all_metaclass_instances { values %METAS }
+ sub get_all_metaclass_names { keys %METAS }
sub initialize {
my $class = shift;
@@ -128,6 +134,20 @@
return $meta;
}
+{
+ # NOTE:
+ # this should be sufficient, if you have a
+ # use case where it is not, write a test and
+ # I will change it.
+ my $ANON_CLASS_SERIAL = 0;
+
+ sub create_anon_class {
+ my ($class, %options) = @_;
+ my $package_name = 'Class::MOP::Class::__ANON__::SERIAL::' . ++$ANON_CLASS_SERIAL;
+ return $class->create($package_name, '0.00', %options);
+ }
+}
+
## Attribute readers
# NOTE:
@@ -157,16 +177,7 @@
my ($class, %params) = @_;
my $instance = {};
foreach my $attr ($class->compute_all_applicable_attributes()) {
- my $init_arg = $attr->init_arg();
- # try to fetch the init arg from the %params ...
- my $val;
- $val = $params{$init_arg} if exists $params{$init_arg};
- # if nothing was in the %params, we can use the
- # attribute's default value (if it has one)
- if (!defined $val && $attr->has_default) {
- $val = $attr->default($instance);
- }
- $instance->{$attr->name} = $val;
+ $attr->initialize_instance_slot($class, $instance, \%params);
}
return $instance;
}
@@ -652,6 +663,21 @@
into it's metaclass. This will allow this class to reap all the benifits
of the MOP when subclassing it.
+=item B<get_all_metaclasses>
+
+This will return an hash of all the metaclass instances that have
+been cached by B<Class::MOP::Class> keyed by the package name.
+
+=item B<get_all_metaclass_instances>
+
+This will return an array of all the metaclass instances that have
+been cached by B<Class::MOP::Class>.
+
+=item B<get_all_metaclass_names>
+
+This will return an array of all the metaclass names that have
+been cached by B<Class::MOP::Class>.
+
=back
=head2 Class construction
@@ -675,6 +701,14 @@
C<$package_name> into existence and adding any of the
C<$package_version>, C<@superclasses>, C<%methods> and C<%attributes>
to it.
+
+=item B<create_anon_class (superclasses =E<gt> ?@superclasses,
+ methods =E<gt> ?%methods,
+ attributes =E<gt> ?%attributes)>
+
+This will create an anonymous class, it works much like C<create> but
+it does not need a C<$package_name>. Instead it will create a suitably
+unique package name for you to stash things into.
=item B<initialize ($package_name)>
Modified: packages/libclass-mop-perl/trunk/t/000_load.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/000_load.t?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/000_load.t (original)
+++ packages/libclass-mop-perl/trunk/t/000_load.t Mon Apr 24 12:04:49 2006
@@ -3,11 +3,34 @@
use strict;
use warnings;
-use Test::More tests => 4;
+use Test::More tests => 7;
BEGIN {
use_ok('Class::MOP');
use_ok('Class::MOP::Class');
use_ok('Class::MOP::Attribute');
use_ok('Class::MOP::Method');
-}
+}
+
+# make sure we are tracking metaclasses correctly
+
+my %METAS = (
+ 'Class::MOP::Attribute' => Class::MOP::Attribute->meta,
+ 'Class::MOP::Class' => Class::MOP::Class->meta,
+ 'Class::MOP::Method' => Class::MOP::Method->meta
+);
+
+is_deeply(
+ { Class::MOP::Class->get_all_metaclasses },
+ \%METAS,
+ '... got all the metaclasses');
+
+is_deeply(
+ [ sort { $a->name cmp $b->name } Class::MOP::Class->get_all_metaclass_instances ],
+ [ Class::MOP::Attribute->meta, Class::MOP::Class->meta, Class::MOP::Method->meta ],
+ '... got all the metaclass instances');
+
+is_deeply(
+ [ sort Class::MOP::Class->get_all_metaclass_names ],
+ [ 'Class::MOP::Attribute', 'Class::MOP::Class', 'Class::MOP::Method' ],
+ '... got all the metaclass names');
Modified: packages/libclass-mop-perl/trunk/t/001_basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/001_basic.t?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/001_basic.t (original)
+++ packages/libclass-mop-perl/trunk/t/001_basic.t Mon Apr 24 12:04:49 2006
@@ -67,3 +67,4 @@
[ $Baz->class_precedence_list ],
[ 'Baz', 'Bar', 'Foo', 'UNIVERSAL' ],
'... Baz->class_precedence_list == (Baz, Bar, Foo, UNIVERSAL)');
+
Modified: packages/libclass-mop-perl/trunk/t/004_advanced_methods.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/004_advanced_methods.t?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/004_advanced_methods.t (original)
+++ packages/libclass-mop-perl/trunk/t/004_advanced_methods.t Mon Apr 24 12:04:49 2006
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More tests => 14;
use Test::Exception;
BEGIN {
@@ -53,6 +53,25 @@
sub foobarbaz { 'Foo::Bar::Baz::foobarbaz' }
}
+ok(!defined(Class::MOP::Class->initialize('Foo')->find_next_method_by_name('BUILD')),
+ '... Foo::BUILD has not next method');
+
+is(Class::MOP::Class->initialize('Bar')->find_next_method_by_name('BUILD'),
+ Class::MOP::Class->initialize('Foo')->get_method('BUILD'),
+ '... Bar::BUILD does have a next method');
+
+is(Class::MOP::Class->initialize('Baz')->find_next_method_by_name('BUILD'),
+ Class::MOP::Class->initialize('Bar')->get_method('BUILD'),
+ '... Baz->BUILD does have a next method');
+
+is(Class::MOP::Class->initialize('Foo::Bar')->find_next_method_by_name('BUILD'),
+ Class::MOP::Class->initialize('Foo')->get_method('BUILD'),
+ '... Foo::Bar->BUILD does have a next method');
+
+is(Class::MOP::Class->initialize('Foo::Bar::Baz')->find_next_method_by_name('BUILD'),
+ Class::MOP::Class->initialize('Foo')->get_method('BUILD'),
+ '... Foo::Bar::Baz->BUILD does have a next method');
+
is_deeply(
[ sort { $a->{name} cmp $b->{name} } Class::MOP::Class->initialize('Foo')->compute_all_applicable_methods() ],
[
Modified: packages/libclass-mop-perl/trunk/t/010_self_introspection.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/010_self_introspection.t?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/010_self_introspection.t (original)
+++ packages/libclass-mop-perl/trunk/t/010_self_introspection.t Mon Apr 24 12:04:49 2006
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 126;
+use Test::More tests => 134;
use Test::Exception;
BEGIN {
@@ -22,7 +22,9 @@
my @methods = qw(
meta
- initialize create
+ get_all_metaclasses get_all_metaclass_names get_all_metaclass_instances
+
+ initialize create create_anon_class
new_object clone_object
construct_instance construct_class_instance clone_instance
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=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/014_attribute_introspection.t (original)
+++ packages/libclass-mop-perl/trunk/t/014_attribute_introspection.t Mon Apr 24 12:04:49 2006
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 39;
+use Test::More tests => 40;
use Test::Exception;
BEGIN {
@@ -22,6 +22,9 @@
my @methods = qw(
meta
new clone
+
+ initialize_instance_slot
+
name
has_accessor accessor
has_writer writer
Modified: packages/libclass-mop-perl/trunk/t/030_method.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/030_method.t?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/030_method.t (original)
+++ packages/libclass-mop-perl/trunk/t/030_method.t Mon Apr 24 12:04:49 2006
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 18;
+use Test::More tests => 25;
use Test::Exception;
BEGIN {
@@ -16,6 +16,15 @@
is($method->package_name, 'main', '... our package is main::');
is($method->name, '__ANON__', '... our sub name is __ANON__');
+is($method->fully_qualified_name, 'main::__ANON__', '... our subs full name is main::__ANON__');
+
+dies_ok { Class::MOP::Method->wrap } '... cant call this method without some code';
+dies_ok { Class::MOP::Method->wrap([]) } '... cant call this method without some code';
+dies_ok { Class::MOP::Method->wrap(bless {} => 'Fail') } '... cant call this method without some code';
+
+dies_ok { Class::MOP::Method->name } '... cant call this method with a class';
+dies_ok { Class::MOP::Method->package_name } '... cant call this method with a class';
+dies_ok { Class::MOP::Method->fully_qualified_name } '... cant call this method with a class';
my $meta = Class::MOP::Method->meta;
isa_ok($meta, 'Class::MOP::Class');
Modified: packages/libclass-mop-perl/trunk/t/102_InsideOutClass_test.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/102_InsideOutClass_test.t?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/102_InsideOutClass_test.t (original)
+++ packages/libclass-mop-perl/trunk/t/102_InsideOutClass_test.t Mon Apr 24 12:04:49 2006
@@ -14,7 +14,7 @@
{
package Foo;
- use metaclass 'InsideOutClass' => (
+ use metaclass 'Class::MOP::Class' => (
':attribute_metaclass' => 'InsideOutClass::Attribute'
);
Modified: packages/libclass-mop-perl/trunk/t/106_LazyClass_test.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libclass-mop-perl/trunk/t/106_LazyClass_test.t?rev=2627&op=diff
==============================================================================
--- packages/libclass-mop-perl/trunk/t/106_LazyClass_test.t (original)
+++ packages/libclass-mop-perl/trunk/t/106_LazyClass_test.t Mon Apr 24 12:04:49 2006
@@ -14,7 +14,7 @@
{
package BinaryTree;
- use metaclass 'LazyClass' => (
+ use metaclass 'Class::MOP::Class' => (
':attribute_metaclass' => 'LazyClass::Attribute'
);
More information about the Pkg-perl-cvs-commits
mailing list