r20544 - in /branches/upstream/libclass-mop-perl/current: ./ lib/Class/ lib/Class/MOP/ lib/Class/MOP/Method/ t/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Fri May 30 10:40:03 UTC 2008
Author: eloy
Date: Fri May 30 10:40:02 2008
New Revision: 20544
URL: http://svn.debian.org/wsvn/?sc=1&rev=20544
Log:
[svn-upgrade] Integrating new upstream version, libclass-mop-perl (0.58)
Modified:
branches/upstream/libclass-mop-perl/current/Changes
branches/upstream/libclass-mop-perl/current/META.yml
branches/upstream/libclass-mop-perl/current/README
branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Immutable.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Accessor.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Constructor.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Generated.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm
branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t
branches/upstream/libclass-mop-perl/current/t/080_meta_package.t
Modified: branches/upstream/libclass-mop-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/Changes?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/Changes (original)
+++ branches/upstream/libclass-mop-perl/current/Changes Fri May 30 10:40:02 2008
@@ -1,4 +1,38 @@
Revision history for Perl extension Class-MOP.
+
+0.58 Thurs. May 29, 2008
+ (late night release engineering)--
+
+ - fixing the version is META.yml, no functional
+ changes in this release
+
+0.57 Wed. May 28, 2008
+ !! Seveal speedups resulting in 20-25% speedups !!
+ || (thanks to konobi, groditi, mst & CataMoose) !!
+
+ * Class::MOP::Class
+ - made get_method_map use list_all_package_symbols
+ instead of manually grabbing each symbol
+ - streamlining &initialize somewhat, since it gets
+ called so much
+
+ * Class::MOP::Package
+ - made {get, has}_package_symbol not call
+ &namespace so much
+ - inlining a few calls to &name with
+ direct HASH access key access
+ - added get_all_package_symbols to fetch
+ a HASH of items based on a type filter
+ similar to list_all_package_symbols
+ - added tests for this
+
+ * Class::MOP::Method
+ Class::MOP::Method::Constructor
+ Class::MOP::Method::Generated
+ Class::MOP::Method::Accessor
+ - added more descriptive error message to help
+ keep people from wasting time tracking an error
+ that is easily fixed by upgrading.
0.56 Saturday, May 24, 2008
* Class::MOP
Modified: branches/upstream/libclass-mop-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/META.yml?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/META.yml (original)
+++ branches/upstream/libclass-mop-perl/current/META.yml Fri May 30 10:40:02 2008
@@ -1,69 +1,71 @@
----
-abstract: A Meta Object Protocol for Perl 5
-author:
- - Stevan Little <stevan at iinteractive.com>
-build_requires:
+---
+abstract: 'A Meta Object Protocol for Perl 5'
+author:
+ - 'Stevan Little <stevan at iinteractive.com>'
+build_requires:
File::Spec: 0
Test::Exception: 0.21
Test::More: 0.62
distribution_type: module
-generated_by: Module::Install version 0.68
+generated_by: 'Module::Install version 0.73'
license: perl
-meta-spec:
+meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3
name: Class-MOP
-no_index:
- directory:
+no_index:
+ directory:
- inc
- t
-provides:
- Class::MOP:
+ - examples
+ - examples
+provides:
+ Class::MOP:
file: lib/Class/MOP.pm
- version: 0.56
- Class::MOP::Attribute:
+ version: 0.58
+ Class::MOP::Attribute:
file: lib/Class/MOP/Attribute.pm
- version: 0.24
- Class::MOP::Class:
+ version: 0.25
+ Class::MOP::Class:
file: lib/Class/MOP/Class.pm
- version: 0.31
- Class::MOP::Immutable:
+ version: 0.32
+ Class::MOP::Immutable:
file: lib/Class/MOP/Immutable.pm
version: 0.06
- Class::MOP::Instance:
+ Class::MOP::Instance:
file: lib/Class/MOP/Instance.pm
version: 0.05
- Class::MOP::Method:
+ Class::MOP::Method:
file: lib/Class/MOP/Method.pm
- version: 0.07
- Class::MOP::Method::Accessor:
+ version: 0.08
+ Class::MOP::Method::Accessor:
file: lib/Class/MOP/Method/Accessor.pm
+ version: 0.04
+ Class::MOP::Method::Constructor:
+ file: lib/Class/MOP/Method/Constructor.pm
+ version: 0.06
+ Class::MOP::Method::Generated:
+ file: lib/Class/MOP/Method/Generated.pm
version: 0.03
- Class::MOP::Method::Constructor:
- file: lib/Class/MOP/Method/Constructor.pm
- version: 0.05
- Class::MOP::Method::Generated:
- file: lib/Class/MOP/Method/Generated.pm
- version: 0.02
- Class::MOP::Method::Wrapped:
+ Class::MOP::Method::Wrapped:
file: lib/Class/MOP/Method/Wrapped.pm
version: 0.03
- Class::MOP::Module:
+ Class::MOP::Module:
file: lib/Class/MOP/Module.pm
version: 0.03
- Class::MOP::Object:
+ Class::MOP::Object:
file: lib/Class/MOP/Object.pm
version: 0.03
- Class::MOP::Package:
+ Class::MOP::Package:
file: lib/Class/MOP/Package.pm
- version: 0.08
- metaclass:
+ version: 0.09
+ metaclass:
file: lib/metaclass.pm
version: 0.05
-requires:
+requires:
Carp: 0
MRO::Compat: 0.05
Scalar::Util: 1.18
Sub::Identify: 0.03
Sub::Name: 0.02
-version: 0.56
+version: 0.58
Modified: branches/upstream/libclass-mop-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/README?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/README (original)
+++ branches/upstream/libclass-mop-perl/current/README Fri May 30 10:40:02 2008
@@ -1,4 +1,4 @@
-Class::MOP version 0.55
+Class::MOP version 0.58
===========================
See the individual module documentation for more information
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm Fri May 30 10:40:02 2008
@@ -16,7 +16,7 @@
use Class::MOP::Immutable;
BEGIN {
- our $VERSION = '0.56';
+ our $VERSION = '0.58';
our $AUTHORITY = 'cpan:STEVAN';
*IS_RUNNING_ON_5_10 = ($] < 5.009_005)
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm Fri May 30 10:40:02 2008
@@ -11,7 +11,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'reftype', 'weaken';
-our $VERSION = '0.31';
+our $VERSION = '0.32';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Module';
@@ -23,10 +23,8 @@
my $package_name = shift;
(defined $package_name && $package_name && !blessed($package_name))
|| confess "You must pass a package name and it cannot be blessed";
- if (defined(my $meta = Class::MOP::get_metaclass_by_name($package_name))) {
- return $meta;
- }
- $class->construct_class_instance('package' => $package_name, @_);
+ return Class::MOP::get_metaclass_by_name($package_name)
+ || $class->construct_class_instance('package' => $package_name, @_);
}
sub reinitialize {
@@ -312,8 +310,10 @@
my $class_name = $self->name;
my $method_metaclass = $self->method_metaclass;
- foreach my $symbol ($self->list_all_package_symbols('CODE')) {
- my $code = $self->get_package_symbol('&' . $symbol);
+ my %all_code = $self->get_all_package_symbols('CODE');
+
+ foreach my $symbol (keys %all_code) {
+ my $code = $all_code{$symbol};
next if exists $map->{$symbol} &&
defined $map->{$symbol} &&
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Immutable.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Immutable.pm?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Immutable.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Immutable.pm Fri May 30 10:40:02 2008
@@ -114,20 +114,27 @@
my $destructor_class = $options{destructor_class};
- my $destructor = $destructor_class->new(
- options => \%options,
- metaclass => $metaclass,
- package_name => $metaclass->name,
- name => 'DESTROY'
- );
-
- $metaclass->add_method('DESTROY' => $destructor)
- # NOTE:
- # we allow the destructor to determine
- # if it is needed or not, it can perform
- # all sorts of checks because it has the
- # metaclass instance
- if $destructor->is_needed;
+ # NOTE:
+ # we allow the destructor to determine
+ # if it is needed or not before we actually
+ # create the destructor too
+ # - SL
+ if ($destructor_class->is_needed($metaclass)) {
+ my $destructor = $destructor_class->new(
+ options => \%options,
+ metaclass => $metaclass,
+ package_name => $metaclass->name,
+ name => 'DESTROY'
+ );
+
+ $metaclass->add_method('DESTROY' => $destructor)
+ # NOTE:
+ # we allow the destructor to determine
+ # if it is needed or not, it can perform
+ # all sorts of checks because it has the
+ # metaclass instance
+ if $destructor->is_needed;
+ }
}
my $memoized_methods = $self->options->{memoize};
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method.pm?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method.pm Fri May 30 10:40:02 2008
@@ -7,31 +7,40 @@
use Carp 'confess';
use Scalar::Util 'reftype', 'blessed';
-our $VERSION = '0.07';
+our $VERSION = '0.08';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Object';
# NOTE:
-# if poked in the right way,
+# if poked in the right way,
# they should act like CODE refs.
use overload '&{}' => sub { $_[0]->body }, fallback => 1;
+our $UPGRADE_ERROR_TEXT = q{
+---------------------------------------------------------
+NOTE: this error is likely not an error, but a regression
+caused by the latest upgrade to Moose/Class::MOP. Consider
+upgrading any MooseX::* modules to their latest versions
+before spending too much time chasing this one down.
+---------------------------------------------------------
+};
+
# construction
-sub wrap {
+sub wrap {
my ( $class, $code, %params ) = @_;
-
+
('CODE' eq (reftype($code) || ''))
|| confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
-
+
($params{package_name} && $params{name})
- || confess "You must supply the package_name and name parameters";
-
- bless {
+ || confess "You must supply the package_name and name parameters $UPGRADE_ERROR_TEXT";
+
+ bless {
'&!body' => $code,
'$!package_name' => $params{package_name},
- '$!name' => $params{name},
+ '$!name' => $params{name},
} => blessed($class) || $class;
}
@@ -43,12 +52,12 @@
# informational
-sub package_name {
+sub package_name {
my $self = shift;
$self->{'$!package_name'} ||= (Class::MOP::get_code_info($self->body))[0];
}
-sub name {
+sub name {
my $self = shift;
$self->{'$!name'} ||= (Class::MOP::get_code_info($self->body))[1];
}
@@ -70,14 +79,14 @@
=pod
-=head1 NAME
+=head1 NAME
Class::MOP::Method - Method Meta Object
=head1 DESCRIPTION
-The Method Protocol is very small, since methods in Perl 5 are just
-subroutines within the particular package. We provide a very basic
+The Method Protocol is very small, since methods in Perl 5 are just
+subroutines within the particular package. We provide a very basic
introspection interface.
=head1 METHODS
@@ -88,7 +97,7 @@
=item B<meta>
-This will return a B<Class::MOP::Class> instance which is related
+This will return a B<Class::MOP::Class> instance which is related
to this class.
=back
@@ -99,15 +108,15 @@
=item B<wrap ($code, %params)>
-This is the basic constructor, it returns a B<Class::MOP::Method>
-instance which wraps the given C<$code> reference. You can also
+This is the basic constructor, it returns a B<Class::MOP::Method>
+instance which wraps the given C<$code> reference. You can also
set the C<package_name> and C<name> attributes using the C<%params>.
-If these are not set, then thier accessors will attempt to figure
+If these are not set, then thier accessors will attempt to figure
it out using the C<Class::MOP::get_code_info> function.
=item B<clone (%params)>
-This will make a copy of the object, allowing you to override
+This will make a copy of the object, allowing you to override
any values by stuffing them in C<%params>.
=back
@@ -145,7 +154,7 @@
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: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Accessor.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Accessor.pm?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Accessor.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Accessor.pm Fri May 30 10:40:02 2008
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.03';
+our $VERSION = '0.04';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Method::Generated';
@@ -26,7 +26,7 @@
|| confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
($options{package_name} && $options{name})
- || confess "You must supply the package_name and name parameters";
+ || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
my $self = bless {
# from our superclass
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Constructor.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Constructor.pm?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Constructor.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Constructor.pm Fri May 30 10:40:02 2008
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
-our $VERSION = '0.05';
+our $VERSION = '0.06';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Method::Generated';
@@ -21,7 +21,7 @@
if $options{is_inline};
($options{package_name} && $options{name})
- || confess "You must supply the package_name and name parameters";
+ || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
my $self = bless {
# from our superclass
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Generated.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Generated.pm?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Generated.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Generated.pm Fri May 30 10:40:02 2008
@@ -6,7 +6,7 @@
use Carp 'confess';
-our $VERSION = '0.02';
+our $VERSION = '0.03';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Method';
@@ -16,7 +16,7 @@
my %options = @_;
($options{package_name} && $options{name})
- || confess "You must supply the package_name and name parameters";
+ || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
my $self = bless {
# from our superclass
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm Fri May 30 10:40:02 2008
@@ -7,7 +7,7 @@
use Scalar::Util 'blessed';
use Carp 'confess';
-our $VERSION = '0.08';
+our $VERSION = '0.09';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Object';
@@ -39,7 +39,7 @@
# all these attribute readers will be bootstrapped
# away in the Class::MOP bootstrap section
-sub name { $_[0]->{'$!package'} }
+sub name { $_[0]->{'$!package'} }
sub namespace {
# NOTE:
# because of issues with the Perl API
@@ -49,7 +49,7 @@
# we could just store a ref and it would
# Just Work, but oh well :\
no strict 'refs';
- \%{$_[0]->name . '::'}
+ \%{$_[0]->{'$!package'} . '::'}
}
# utility methods
@@ -89,9 +89,11 @@
my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
+ my $pkg = $self->{'$!package'};
+
no strict 'refs';
no warnings 'redefine', 'misc';
- *{$self->name . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value;
+ *{$pkg . '::' . $name} = ref $initial_value ? $initial_value : \$initial_value;
}
sub remove_package_glob {
@@ -107,7 +109,9 @@
my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
- return 0 unless exists $self->namespace->{$name};
+ my $namespace = $self->namespace;
+
+ return 0 unless exists $namespace->{$name};
# FIXME:
# For some really stupid reason
@@ -118,15 +122,15 @@
# if you put \undef in your scalar
# then this is broken.
- if (ref($self->namespace->{$name}) eq 'SCALAR') {
+ if (ref($namespace->{$name}) eq 'SCALAR') {
return ($type eq 'CODE' ? 1 : 0);
}
elsif ($type eq 'SCALAR') {
- my $val = *{$self->namespace->{$name}}{$type};
+ my $val = *{$namespace->{$name}}{$type};
return defined(${$val}) ? 1 : 0;
}
else {
- defined(*{$self->namespace->{$name}}{$type}) ? 1 : 0;
+ defined(*{$namespace->{$name}}{$type}) ? 1 : 0;
}
}
@@ -135,10 +139,12 @@
my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
+ my $namespace = $self->namespace;
+
$self->add_package_symbol($variable)
- unless exists $self->namespace->{$name};
-
- if (ref($self->namespace->{$name}) eq 'SCALAR') {
+ unless exists $namespace->{$name};
+
+ if (ref($namespace->{$name}) eq 'SCALAR') {
if ($type eq 'CODE') {
no strict 'refs';
return \&{$self->name.'::'.$name};
@@ -148,7 +154,7 @@
}
}
else {
- return *{$self->namespace->{$name}}{$type};
+ return *{$namespace->{$name}}{$type};
}
}
@@ -196,11 +202,13 @@
sub list_all_package_symbols {
my ($self, $type_filter) = @_;
- return keys %{$self->namespace} unless defined $type_filter;
+
+ my $namespace = $self->namespace;
+ return keys %{$namespace} unless defined $type_filter;
+
# NOTE:
# or we can filter based on
# type (SCALAR|ARRAY|HASH|CODE)
- my $namespace = $self->namespace;
return grep {
(ref($namespace->{$_})
? (ref($namespace->{$_}) eq 'SCALAR' && $type_filter eq 'CODE')
@@ -209,6 +217,27 @@
} keys %{$namespace};
}
+sub get_all_package_symbols {
+ my ($self, $type_filter) = @_;
+ my $namespace = $self->namespace;
+ return %{$namespace} unless defined $type_filter;
+
+ # NOTE:
+ # or we can filter based on
+ # type (SCALAR|ARRAY|HASH|CODE)
+ no strict 'refs';
+ return map {
+ $_ => (ref($namespace->{$_}) eq 'SCALAR'
+ ? ($type_filter eq 'CODE' ? \&{$self->name . '::' . $_} : undef)
+ : *{$namespace->{$_}}{$type_filter})
+ } grep {
+ (ref($namespace->{$_})
+ ? (ref($namespace->{$_}) eq 'SCALAR' && $type_filter eq 'CODE')
+ : (ref(\$namespace->{$_}) eq 'GLOB'
+ && defined(*{$namespace->{$_}}{$type_filter})));
+ } keys %{$namespace};
+}
+
1;
__END__
@@ -284,6 +313,11 @@
By passing a C<$type_filter>, you can limit the list to only those
which match the filter (either SCALAR, ARRAY, HASH or CODE).
+=item B<get_all_package_symbols (?$type_filter)>
+
+Works exactly like C<list_all_package_symbols> but returns a HASH of
+name => thing mapping instead of just an ARRAY of names.
+
=back
=head1 AUTHORS
Modified: branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t (original)
+++ branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t Fri May 30 10:40:02 2008
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 199;
+use Test::More tests => 201;
use Test::Exception;
BEGIN {
@@ -35,7 +35,7 @@
namespace
add_package_symbol get_package_symbol has_package_symbol remove_package_symbol
- list_all_package_symbols remove_package_glob
+ list_all_package_symbols get_all_package_symbols remove_package_glob
_deconstruct_variable_name
);
Modified: branches/upstream/libclass-mop-perl/current/t/080_meta_package.t
URL: http://svn.debian.org/wsvn/branches/upstream/libclass-mop-perl/current/t/080_meta_package.t?rev=20544&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/t/080_meta_package.t (original)
+++ branches/upstream/libclass-mop-perl/current/t/080_meta_package.t Fri May 30 10:40:02 2008
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 88;
+use Test::More tests => 92;
use Test::Exception;
BEGIN {
@@ -226,6 +226,31 @@
ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');
}
+# get_all_package_symbols
+
+{
+ my %syms = Foo->meta->get_all_package_symbols;
+
+ is_deeply(
+ [ sort keys %syms ],
+ [ sort Foo->meta->list_all_package_symbols ],
+ '... the fetched symbols are the same as the listed ones'
+ );
+}
+
+{
+ my %syms = Foo->meta->get_all_package_symbols('CODE');
+
+ is_deeply(
+ [ sort keys %syms ],
+ [ sort Foo->meta->list_all_package_symbols('CODE') ],
+ '... the fetched symbols are the same as the listed ones'
+ );
+
+ foreach my $symbol (keys %syms) {
+ is($syms{$symbol}, Foo->meta->get_package_symbol('&' . $symbol), '... got the right symbol');
+ }
+}
# check some errors
More information about the Pkg-perl-cvs-commits
mailing list