r38419 - in /branches/upstream/libclass-mop-perl/current: ./ lib/ lib/Class/ lib/Class/MOP/ lib/Class/MOP/Class/Immutable/ lib/Class/MOP/Class/Immutable/Class/MOP/ lib/Class/MOP/Method/ t/ xt/author/
carnil-guest at users.alioth.debian.org
carnil-guest at users.alioth.debian.org
Mon Jun 22 05:28:09 UTC 2009
Author: carnil-guest
Date: Mon Jun 22 05:27:46 2009
New Revision: 38419
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38419
Log:
[svn-upgrade] Integrating new upstream version, libclass-mop-perl (0.87)
Added:
branches/upstream/libclass-mop-perl/current/t/310_inline_structor.t
branches/upstream/libclass-mop-perl/current/t/311_inline_and_dollar_at.t
Removed:
branches/upstream/libclass-mop-perl/current/t/310_immutable_destroy.t
Modified:
branches/upstream/libclass-mop-perl/current/Changes
branches/upstream/libclass-mop-perl/current/MANIFEST
branches/upstream/libclass-mop-perl/current/META.yml
branches/upstream/libclass-mop-perl/current/Makefile.PL
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/Attribute.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class/Immutable/Class/MOP/Class.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class/Immutable/Trait.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Instance.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/Method/Inlined.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Wrapped.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Module.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Object.pm
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm
branches/upstream/libclass-mop-perl/current/lib/metaclass.pm
branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t
branches/upstream/libclass-mop-perl/current/xt/author/pod_spell.t
Modified: branches/upstream/libclass-mop-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/Changes?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/Changes (original)
+++ branches/upstream/libclass-mop-perl/current/Changes Mon Jun 22 05:27:46 2009
@@ -1,14 +1,30 @@
Revision history for Perl extension Class-MOP.
+
+0.87 Sun, Jun 21, 2009
+ * Various
+ - Made sure to always local-ize $@ and $SIG{__DIE__} before
+ calling an eval. Fixes RT #45973.
+
+ * Class::MOP::Class
+ - Synced docs about immutability with the current reality (which
+ changed back in 0.82_01)
+ - Removed the immutable_transformer method, which had been
+ returning undef since 0.82_01 anyway.
+
+ * Tests
+ - Got rid of tests which needed Moose and improved testing of
+ constructor/destructor inlining warnings. Fixes RT #47119.
0.86 Tue, Jun 16, 2009
* Class::MOP::Class
- If you redefined a subroutine at runtime and then wrapped it
with a method modifier, the modifier could in some cases wrap
- the original version of the subroutine
+ the original version of the subroutine. Fixes RT #46957.
* Class::MOP::Class
- make_immutable issues a warning instead of overriding an
- existing DESTROY method (Dylan William Hardison)
+ existing DESTROY method (Dylan William Hardison). Fixes RT
+ #46854.
0.85 Sat, Jun 6, 2009
* Class::MOP::Attribute
Modified: branches/upstream/libclass-mop-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/MANIFEST?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/MANIFEST (original)
+++ branches/upstream/libclass-mop-perl/current/MANIFEST Mon Jun 22 05:27:46 2009
@@ -110,7 +110,8 @@
t/307_null_stash.t
t/308_insertion_order.t
t/309_subname.t
-t/310_immutable_destroy.t
+t/310_inline_structor.t
+t/311_inline_and_dollar_at.t
t/lib/BinaryTree.pm
t/lib/MyMetaClass.pm
t/lib/MyMetaClass/Attribute.pm
Modified: branches/upstream/libclass-mop-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/META.yml?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/META.yml (original)
+++ branches/upstream/libclass-mop-perl/current/META.yml Mon Jun 22 05:27:46 2009
@@ -32,4 +32,4 @@
perl: 5.8.1
resources:
license: http://dev.perl.org/licenses/
-version: 0.86
+version: 0.87
Modified: branches/upstream/libclass-mop-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/Makefile.PL?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/Makefile.PL (original)
+++ branches/upstream/libclass-mop-perl/current/Makefile.PL Mon Jun 22 05:27:46 2009
@@ -65,7 +65,7 @@
# before a release.
sub check_conflicts {
my %conflicts = (
- 'Moose' => '0.72',
+ 'Moose' => '0.81',
);
my $found = 0;
Modified: branches/upstream/libclass-mop-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/README?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/README (original)
+++ branches/upstream/libclass-mop-perl/current/README Mon Jun 22 05:27:46 2009
@@ -1,4 +1,4 @@
-Class::MOP version 0.86
+Class::MOP version 0.87
===========================
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/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm Mon Jun 22 05:27:46 2009
@@ -29,7 +29,7 @@
*check_package_cache_flag = \&mro::get_pkg_gen;
}
-our $VERSION = '0.86';
+our $VERSION = '0.87';
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Attribute.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Attribute.pm?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Attribute.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Attribute.pm Mon Jun 22 05:27:46 2009
@@ -9,7 +9,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class.pm?rev=38419&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 Mon Jun 22 05:27:46 2009
@@ -15,7 +15,7 @@
use Sub::Name 'subname';
use Devel::GlobalDestruction 'in_global_destruction';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -623,7 +623,7 @@
my ( $current_package, $current_name ) = Class::MOP::get_code_info($body);
- if ( $current_name eq '__ANON__' ) {
+ if ( !defined $current_name || $current_name eq '__ANON__' ) {
my $full_method_name = ($self->name . '::' . $method_name);
subname($full_method_name => $body);
}
@@ -855,7 +855,12 @@
$self->get_attribute_map->{$attribute->name} = $attribute;
# invalidate package flag here
- my $e = do { local $@; eval { $attribute->install_accessors() }; $@ };
+ my $e = do {
+ local $@;
+ local $SIG{__DIE__};
+ eval { $attribute->install_accessors() };
+ $@;
+ };
if ( $e ) {
$self->remove_attribute($attribute->name);
die $e;
@@ -1008,7 +1013,6 @@
sub is_mutable { 1 }
sub is_immutable { 0 }
-sub immutable_transformer { return }
sub _immutable_options {
my ( $self, @args ) = @_;
@@ -1077,15 +1081,13 @@
my $class_name;
if ( $meta_attr and $trait eq $meta_attr->default ) {
-
- # if the trait is the same as the default we try and pick a predictable
- # name for the immutable metaclass
- $class_name = "Class::MOP::Class::Immutable::" . ref($self);
+ # if the trait is the same as the default we try and pick a
+ # predictable name for the immutable metaclass
+ $class_name = 'Class::MOP::Class::Immutable::' . ref($self);
}
else {
- $class_name
- = join( "::", "Class::MOP::Class::Immutable::CustomTrait", $trait,
- "ForMetaClass", ref($self) );
+ $class_name = join '::', 'Class::MOP::Class::Immutable::CustomTrait',
+ $trait, 'ForMetaClass', ref($self);
}
if ( Class::MOP::is_class_loaded($class_name) ) {
@@ -1193,11 +1195,11 @@
sub _inline_destructor {
my ( $self, %args ) = @_;
- ( exists $args{destructor_class} )
+ ( exists $args{destructor_class} && defined $args{destructor_class} )
|| confess "The 'inline_destructor' option is present, but "
. "no destructor class was specified";
- if ( $self->has_method('DESTROY') ) {
+ if ( $self->has_method('DESTROY') && ! $args{replace_destructor} ) {
my $class = $self->name;
warn "Not inlining a destructor for $class since it defines"
. " its own destructor.\n";
@@ -1217,9 +1219,10 @@
name => 'DESTROY'
);
- $self->add_method( 'DESTROY' => $destructor );
-
- $self->_add_inlined_method($destructor);
+ if ( $args{replace_destructor} or $destructor->can_be_inlined ) {
+ $self->add_method( 'DESTROY' => $destructor );
+ $self->_add_inlined_method($destructor);
+ }
}
1;
@@ -1613,10 +1616,10 @@
This will return a L<Class::MOP::Attribute> for the specified
C<$attribute_name>. If the class does not have the specified
-attribute, it returns C<undef>.
-
-NOTE that get_attribute does not search superclasses, for
-that you need to use C<find_attribute_by_name>.
+attribute, it returns C<undef>.
+
+NOTE that get_attribute does not search superclasses, for that you
+need to use C<find_attribute_by_name>.
=item B<< $metaclass->has_attribute($attribute_name) >>
@@ -1691,6 +1694,12 @@
methods, and also allows us to optimize some methods on the metaclass
object itself.
+After immutabilization, the metaclass object will cache most
+informational methods such as C<get_method_map> and
+C<get_all_attributes>. Methods which would alter the class, such as
+C<add_attribute>, C<add_method>, and so on will throw an error on an
+immutable metaclass object.
+
The immutabilization system in L<Moose> takes much greater advantage
of the inlining features than Class::MOP itself does.
@@ -1701,20 +1710,62 @@
This method will create an immutable transformer and uses it to make
the class and its metaclass object immutable.
-Details of how immutabilization works are in L<Class::MOP::Immutable>
-documentation.
+This method accepts the following options:
+
+=over 8
+
+=item * inline_accessors
+
+=item * inline_constructor
+
+=item * inline_destructor
+
+These are all booleans indicating whether the specified method(s)
+should be inlined.
+
+By default, accessors and the constructor are inlined, but not the
+destructor.
+
+=item * immutable_trait
+
+The name of a class which will be used as a parent class for the
+metaclass object being made immutable. This "trait" implements the
+post-immutability functionality of the metaclass (but not the
+transformation itself).
+
+This defaults to L<Class::MOP::Class::Immutable::Trait>.
+
+=item * constructor_name
+
+This is the constructor method name. This defaults to "new".
+
+=item * constructor_class
+
+The name of the method metaclass for constructors. It will be used to
+generate the inlined constructor. This defaults to
+"Class::MOP::Method::Constructor".
+
+=item * replace_constructor
+
+This is a boolean indicating whether an existing constructor should be
+replaced when inlining a constructor. This defaults to false.
+
+=item * destructor_class
+
+The name of the method metaclass for destructors. It will be used to
+generate the inlined destructor. This defaults to
+"Class::MOP::Method::Denstructor".
+
+=item * replace_destructor
+
+This is a boolean indicating whether an existing destructor should be
+replaced when inlining a destructor. This defaults to false.
+
+=back
=item B<< $metaclass->make_mutable >>
Calling this method reverse the immutabilization transformation.
-
-=item B<< $metaclass->immutable_transformer >>
-
-If the class has been made immutable previously, this returns the
-L<Class::MOP::Immutable> object that was created to do the
-transformation.
-
-If the class was never made immutable, this method will die.
=back
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class/Immutable/Class/MOP/Class.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class/Immutable/Class/MOP/Class.pm?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class/Immutable/Class/MOP/Class.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class/Immutable/Class/MOP/Class.pm Mon Jun 22 05:27:46 2009
@@ -3,7 +3,7 @@
use strict;
use warnings;
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class/Immutable/Trait.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class/Immutable/Trait.pm?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class/Immutable/Trait.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class/Immutable/Trait.pm Mon Jun 22 05:27:46 2009
@@ -8,7 +8,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -107,8 +107,10 @@
=head1 DESCRIPTION
-This class provides a trait that is applied to immutable metaclass
-objects. This is deep guts.
+This class provides a pseudo-trait that is applied to immutable metaclass
+objects. In reality, it is simply a parent class.
+
+It implements caching and read-only-ness for various metaclass methods.
=head1 AUTHOR
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Instance.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Instance.pm?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Instance.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Instance.pm Mon Jun 22 05:27:46 2009
@@ -6,7 +6,7 @@
use Scalar::Util 'weaken', 'blessed';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method.pm?rev=38419&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 Mon Jun 22 05:27:46 2009
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'weaken';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Accessor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Accessor.pm?rev=38419&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 Mon Jun 22 05:27:46 2009
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -73,8 +73,7 @@
($self->is_inline ? 'inline' : ())
);
- eval { $self->{'body'} = $self->$method_name() };
- die $@ if $@;
+ $self->{'body'} = $self->$method_name();
}
## generators
@@ -160,7 +159,7 @@
my $attr_name = $attr->name;
my $meta_instance = $attr->associated_class->instance_metaclass;
- my $code = $self->_eval_closure(
+ my ( $code, $e ) = $self->_eval_closure(
{},
'sub {'
. $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
@@ -168,7 +167,7 @@
. $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
. '}'
);
- confess "Could not generate inline accessor because : $@" if $@;
+ confess "Could not generate inline accessor because : $e" if $e;
return $code;
}
@@ -185,14 +184,14 @@
my $attr_name = $attr->name;
my $meta_instance = $attr->associated_class->instance_metaclass;
- my $code = $self->_eval_closure(
+ my ( $code, $e ) = $self->_eval_closure(
{},
'sub {'
. 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
. $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
. '}'
);
- confess "Could not generate inline reader because : $@" if $@;
+ confess "Could not generate inline reader because : $e" if $e;
return $code;
}
@@ -209,13 +208,13 @@
my $attr_name = $attr->name;
my $meta_instance = $attr->associated_class->instance_metaclass;
- my $code = $self->_eval_closure(
+ my ( $code, $e ) = $self->_eval_closure(
{},
'sub {'
. $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
. '}'
);
- confess "Could not generate inline writer because : $@" if $@;
+ confess "Could not generate inline writer because : $e" if $e;
return $code;
}
@@ -232,13 +231,13 @@
my $attr_name = $attr->name;
my $meta_instance = $attr->associated_class->instance_metaclass;
- my $code = $self->_eval_closure(
+ my ( $code, $e ) = $self->_eval_closure(
{},
'sub {'
. $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name)
. '}'
);
- confess "Could not generate inline predicate because : $@" if $@;
+ confess "Could not generate inline predicate because : $e" if $e;
return $code;
}
@@ -255,13 +254,13 @@
my $attr_name = $attr->name;
my $meta_instance = $attr->associated_class->instance_metaclass;
- my $code = $self->_eval_closure(
+ my ( $code, $e ) = $self->_eval_closure(
{},
'sub {'
. $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name)
. '}'
);
- confess "Could not generate inline clearer because : $@" if $@;
+ confess "Could not generate inline clearer because : $e" if $e;
return $code;
}
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Constructor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Constructor.pm?rev=38419&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 Mon Jun 22 05:27:46 2009
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -136,11 +136,11 @@
$source .= ";\n" . '}';
warn $source if $self->options->{debug};
- my $code = $self->_eval_closure(
+ my ( $code, $e ) = $self->_eval_closure(
$close_over,
$source
);
- confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$@" if $@;
+ confess "Could not eval the constructor :\n\n$source\n\nbecause :\n\n$e" if $e;
return $code;
}
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Generated.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Generated.pm?rev=38419&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 Mon Jun 22 05:27:46 2009
@@ -6,7 +6,7 @@
use Carp 'confess';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -29,22 +29,29 @@
sub _eval_closure {
# my ($self, $captures, $sub_body) = @_;
my $__captures = $_[1];
- eval join(
- "\n",
- (
+
+ my $code;
+
+ my $e = do {
+ local $@;
+ local $SIG{__DIE__};
+ $code = eval join
+ "\n", (
map {
/^([\@\%\$])/
or die "capture key should start with \@, \% or \$: $_";
- q[my ]
- . $_ . q[ = ]
- . $1
- . q[{$__captures->{']
- . $_
- . q['}};];
- } keys %$__captures
- ),
- $_[2]
- );
+ q[my ]
+ . $_ . q[ = ]
+ . $1
+ . q[{$__captures->{']
+ . $_ . q['}};];
+ } keys %$__captures
+ ),
+ $_[2];
+ $@;
+ };
+
+ return ( $code, $e );
}
sub _add_line_directive {
@@ -77,7 +84,7 @@
my $code = $self->_add_line_directive(%args);
- $self->_eval_closure($args{environment}, $code);
+ return $self->_eval_closure($args{environment}, $code);
}
1;
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Inlined.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Inlined.pm?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Inlined.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Inlined.pm Mon Jun 22 05:27:46 2009
@@ -6,7 +6,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -34,6 +34,22 @@
my $metaclass = $self->associated_metaclass;
my $class = $metaclass->name;
+ # If we don't find an inherited method, this is a rather weird
+ # case where we have no method in the inheritance chain even
+ # though we're expecting one to be there
+ my $inherited_method
+ = $metaclass->find_next_method_by_name( $self->name );
+
+ if ( $inherited_method
+ && $inherited_method->isa('Class::MOP::Method::Wrapped') ) {
+ warn "Not inlining '"
+ . $self->name
+ . "' for $class since it "
+ . "has method modifiers which would be lost if it were inlined\n";
+
+ return 0;
+ }
+
my $expected_class = $self->_expected_method_class
or return 1;
@@ -57,15 +73,6 @@
# the method is what we wanted (probably Moose::Object::new)
return 1
if refaddr($expected_method) == refaddr($actual_method);
-
- # If we don't find an inherited method, this is a rather weird
- # case where we have no method in the inheritance chain even
- # though we're expecting one to be there
- #
- # this returns 1 for backwards compatibility for now
- my $inherited_method
- = $metaclass->find_next_method_by_name( $self->name )
- or return 1;
# otherwise we have to check that the actual method is an inlined
# version of what we're expecting
@@ -95,12 +102,6 @@
. " constructor, specify inline_constructor => 0 in your"
. " call to $class->meta->make_immutable\n";
}
-
- $warning
- .= " ('"
- . $self->name
- . "' has method modifiers which would be lost if it were inlined)\n"
- if $inherited_method->isa('Class::MOP::Method::Wrapped');
warn $warning;
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Wrapped.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Wrapped.pm?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Wrapped.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Method/Wrapped.pm Mon Jun 22 05:27:46 2009
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Module.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Module.pm?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Module.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Module.pm Mon Jun 22 05:27:46 2009
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -50,8 +50,13 @@
$code .= "\$$package_name\:\:AUTHORITY = '" . $authority . "';"
if defined $authority;
- eval $code;
- confess "creation of $package_name failed : $@" if $@;
+ my $e = do {
+ local $@;
+ local $SIG{__DIE__};
+ eval $code;
+ $@;
+ };
+ confess "creation of $package_name failed : $e" if $e;
}
1;
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Object.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Object.pm?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Object.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Object.pm Mon Jun 22 05:27:46 2009
@@ -6,7 +6,7 @@
use Scalar::Util 'blessed';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Package.pm?rev=38419&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 Mon Jun 22 05:27:46 2009
@@ -8,7 +8,7 @@
use Scalar::Util 'blessed';
use Carp 'confess';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: branches/upstream/libclass-mop-perl/current/lib/metaclass.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/lib/metaclass.pm?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/metaclass.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/metaclass.pm Mon Jun 22 05:27:46 2009
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.86';
+our $VERSION = '0.87';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/t/010_self_introspection.t?rev=38419&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 Mon Jun 22 05:27:46 2009
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 298;
+use Test::More tests => 296;
use Test::Exception;
use Class::MOP;
@@ -92,8 +92,6 @@
_immutable_metaclass
immutable_trait constructor_name constructor_class destructor_class
-
- immutable_transformer
DESTROY
);
Added: branches/upstream/libclass-mop-perl/current/t/310_inline_structor.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/t/310_inline_structor.t?rev=38419&op=file
==============================================================================
--- branches/upstream/libclass-mop-perl/current/t/310_inline_structor.t (added)
+++ branches/upstream/libclass-mop-perl/current/t/310_inline_structor.t Mon Jun 22 05:27:46 2009
@@ -1,0 +1,295 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ eval "use Test::Output;";
+ plan skip_all => "Test::Output is required for this test" if $@;
+ plan 'no_plan';
+}
+
+use Class::MOP;
+
+{
+ package HasConstructor;
+
+ sub new { bless {}, $_[0] }
+
+ my $meta = Class::MOP::Class->initialize(__PACKAGE__);
+
+ $meta->superclasses('NotMoose');
+
+ ::stderr_like(
+ sub { $meta->make_immutable },
+ qr/\QNot inlining a constructor for HasConstructor since it defines its own constructor.\E\s+\QIf you are certain you don't need to inline your constructor, specify inline_constructor => 0 in your call to HasConstructor->meta->make_immutable\E/,
+ 'got a warning that Foo will not have an inlined constructor because it defines its own new method'
+ );
+
+ ::is(
+ $meta->find_method_by_name('new')->body,
+ HasConstructor->can('new'),
+ 'HasConstructor->new was untouched'
+ );
+}
+
+{
+ package My::Constructor;
+
+ use base 'Class::MOP::Method::Constructor';
+
+ sub _expected_method_class { 'Base::Class' }
+}
+
+{
+ package No::Constructor;
+}
+
+{
+ package My::Constructor2;
+
+ use base 'Class::MOP::Method::Constructor';
+
+ sub _expected_method_class { 'No::Constructor' }
+}
+
+{
+ package Base::Class;
+
+ sub new { bless {}, $_[0] }
+ sub DESTROY { }
+}
+
+{
+ package NotMoose;
+
+ sub new {
+ my $class = shift;
+
+ return bless { not_moose => 1 }, $class;
+ }
+}
+
+{
+ package Foo;
+ my $meta = Class::MOP::Class->initialize(__PACKAGE__);
+
+ $meta->superclasses('NotMoose');
+
+ ::stderr_like(
+ sub { $meta->make_immutable( constructor_class => 'My::Constructor' ) },
+ qr/\QNot inlining 'new' for Foo since it is not inheriting the default Base::Class::new\E\s+\QIf you are certain you don't need to inline your constructor, specify inline_constructor => 0 in your call to Foo->meta->make_immutable/,
+ 'got a warning that Foo will not have an inlined constructor'
+ );
+
+ ::is(
+ $meta->find_method_by_name('new')->body,
+ NotMoose->can('new'),
+ 'Foo->new is inherited from NotMoose'
+ );
+}
+
+{
+ package Bar;
+ my $meta = Class::MOP::Class->initialize(__PACKAGE__);
+
+ $meta->superclasses('NotMoose');
+
+ ::stderr_is(
+ sub { $meta->make_immutable( replace_constructor => 1 ) },
+ q{},
+ 'no warning when replace_constructor is true'
+ );
+
+ ::is(
+ $meta->find_method_by_name('new')->package_name,
+ 'Bar',
+ 'Bar->new is inlined, and not inherited from NotMoose'
+ );
+}
+
+{
+ package Baz;
+ Class::MOP::Class->initialize(__PACKAGE__)->make_immutable;
+}
+
+{
+ package Quux;
+ my $meta = Class::MOP::Class->initialize(__PACKAGE__);
+
+ $meta->superclasses('Baz');
+
+ ::stderr_is(
+ sub { $meta->make_immutable },
+ q{},
+ 'no warning when inheriting from a class that has already made itself immutable'
+ );
+}
+
+{
+ package Whatever;
+ my $meta = Class::MOP::Class->initialize(__PACKAGE__);
+
+ ::stderr_like(
+ sub { $meta->make_immutable( constructor_class => 'My::Constructor2' ) },
+ qr/\QNot inlining 'new' for Whatever since No::Constructor::new is not defined/,
+ 'got a warning that Whatever will not have an inlined constructor because its expected inherited method does not exist'
+ );
+}
+
+{
+ package My::Constructor3;
+
+ use base 'Class::MOP::Method::Constructor';
+}
+
+{
+ package CustomCons;
+
+ Class::MOP::Class->initialize(__PACKAGE__)->make_immutable( constructor_class => 'My::Constructor3' );
+}
+
+{
+ package Subclass;
+ my $meta = Class::MOP::Class->initialize(__PACKAGE__);
+
+ $meta->superclasses('CustomCons');
+
+ ::stderr_is(
+ sub { $meta->make_immutable },
+ q{},
+ 'no warning when inheriting from a class that has already made itself immutable'
+ );
+}
+
+{
+ package ModdedNew;
+ my $meta = Class::MOP::Class->initialize(__PACKAGE__);
+
+ sub new { bless {}, shift }
+
+ $meta->add_before_method_modifier( 'new' => sub { } );
+}
+
+{
+ package ModdedSub;
+ my $meta = Class::MOP::Class->initialize(__PACKAGE__);
+
+ $meta->superclasses('ModdedNew');
+
+ ::stderr_like(
+ sub { $meta->make_immutable },
+ qr/\QNot inlining 'new' for ModdedSub since it has method modifiers which would be lost if it were inlined/,
+ 'got a warning that ModdedSub will not have an inlined constructor since it inherited a wrapped new'
+ );
+}
+
+{
+ package My::Destructor;
+
+ use base 'Class::MOP::Method::Inlined';
+
+ sub new {
+ my $class = shift;
+ my %options = @_;
+
+ my $self = bless \%options, $class;
+ $self->_inline_destructor;
+
+ return $self;
+ }
+
+ sub _inline_destructor {
+ my $self = shift;
+
+ my ( $code, $e ) = $self->_eval_closure( {}, 'sub { }' );
+ die $e if $e;
+
+ $self->{body} = $code;
+ }
+
+ sub is_needed { 1 }
+ sub associated_metaclass { $_[0]->{metaclass} }
+ sub body { $_[0]->{body} }
+ sub _expected_method_class { 'Base::Class' }
+}
+
+{
+ package HasDestructor;
+ my $meta = Class::MOP::Class->initialize(__PACKAGE__);
+
+ sub DESTROY { }
+
+ ::stderr_like(
+ sub {
+ $meta->make_immutable(
+ inline_destructor => 1,
+ destructor_class => 'My::Destructor',
+ );
+ },
+ qr/Not inlining a destructor for HasDestructor since it defines its own destructor./,
+ 'got a warning when trying to inline a destructor for a class that already defines DESTROY'
+ );
+
+ ::is(
+ $meta->find_method_by_name('DESTROY')->body,
+ HasDestructor->can('DESTROY'),
+ 'HasDestructor->DESTROY was untouched'
+ );
+}
+
+{
+ package HasDestructor2;
+ my $meta = Class::MOP::Class->initialize(__PACKAGE__);
+
+ sub DESTROY { }
+
+ $meta->make_immutable(
+ inline_destructor => 1,
+ destructor_class => 'My::Destructor',
+ replace_destructor => 1
+ );
+
+ ::stderr_is(
+ sub {
+ $meta->make_immutable(
+ inline_destructor => 1,
+ destructor_class => 'My::Destructor',
+ replace_destructor => 1
+ );
+ },
+ q{},
+ 'no warning when replace_destructor is true'
+ );
+
+ ::isnt(
+ $meta->find_method_by_name('new')->body,
+ HasConstructor2->can('new'),
+ 'HasConstructor2->new was replaced'
+ );
+}
+
+{
+ package ParentHasDestructor;
+
+ sub DESTROY { }
+}
+
+{
+ package DestructorChild;
+
+ use base 'ParentHasDestructor';
+
+ my $meta = Class::MOP::Class->initialize(__PACKAGE__);
+
+ ::stderr_like(
+ sub {
+ $meta->make_immutable(
+ inline_destructor => 1,
+ destructor_class => 'My::Destructor',
+ );
+ },
+ qr/Not inlining 'DESTROY' for DestructorChild since it is not inheriting the default Base::Class::DESTROY/,
+ 'got a warning when trying to inline a destructor in a class that inherits an unexpected DESTROY'
+ );
+}
Added: branches/upstream/libclass-mop-perl/current/t/311_inline_and_dollar_at.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/t/311_inline_and_dollar_at.t?rev=38419&op=file
==============================================================================
--- branches/upstream/libclass-mop-perl/current/t/311_inline_and_dollar_at.t (added)
+++ branches/upstream/libclass-mop-perl/current/t/311_inline_and_dollar_at.t Mon Jun 22 05:27:46 2009
@@ -1,0 +1,21 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+plan tests => 1;
+
+use Class::MOP;
+
+
+{
+ package Foo;
+
+ my $meta = Class::MOP::Class->initialize(__PACKAGE__);
+
+ $@ = 'dollar at';
+
+ $meta->make_immutable;
+
+ ::is( $@, 'dollar at', '$@ is untouched after immutablization' );
+}
Modified: branches/upstream/libclass-mop-perl/current/xt/author/pod_spell.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/xt/author/pod_spell.t?rev=38419&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/xt/author/pod_spell.t (original)
+++ branches/upstream/libclass-mop-perl/current/xt/author/pod_spell.t Mon Jun 22 05:27:46 2009
@@ -166,6 +166,8 @@
pre
# vice versa
versa
+# foo-ness
+ness
## slang
C'mon
More information about the Pkg-perl-cvs-commits
mailing list