r61946 - in /trunk/libclass-mop-perl: ./ debian/ lib/ lib/Class/ lib/Class/MOP/ lib/Class/MOP/Class/Immutable/ lib/Class/MOP/Method/ lib/Class/MOP/Mixin/ t/
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Mon Aug 23 21:48:34 UTC 2010
Author: angelabad-guest
Date: Mon Aug 23 21:48:02 2010
New Revision: 61946
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=61946
Log:
* New upstream release
* Add myself to uploaders
* debian/control: Remove some versioned {Build}-Depends which are in
stable release
* Update copyright file
Added:
trunk/libclass-mop-perl/t/316_numeric_defaults.t
- copied unchanged from r61945, branches/upstream/libclass-mop-perl/current/t/316_numeric_defaults.t
Modified:
trunk/libclass-mop-perl/Changes
trunk/libclass-mop-perl/MANIFEST
trunk/libclass-mop-perl/META.yml
trunk/libclass-mop-perl/README
trunk/libclass-mop-perl/debian/changelog
trunk/libclass-mop-perl/debian/control
trunk/libclass-mop-perl/debian/copyright
trunk/libclass-mop-perl/lib/Class/MOP.pm
trunk/libclass-mop-perl/lib/Class/MOP/Attribute.pm
trunk/libclass-mop-perl/lib/Class/MOP/Class.pm
trunk/libclass-mop-perl/lib/Class/MOP/Class/Immutable/Trait.pm
trunk/libclass-mop-perl/lib/Class/MOP/Deprecated.pm
trunk/libclass-mop-perl/lib/Class/MOP/Instance.pm
trunk/libclass-mop-perl/lib/Class/MOP/Method.pm
trunk/libclass-mop-perl/lib/Class/MOP/Method/Accessor.pm
trunk/libclass-mop-perl/lib/Class/MOP/Method/Constructor.pm
trunk/libclass-mop-perl/lib/Class/MOP/Method/Generated.pm
trunk/libclass-mop-perl/lib/Class/MOP/Method/Inlined.pm
trunk/libclass-mop-perl/lib/Class/MOP/Method/Wrapped.pm
trunk/libclass-mop-perl/lib/Class/MOP/Mixin.pm
trunk/libclass-mop-perl/lib/Class/MOP/Mixin/AttributeCore.pm
trunk/libclass-mop-perl/lib/Class/MOP/Mixin/HasAttributes.pm
trunk/libclass-mop-perl/lib/Class/MOP/Mixin/HasMethods.pm
trunk/libclass-mop-perl/lib/Class/MOP/Module.pm
trunk/libclass-mop-perl/lib/Class/MOP/Object.pm
trunk/libclass-mop-perl/lib/Class/MOP/Package.pm
trunk/libclass-mop-perl/lib/metaclass.pm
trunk/libclass-mop-perl/t/003_methods.t
trunk/libclass-mop-perl/t/021_attribute_errors_and_edge_cases.t
Modified: trunk/libclass-mop-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/Changes?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/Changes (original)
+++ trunk/libclass-mop-perl/Changes Mon Aug 23 21:48:02 2010
@@ -1,4 +1,23 @@
Revision history for Perl extension Class-MOP.
+
+1.06 Sun, Aug 23, 2010
+
+ [BUG FIXES]
+
+ * Version 1.05 no longer reported constants as methods, except with Perl
+ 5.8.x, and doing so in 5.8.x caused test failures. Constants are now
+ _expected_ to be reported as methods, and this is tested for
+ explicit. (Dave Rolsky)
+
+
+1.05 Sun, Aug 22, 2010
+
+ [ENHANCEMENTS]
+
+ * Refactorings and improvements to how defaults are handled, particularly
+ for inlined code (doy).
+
+ * Optimizations that should help speed up compilation time (Dave Rolsky).
1.04 Tue, Jul 25, 2010
@@ -9,7 +28,7 @@
package, which cuts down on noise. When importing Class::MOP::Deprecated,
the request API version should now be passed in the "-api_version"
flag. However, the old "-compatible" flag will continue to work. (Dave
- Rolsky).
+ Rolsky)
1.03 Sat, Jun 5, 2010
Modified: trunk/libclass-mop-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/MANIFEST?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/MANIFEST (original)
+++ trunk/libclass-mop-perl/MANIFEST Mon Aug 23 21:48:02 2010
@@ -123,6 +123,7 @@
t/313_before_after_dollar_under.t
t/314_class_is_pristine.t
t/315_magic.t
+t/316_numeric_defaults.t
t/500_deprecated.t
t/lib/BinaryTree.pm
t/lib/MyMetaClass.pm
Modified: trunk/libclass-mop-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/META.yml?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/META.yml (original)
+++ trunk/libclass-mop-perl/META.yml Mon Aug 23 21:48:02 2010
@@ -38,5 +38,5 @@
resources:
license: http://dev.perl.org/licenses/
repository: git://git.moose.perl.org/Class-MOP.git
-version: 1.04
+version: 1.06
x_authority: cpan:STEVAN
Modified: trunk/libclass-mop-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/README?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/README (original)
+++ trunk/libclass-mop-perl/README Mon Aug 23 21:48:02 2010
@@ -1,4 +1,4 @@
-Class::MOP version 1.04
+Class::MOP version 1.06
===========================
See the individual module documentation for more information
Modified: trunk/libclass-mop-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/debian/changelog?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/debian/changelog (original)
+++ trunk/libclass-mop-perl/debian/changelog Mon Aug 23 21:48:02 2010
@@ -1,3 +1,13 @@
+libclass-mop-perl (1.06-1) unstable; urgency=low
+
+ * New upstream release
+ * Add myself to uploaders
+ * debian/control: Remove some versioned {Build}-Depends which are in
+ stable release
+ * Update copyright file
+
+ -- Angel Abad <angelabad at gmail.com> Mon, 23 Aug 2010 23:47:25 +0200
+
libclass-mop-perl (1.04-1) unstable; urgency=low
* New upstream release.
Modified: trunk/libclass-mop-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/debian/control?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/debian/control (original)
+++ trunk/libclass-mop-perl/debian/control Mon Aug 23 21:48:02 2010
@@ -1,21 +1,22 @@
Source: libclass-mop-perl
Section: perl
Priority: optional
-Build-Depends: perl, perl (>= 5.10.1) | libtest-simple-perl (>= 0.88), debhelper (>= 7),
- libsub-name-perl (>= 0.04), libtask-weaken-perl,
- libtest-exception-perl (>= 0.27), libtest-pod-perl, libtest-pod-coverage-perl,
- libdevel-globaldestruction-perl, libsuper-perl,
- libalgorithm-c3-perl, libmro-compat-perl, libtest-output-perl,
- libclass-c3-perl, libtest-leaktrace-perl, libtry-tiny-perl,
- libdata-optlist-perl, liblist-moreutils-perl, libpackage-stash-perl,
- libpackage-deprecationmanager-perl
+Build-Depends: debhelper (>= 7), libalgorithm-c3-perl, libclass-c3-perl,
+ libdata-optlist-perl, libdevel-globaldestruction-perl,
+ liblist-moreutils-perl, libmro-compat-perl,
+ libpackage-deprecationmanager-perl, libpackage-stash-perl,
+ libsub-name-perl (>= 0.04), libsuper-perl, libtask-weaken-perl,
+ libtest-exception-perl, libtest-leaktrace-perl, libtest-output-perl,
+ libtest-pod-coverage-perl, libtest-pod-perl, libtry-tiny-perl,
+ perl, perl (>= 5.10.1) | libtest-simple-perl (>= 0.88)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Krzysztof Krzyżaniak (eloy) <eloy at debian.org>,
Damyan Ivanov <dmn at debian.org>, Russ Allbery <rra at debian.org>,
gregor herrmann <gregoa at debian.org>, Brian Cassidy <brian.cassidy at gmail.com>,
Antonio Radici <antonio at dyne.org>, Ryan Niebur <ryan at debian.org>,
Salvatore Bonaccorso <salvatore.bonaccorso at gmail.com>,
- Jonathan Yu <jawnsy at cpan.org>, Ansgar Burchardt <ansgar at 43-1.org>
+ Jonathan Yu <jawnsy at cpan.org>, Ansgar Burchardt <ansgar at 43-1.org>,
+ Angel Abad <angelabad at gmail.com>
Standards-Version: 3.9.1
Homepage: http://search.cpan.org/dist/Class-MOP/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libclass-mop-perl/
@@ -23,11 +24,11 @@
Package: libclass-mop-perl
Architecture: any
-Depends: ${perl:Depends}, ${misc:Depends}, ${shlibs:Depends},
- libdevel-globaldestruction-perl, libsub-name-perl (>= 0.04),
- libmro-compat-perl, libtry-tiny-perl, libtask-weaken-perl,
- libdata-optlist-perl, liblist-moreutils-perl, libpackage-stash-perl,
- libpackage-deprecationmanager-perl
+Depends: ${misc:Depends}, ${perl:Depends}, ${shlibs:Depends},
+ libdata-optlist-perl, libdevel-globaldestruction-perl,
+ liblist-moreutils-perl, libmro-compat-perl,
+ libpackage-deprecationmanager-perl, libpackage-stash-perl,
+ libsub-name-perl, libtask-weaken-perl, libtry-tiny-perl
Suggests: libmoose-perl
Breaks: libmoose-perl (<< 1.04)
Description: Perl module implementing a Meta Object Protocol (MOP)
Modified: trunk/libclass-mop-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/debian/copyright?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/debian/copyright (original)
+++ trunk/libclass-mop-perl/debian/copyright Mon Aug 23 21:48:02 2010
@@ -1,4 +1,4 @@
-Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=59
+Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135
Maintainer: Stevan Little <stevan at iinteractive.com>
Source: http://search.cpan.org/dist/Class-MOP/
Name: Class-MOP
@@ -19,18 +19,18 @@
License: Artistic or GPL-1+
Files: debian/*
-Copyright: 2009-2010, Jonathan Yu <jawnsy at cpan.org>
+Copyright: 2006-2010, gregor herrmann <gregoa at debian.org>
+ 2006-2008, Krzysztof Krzyzaniak (eloy) <eloy at debian.org>
+ 2007-2008, Damyan Ivanov <dmn at debian.org>
+ 2007, Russ Allbery <rra at debian.org>
+ 2008-2009, Brian Cassidy <brian.cassidy at gmail.com>
+ 2008, Roberto C. Sanchez <roberto at debian.org>
2009-2010, Ansgar Burchardt <ansgar at 43-1.org>
+ 2009-2010, Jonathan Yu <jawnsy at cpan.org>
2009, Antonio Radici <antonio at dyne.org>
2009, Ryan Niebur <ryanryan52 at gmail.com>
2009, Salvatore Bonaccorso <salvatore.bonaccorso at gmail.com>
- 2008-2009, Brian Cassidy <brian.cassidy at gmail.com>
- 2006-2010, gregor herrmann <gregoa at debian.org>
- 2008, Krzysztof Krzyżaniak (eloy) <eloy at debian.org>
- 2008, Roberto C. Sanchez <roberto at debian.org>
- 2007-2008, Damyan Ivanov <dmn at debian.org>
- 2007, Russ Allbery <rra at debian.org>
- 2006-2007, Krzysztof Krzyzaniak (eloy) <eloy at debian.org>
+ 2010, Angel Abad <angelabad at gmail.com>
License: Artistic or GPL-1+
License: Artistic
@@ -46,5 +46,5 @@
the Free Software Foundation; either version 1, or (at your option)
any later version.
.
- On Debian GNU/Linux systems, the complete text of version 1 of the GNU
+ On Debian GNU/Linux systems, the complete text of version 1 of the
General Public License can be found in `/usr/share/common-licenses/GPL-1'.
Modified: trunk/libclass-mop-perl/lib/Class/MOP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP.pm Mon Aug 23 21:48:02 2010
@@ -29,14 +29,13 @@
*check_package_cache_flag = \&mro::get_pkg_gen;
}
-our $VERSION = '1.04';
+our $VERSION = '1.06';
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
require XSLoader;
XSLoader::load( __PACKAGE__, $XS_VERSION );
-
{
# Metaclasses are singletons, so we cache them here.
@@ -549,13 +548,6 @@
))
);
-Class::MOP::Method->meta->add_method('clone' => sub {
- my $self = shift;
- my $clone = $self->meta->clone_object($self, @_);
- $clone->_set_original_method($self);
- return $clone;
-});
-
## --------------------------------------------------------
## Class::MOP::Method::Wrapped
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Attribute.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Attribute.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Attribute.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Attribute.pm Mon Aug 23 21:48:02 2010
@@ -10,7 +10,7 @@
use Scalar::Util 'blessed', 'weaken';
use Try::Tiny;
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -73,7 +73,9 @@
'clearer' => $options->{clearer},
'builder' => $options->{builder},
'init_arg' => $options->{init_arg},
- 'default' => $options->{default},
+ exists $options->{default}
+ ? ('default' => $options->{default})
+ : (),
'initializer' => $options->{initializer},
'definition_context' => $options->{definition_context},
# keep a weakened link to the
@@ -117,7 +119,7 @@
$params->{$init_arg},
);
}
- elsif (defined $self->{'default'}) {
+ elsif (exists $self->{'default'}) {
$self->_set_initial_slot_value(
$meta_instance,
$instance,
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Class.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Class.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Class.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Class.pm Mon Aug 23 21:48:02 2010
@@ -16,7 +16,7 @@
use Try::Tiny;
use List::MoreUtils 'all';
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -190,29 +190,31 @@
sub _check_metaclass_compatibility {
my $self = shift;
- if (my @superclasses = $self->superclasses) {
- $self->_fix_metaclass_incompatibility(@superclasses);
-
- my %base_metaclass = $self->_base_metaclasses;
-
- # this is always okay ...
- return if ref($self) eq 'Class::MOP::Class'
+ my @superclasses = $self->superclasses
+ or return;
+
+ $self->_fix_metaclass_incompatibility(@superclasses);
+
+ my %base_metaclass = $self->_base_metaclasses;
+
+ # this is always okay ...
+ return
+ if ref($self) eq 'Class::MOP::Class'
&& all {
my $meta = $self->$_;
- !defined($meta) || $meta eq $base_metaclass{$_}
- } keys %base_metaclass;
-
+ !defined($meta) || $meta eq $base_metaclass{$_};
+ }
+ keys %base_metaclass;
+
+ for my $superclass (@superclasses) {
+ $self->_check_class_metaclass_compatibility($superclass);
+ }
+
+ for my $metaclass_type ( keys %base_metaclass ) {
+ next unless defined $self->$metaclass_type;
for my $superclass (@superclasses) {
- $self->_check_class_metaclass_compatibility($superclass);
- }
-
- for my $metaclass_type (keys %base_metaclass) {
- next unless defined $self->$metaclass_type;
- for my $superclass (@superclasses) {
- $self->_check_single_metaclass_compatibility(
- $metaclass_type, $superclass
- );
- }
+ $self->_check_single_metaclass_compatibility( $metaclass_type,
+ $superclass );
}
}
}
@@ -760,10 +762,13 @@
sub superclasses {
my $self = shift;
- my $var_spec = { sigil => '@', type => 'ARRAY', name => 'ISA' };
+
+ my $isa = $self->get_package_symbol(
+ { sigil => '@', type => 'ARRAY', name => 'ISA' } );
+
if (@_) {
my @supers = @_;
- @{$self->get_package_symbol($var_spec)} = @supers;
+ @{$isa} = @supers;
# NOTE:
# on 5.8 and below, we need to call
@@ -782,7 +787,8 @@
$self->_check_metaclass_compatibility();
$self->_superclasses_updated();
}
- @{$self->get_package_symbol($var_spec)};
+
+ return @{$isa};
}
sub _superclasses_updated {
@@ -942,8 +948,7 @@
for my $class ( reverse $self->linearized_isa ) {
my $meta = Class::MOP::Class->initialize($class);
- $methods{$_} = $meta->get_method($_)
- for $meta->get_method_list;
+ $methods{ $_->name } = $_ for $meta->_get_local_methods;
}
return values %methods;
@@ -1706,7 +1711,8 @@
=item B<< $metaclass->get_attribute_list >>
This will return a list of attributes I<names> for all attributes
-defined in this class.
+defined in this class. Note that this operates on the current class
+only, it does not traverse the inheritance hierarchy.
=item B<< $metaclass->get_all_attributes >>
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Class/Immutable/Trait.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Class/Immutable/Trait.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Class/Immutable/Trait.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Class/Immutable/Trait.pm Mon Aug 23 21:48:02 2010
@@ -8,7 +8,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Deprecated.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Deprecated.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Deprecated.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Deprecated.pm Mon Aug 23 21:48:02 2010
@@ -3,7 +3,7 @@
use strict;
use warnings;
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Instance.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Instance.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Instance.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Instance.pm Mon Aug 23 21:48:02 2010
@@ -6,7 +6,7 @@
use Scalar::Util 'weaken', 'blessed';
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Method.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Method.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Method.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Method.pm Mon Aug 23 21:48:02 2010
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'weaken', 'reftype', 'blessed';
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -123,11 +123,19 @@
$self->body->(@_);
}
-# NOTE:
-# the Class::MOP bootstrap
-# will create this for us
-# - SL
-# sub clone { ... }
+# We used to go through use Class::MOP::Class->clone_instance to do this, but
+# this was awfully slow. This method may be called a number of times when
+# classes are loaded (especially during Moose role application), so it is
+# worth optimizing. - DR
+sub clone {
+ my $self = shift;
+
+ my $clone = bless { %{$self}, @_ }, blessed($self);
+
+ $clone->_set_original_method($self);
+
+ return $clone;
+}
1;
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Method/Accessor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Method/Accessor.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Method/Accessor.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Method/Accessor.pm Mon Aug 23 21:48:02 2010
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Method/Constructor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Method/Constructor.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Method/Constructor.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Method/Constructor.pm Mon Aug 23 21:48:02 2010
@@ -5,9 +5,9 @@
use warnings;
use Carp 'confess';
-use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
-
-our $VERSION = '1.04';
+use Scalar::Util 'blessed', 'weaken';
+
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -100,7 +100,11 @@
sub _generate_constructor_method_inline {
my $self = shift;
- my $close_over = {};
+ my $defaults = [map { $_->default } @{ $self->_attributes }];
+
+ my $close_over = {
+ '$defaults' => \$defaults,
+ };
my $source = 'sub {';
$source .= "\n" . 'my $class = shift;';
@@ -111,8 +115,9 @@
$source .= "\n" . 'my $params = @_ == 1 ? $_[0] : {@_};';
$source .= "\n" . 'my $instance = ' . $self->_meta_instance->inline_create_instance('$class');
+ my $idx = 0;
$source .= ";\n" . (join ";\n" => map {
- $self->_generate_slot_initializer($_, $close_over)
+ $self->_generate_slot_initializer($_, $idx++)
} @{ $self->_attributes });
$source .= ";\n" . 'return $instance';
$source .= ";\n" . '}';
@@ -130,54 +135,68 @@
sub _generate_slot_initializer {
my $self = shift;
my $attr = shift;
- my $close = shift;
+ my $idx = shift;
my $default;
if ($attr->has_default) {
- # NOTE:
- # default values can either be CODE refs
- # in which case we need to call them. Or
- # they can be scalars (strings/numbers)
- # in which case we can just deal with them
- # in the code we eval.
- if ($attr->is_default_a_coderef) {
- my $idx = @{$close->{'@defaults'}||=[]};
- push(@{$close->{'@defaults'}}, $attr->default);
- $default = '$defaults[' . $idx . ']->($instance)';
- }
- else {
- $default = $attr->default;
- # make sure to quote strings ...
- unless (looks_like_number($default)) {
- $default = "'$default'";
- }
- }
+ $default = $self->_generate_default_value($attr, $idx);
} elsif( $attr->has_builder ) {
$default = '$instance->'.$attr->builder;
}
- if ( defined(my $init_arg = $attr->init_arg) ) {
- return (
- 'if(exists $params->{\'' . $init_arg . '\'}){' . "\n" .
- $self->_meta_instance->inline_set_slot_value(
+ if ( defined( my $init_arg = $attr->init_arg ) ) {
+ my $mi = $self->_meta_instance;
+ my $attr_name = $attr->name;
+
+ return (
+ 'if(exists $params->{\''
+ . $init_arg . '\'}){' . "\n"
+ . $mi->inline_set_slot_value(
+ '$instance',
+ $attr_name,
+ '$params->{\'' . $init_arg . '\'}'
+ )
+ . "\n" . '} '
+ . (
+ !defined $default ? '' : 'else {' . "\n"
+ . $mi->inline_set_slot_value(
'$instance',
- $attr->name,
- '$params->{\'' . $init_arg . '\'}' ) . "\n" .
- '} ' . (!defined $default ? '' : 'else {' . "\n" .
- $self->_meta_instance->inline_set_slot_value(
- '$instance',
- $attr->name,
- $default ) . "\n" .
- '}')
+ $attr_name,
+ $default
+ )
+ . "\n" . '}'
+ )
);
- } elsif ( defined $default ) {
+ }
+ elsif ( defined $default ) {
return (
$self->_meta_instance->inline_set_slot_value(
'$instance',
$attr->name,
- $default ) . "\n"
+ $default
+ )
+ . "\n"
);
- } else { return '' }
+ }
+ else {
+ return '';
+ }
+}
+
+sub _generate_default_value {
+ my ($self, $attr, $index) = @_;
+ # NOTE:
+ # default values can either be CODE refs
+ # in which case we need to call them. Or
+ # they can be scalars (strings/numbers)
+ # in which case we can just deal with them
+ # in the code we eval.
+ if ($attr->is_default_a_coderef) {
+ return '$defaults->[' . $index . ']->($instance)';
+ }
+ else {
+ return '$defaults->[' . $index . ']';
+ }
}
1;
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Method/Generated.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Method/Generated.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Method/Generated.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Method/Generated.pm Mon Aug 23 21:48:02 2010
@@ -6,7 +6,7 @@
use Carp 'confess';
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Method/Inlined.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Method/Inlined.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Method/Inlined.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Method/Inlined.pm Mon Aug 23 21:48:02 2010
@@ -6,7 +6,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Method/Wrapped.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Method/Wrapped.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Method/Wrapped.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Method/Wrapped.pm Mon Aug 23 21:48:02 2010
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Mixin.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Mixin.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Mixin.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Mixin.pm Mon Aug 23 21:48:02 2010
@@ -3,7 +3,7 @@
use strict;
use warnings;
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Mixin/AttributeCore.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Mixin/AttributeCore.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Mixin/AttributeCore.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Mixin/AttributeCore.pm Mon Aug 23 21:48:02 2010
@@ -3,7 +3,7 @@
use strict;
use warnings;
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -18,7 +18,7 @@
sub has_clearer { defined $_[0]->{'clearer'} }
sub has_builder { defined $_[0]->{'builder'} }
sub has_init_arg { defined $_[0]->{'init_arg'} }
-sub has_default { defined $_[0]->{'default'} }
+sub has_default { exists $_[0]->{'default'} }
sub has_initializer { defined $_[0]->{'initializer'} }
sub has_insertion_order { defined $_[0]->{'insertion_order'} }
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Mixin/HasAttributes.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Mixin/HasAttributes.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Mixin/HasAttributes.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Mixin/HasAttributes.pm Mon Aug 23 21:48:02 2010
@@ -3,7 +3,7 @@
use strict;
use warnings;
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Mixin/HasMethods.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Mixin/HasMethods.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Mixin/HasMethods.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Mixin/HasMethods.pm Mon Aug 23 21:48:02 2010
@@ -3,7 +3,7 @@
use strict;
use warnings;
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -39,12 +39,14 @@
( defined $method_name && length $method_name )
|| confess "You must define a method name";
+ my $package_name = $self->name;
+
my $body;
if ( blessed($method) ) {
$body = $method->body;
- if ( $method->package_name ne $self->name ) {
+ if ( $method->package_name ne $package_name ) {
$method = $method->clone(
- package_name => $self->name,
+ package_name => $package_name,
name => $method_name,
) if $method->can('clone');
}
@@ -62,7 +64,7 @@
my ( $current_package, $current_name ) = Class::MOP::get_code_info($body);
if ( !defined $current_name || $current_name =~ /^__ANON__/ ) {
- my $full_method_name = ( $self->name . '::' . $method_name );
+ my $full_method_name = ( $package_name . '::' . $method_name );
subname( $full_method_name => $body );
}
@@ -87,7 +89,7 @@
( defined $method_name && length $method_name )
|| confess "You must define a method name";
- return defined( $self->get_method($method_name) );
+ return defined( $self->_get_maybe_raw_method($method_name) );
}
sub get_method {
@@ -95,6 +97,21 @@
( defined $method_name && length $method_name )
|| confess "You must define a method name";
+
+ my $method = $self->_get_maybe_raw_method($method_name)
+ or return;
+
+ return $method if blessed $method;
+
+ return $self->_method_map->{$method_name} = $self->wrap_method_body(
+ body => $method,
+ name => $method_name,
+ associated_metaclass => $self,
+ );
+}
+
+sub _get_maybe_raw_method {
+ my ( $self, $method_name ) = @_;
my $method_map = $self->_method_map;
my $map_entry = $method_map->{$method_name};
@@ -106,25 +123,18 @@
}
);
- # This seems to happen in some weird cases where methods modifiers are
- # added via roles or some other such bizareness. Honestly, I don't totally
- # understand this, but returning the entry works, and keeps various MX
- # modules from blowing up. - DR
- return $map_entry if blessed $map_entry && !$code;
-
- return $map_entry if blessed $map_entry && $map_entry->body == $code;
+ # The !$code case seems to happen in some weird cases where methods
+ # modifiers are added via roles or some other such bizareness. Honestly, I
+ # don't totally understand this, but returning the entry works, and keeps
+ # various MX modules from blowing up. - DR
+ return $map_entry
+ if blessed $map_entry && ( !$code || $map_entry->body == $code );
unless ($map_entry) {
return unless $code && $self->_code_is_mine($code);
}
- $code ||= $map_entry;
-
- return $method_map->{$method_name} = $self->wrap_method_body(
- body => $code,
- name => $method_name,
- associated_metaclass => $self,
- );
+ return $code;
}
sub remove_method {
@@ -148,7 +158,29 @@
sub get_method_list {
my $self = shift;
- return grep { $self->has_method($_) } keys %{ $self->namespace };
+
+ my $namespace = $self->namespace;
+
+ # Constants will show up as some sort of reference in the namespace hash
+ # ref.
+ return grep {
+ ( ref $namespace->{$_} || *{ $namespace->{$_} }{CODE} )
+ && $self->has_method($_)
+ }
+ keys %{$namespace};
+}
+
+# This should probably be what get_method_list actually does, instead of just
+# returning names. This was created as a much faster alternative to
+# $meta->get_method($_) for $meta->get_method_list
+sub _get_local_methods {
+ my $self = shift;
+
+ my $namespace = $self->namespace;
+
+ return map { $self->get_method($_) }
+ grep { ref $namespace->{$_} || *{ $namespace->{$_} }{CODE} }
+ keys %{$namespace};
}
1;
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Module.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Module.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Module.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Module.pm Mon Aug 23 21:48:02 2010
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Object.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Object.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Object.pm Mon Aug 23 21:48:02 2010
@@ -6,7 +6,7 @@
use Scalar::Util 'blessed';
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/Class/MOP/Package.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/Class/MOP/Package.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/Class/MOP/Package.pm (original)
+++ trunk/libclass-mop-perl/lib/Class/MOP/Package.pm Mon Aug 23 21:48:02 2010
@@ -8,7 +8,7 @@
use Carp 'confess';
use Package::Stash;
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/lib/metaclass.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/lib/metaclass.pm?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/lib/metaclass.pm (original)
+++ trunk/libclass-mop-perl/lib/metaclass.pm Mon Aug 23 21:48:02 2010
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '1.04';
+our $VERSION = '1.06';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: trunk/libclass-mop-perl/t/003_methods.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/t/003_methods.t?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/t/003_methods.t (original)
+++ trunk/libclass-mop-perl/t/003_methods.t Mon Aug 23 21:48:02 2010
@@ -352,4 +352,31 @@
}
}
+{
+ package HasConstants;
+
+ use constant FOO => 1;
+ use constant BAR => [];
+ use constant BAZ => {};
+ use constant UNDEF => undef;
+
+ sub quux {1}
+ sub thing {1}
+}
+
+my $HC = Class::MOP::Class->initialize('HasConstants');
+
+is_deeply(
+ [ sort $HC->get_method_list ],
+ [qw( BAR BAZ FOO UNDEF quux thing )],
+ 'get_method_list handles constants properly'
+);
+
+is_deeply(
+ [ sort map { $_->name } $HC->_get_local_methods ],
+ [qw( BAR BAZ FOO UNDEF quux thing )],
+ '_get_local_methods handles constants properly'
+);
+
+
done_testing;
Modified: trunk/libclass-mop-perl/t/021_attribute_errors_and_edge_cases.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libclass-mop-perl/t/021_attribute_errors_and_edge_cases.t?rev=61946&op=diff
==============================================================================
--- trunk/libclass-mop-perl/t/021_attribute_errors_and_edge_cases.t (original)
+++ trunk/libclass-mop-perl/t/021_attribute_errors_and_edge_cases.t Mon Aug 23 21:48:02 2010
@@ -80,6 +80,34 @@
builder => 'Foo', default => 'Foo'
));
} '... no default AND builder';
+
+ my $undef_attr;
+ lives_ok {
+ $undef_attr = Class::MOP::Attribute->new('$test' => (
+ default => undef,
+ predicate => 'has_test',
+ ));
+ } '... undef as a default is okay';
+ ok($undef_attr->has_default, '... and it counts as an actual default');
+ ok(!Class::MOP::Attribute->new('$test')->has_default,
+ '... but attributes with no default have no default');
+
+ Class::MOP::Class->create(
+ 'Foo',
+ attributes => [$undef_attr],
+ );
+ {
+ my $obj = Foo->meta->new_object;
+ ok($obj->has_test, '... and the default is populated');
+ is($obj->meta->get_attribute('$test')->get_value($obj), undef, '... with the right value');
+ }
+ lives_ok { Foo->meta->make_immutable }
+ '... and it can be inlined';
+ {
+ my $obj = Foo->new;
+ ok($obj->has_test, '... and the default is populated');
+ is($obj->meta->get_attribute('$test')->get_value($obj), undef, '... with the right value');
+ }
}
More information about the Pkg-perl-cvs-commits
mailing list