r39281 - in /branches/upstream/libclass-mop-perl/current: ./ lib/ lib/Class/ lib/Class/MOP/ lib/Class/MOP/Class/Immutable/ lib/Class/MOP/Class/Immutable/Class/ lib/Class/MOP/Method/ t/ xs/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Fri Jul 3 23:27:30 UTC 2009
Author: jawnsy-guest
Date: Fri Jul 3 23:27:25 2009
New Revision: 39281
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=39281
Log:
[svn-upgrade] Integrating new upstream version, libclass-mop-perl (0.89)
Added:
branches/upstream/libclass-mop-perl/current/t/074_immutable_custom_trait.t
Removed:
branches/upstream/libclass-mop-perl/current/lib/Class/MOP/Class/Immutable/Class/
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/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/030_method.t
branches/upstream/libclass-mop-perl/current/t/061_instance_inline.t
branches/upstream/libclass-mop-perl/current/t/070_immutable_metaclass.t
branches/upstream/libclass-mop-perl/current/xs/Class.xs
Modified: branches/upstream/libclass-mop-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/Changes?rev=39281&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/Changes (original)
+++ branches/upstream/libclass-mop-perl/current/Changes Fri Jul 3 23:27:25 2009
@@ -1,4 +1,20 @@
Revision history for Perl extension Class-MOP.
+
+0.89 Fri Jul 3, 2009
+ * Class::MOP::Class
+ * Class::MOP::Class::Immutable::Trait
+ - Made the Trait act like a role with a bunch of "around"
+ modifiers, rather than sticking it in the inheritance
+ hierarchy. This fixes various problems that caused with
+ metaclass compatibility, which broke Fey::ORM.
+
+ * Class::MOP::Method
+ - Allow a blessed code reference as the method body. Fixes a
+ problem interaction with MooseX::Types. (ash)
+
+ * Class::MOP::Instance
+ - add inline version of rebless_instance_structure. (doy)
+ - change inline_slot_access to use single quotes (gphat)
0.88 Tue, Jun 23, 2009
* Class::MOP::Class
@@ -74,6 +90,9 @@
* Class::MOP::Package
- Disable prototype mismatch warnings for add_package_symbol.
(Florian Ragwitz)
+ * Tests
+ - Add test for finding methods from $meta->name->meta before immutable,
+ (t0m)
0.83 Mon, April 27, 2009
* Class::MOP::Class
Modified: branches/upstream/libclass-mop-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/MANIFEST?rev=39281&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/MANIFEST (original)
+++ branches/upstream/libclass-mop-perl/current/MANIFEST Fri Jul 3 23:27:25 2009
@@ -19,7 +19,6 @@
lib/Class/MOP.pm
lib/Class/MOP/Attribute.pm
lib/Class/MOP/Class.pm
-lib/Class/MOP/Class/Immutable/Class/MOP/Class.pm
lib/Class/MOP/Class/Immutable/Trait.pm
lib/Class/MOP/Instance.pm
lib/Class/MOP/Method.pm
@@ -82,6 +81,7 @@
t/071_immutable_w_custom_metaclass.t
t/072_immutable_w_constructors.t
t/073_make_mutable.t
+t/074_immutable_custom_trait.t
t/080_meta_package.t
t/081_meta_package_extension.t
t/082_get_code_info.t
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=39281&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/META.yml (original)
+++ branches/upstream/libclass-mop-perl/current/META.yml Fri Jul 3 23:27:25 2009
@@ -32,4 +32,4 @@
perl: 5.8.1
resources:
license: http://dev.perl.org/licenses/
-version: 0.88
+version: 0.89
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=39281&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/Makefile.PL (original)
+++ branches/upstream/libclass-mop-perl/current/Makefile.PL Fri Jul 3 23:27:25 2009
@@ -65,7 +65,7 @@
# before a release.
sub check_conflicts {
my %conflicts = (
- 'Moose' => '0.82',
+ 'Moose' => '0.85',
);
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=39281&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/README (original)
+++ branches/upstream/libclass-mop-perl/current/README Fri Jul 3 23:27:25 2009
@@ -1,4 +1,4 @@
-Class::MOP version 0.88
+Class::MOP version 0.89
===========================
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=39281&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/Class/MOP.pm Fri Jul 3 23:27:25 2009
@@ -29,7 +29,7 @@
*check_package_cache_flag = \&mro::get_pkg_gen;
}
-our $VERSION = '0.88';
+our $VERSION = '0.89';
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -43,10 +43,9 @@
# there is no need to worry about destruction though
# because they should die only when the program dies.
# After all, do package definitions even get reaped?
+ # Anonymous classes manage their own destruction.
my %METAS;
- # means of accessing all the metaclasses that have
- # been initialized thus far (for mugwumps obj browser)
sub get_all_metaclasses { %METAS }
sub get_all_metaclass_instances { values %METAS }
sub get_all_metaclass_names { keys %METAS }
@@ -691,10 +690,6 @@
# NOTE: we don't need to inline the the accessors this only lengthens
# the compile time of the MOP, and gives us no actual benefits.
-# this is just nitpicking to ensure Class::MOP::Class->meta == ->meta->meta
-Class::MOP::Class->meta->_immutable_metaclass;
-$Class::MOP::Class::immutable_metaclass_cache{"Class::MOP::Class"}{"Class::MOP::Class::Immutable::Trait"} = Class::MOP::Class::Immutable::Class::MOP::Class->meta;
-
$_->meta->make_immutable(
inline_constructor => 1,
replace_constructor => 1,
@@ -704,7 +699,6 @@
Class::MOP::Package
Class::MOP::Module
Class::MOP::Class
- Class::MOP::Class::Immutable::Class::MOP::Class
Class::MOP::Attribute
Class::MOP::Method
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=39281&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 Fri Jul 3 23:27:25 2009
@@ -9,7 +9,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$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=39281&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 Jul 3 23:27:25 2009
@@ -8,14 +8,13 @@
use Class::MOP::Method::Wrapped;
use Class::MOP::Method::Accessor;
use Class::MOP::Method::Constructor;
-use Class::MOP::Class::Immutable::Class::MOP::Class;
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
use Sub::Name 'subname';
use Devel::GlobalDestruction 'in_global_destruction';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -197,17 +196,17 @@
: ref($super_meta);
($self->isa($super_meta_type))
- || confess "Class::MOP::class_of(" . $self->name . ") => ("
+ || confess "The metaclass of " . $self->name . " ("
. (ref($self)) . ")" . " is not compatible with the " .
- "Class::MOP::class_of(".$superclass_name . ") => ("
+ "metaclass of its superclass, ".$superclass_name . " ("
. ($super_meta_type) . ")";
# NOTE:
# we also need to check that instance metaclasses
# are compatibile in the same the class.
($self->instance_metaclass->isa($super_meta->instance_metaclass))
- || confess "Class::MOP::class_of(" . $self->name . ")->instance_metaclass => (" . ($self->instance_metaclass) . ")" .
+ || confess "The instance metaclass for " . $self->name . " (" . ($self->instance_metaclass) . ")" .
" is not compatible with the " .
- "Class::MOP::class_of(" . $superclass_name . ")->instance_metaclass => (" . ($super_meta->instance_metaclass) . ")";
+ "instance metaclass of its superclass, " . $superclass_name . " (" . ($super_meta->instance_metaclass) . ")";
}
}
@@ -1094,25 +1093,38 @@
$trait, 'ForMetaClass', ref($self);
}
- if ( Class::MOP::is_class_loaded($class_name) ) {
- if ( $class_name->isa($trait) ) {
- return $class_name;
+ return $class_name
+ if Class::MOP::is_class_loaded($class_name);
+
+ # If the metaclass is a subclass of CMOP::Class which has had
+ # metaclass roles applied (via Moose), then we want to make sure
+ # that we preserve that anonymous class (see Fey::ORM for an
+ # example of where this matters).
+ my $meta_name
+ = $self->meta->is_immutable
+ ? $self->meta->get_mutable_metaclass_name
+ : ref $self->meta;
+
+ my $meta = $meta_name->create(
+ $class_name,
+ superclasses => [ ref $self ],
+ );
+
+ Class::MOP::load_class($trait);
+ for my $meth ( Class::MOP::Class->initialize($trait)->get_all_methods ) {
+ next if $meta->has_method( $meth->name );
+
+ if ( $meta->find_method_by_name( $meth->name ) ) {
+ $meta->add_around_method_modifier( $meth->name, $meth->body );
}
else {
- confess
- "$class_name is already defined but does not inherit $trait";
+ $meta->add_method( $meth->name, $meth->clone );
}
}
- else {
- my @super = ( $trait, ref($self) );
-
- my $meta = $self->initialize($class_name);
- $meta->superclasses(@super);
-
- $meta->make_immutable;
-
- return $class_name;
- }
+
+ $meta->make_immutable( inline_constructor => 0 );
+
+ return $class_name;
}
sub _remove_inlined_code {
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=39281&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 Fri Jul 3 23:27:25 2009
@@ -8,7 +8,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -17,59 +17,79 @@
sub immutable_options { %{ $_[0]{__immutable}{options} } }
-sub is_mutable {0}
-sub is_immutable {1}
+sub is_mutable { 0 }
+sub is_immutable { 1 }
+
+sub _immutable_metaclass { ref $_[1] }
sub superclasses {
- confess "This method is read-only" if @_ > 1;
- $_[0]->next::method;
+ my $orig = shift;
+ my $self = shift;
+ confess "This method is read-only" if @_;
+ $self->$orig;
}
sub _immutable_cannot_call {
Carp::confess "This method cannot be called on an immutable instance";
}
-sub add_method { shift->_immutable_cannot_call }
-sub alias_method { shift->_immutable_cannot_call }
-sub remove_method { shift->_immutable_cannot_call }
-sub add_attribute { shift->_immutable_cannot_call }
-sub remove_attribute { shift->_immutable_cannot_call }
-sub remove_package_symbol { shift->_immutable_cannot_call }
+sub add_method { _immutable_cannot_call() }
+sub alias_method { _immutable_cannot_call() }
+sub remove_method { _immutable_cannot_call() }
+sub add_attribute { _immutable_cannot_call() }
+sub remove_attribute { _immutable_cannot_call() }
+sub remove_package_symbol { _immutable_cannot_call() }
sub class_precedence_list {
- @{ $_[0]{__immutable}{class_precedence_list}
- ||= [ shift->next::method ] };
+ my $orig = shift;
+ my $self = shift;
+ @{ $self->{__immutable}{class_precedence_list}
+ ||= [ $self->$orig ] };
}
sub linearized_isa {
- @{ $_[0]{__immutable}{linearized_isa} ||= [ shift->next::method ] };
+ my $orig = shift;
+ my $self = shift;
+ @{ $self->{__immutable}{linearized_isa} ||= [ $self->$orig ] };
}
sub get_all_methods {
- @{ $_[0]{__immutable}{get_all_methods} ||= [ shift->next::method ] };
+ my $orig = shift;
+ my $self = shift;
+ @{ $self->{__immutable}{get_all_methods} ||= [ $self->$orig ] };
}
sub get_all_method_names {
- @{ $_[0]{__immutable}{get_all_method_names} ||= [ shift->next::method ] };
+ my $orig = shift;
+ my $self = shift;
+ @{ $self->{__immutable}{get_all_method_names} ||= [ $self->$orig ] };
}
sub get_all_attributes {
- @{ $_[0]{__immutable}{get_all_attributes} ||= [ shift->next::method ] };
+ my $orig = shift;
+ my $self = shift;
+ @{ $self->{__immutable}{get_all_attributes} ||= [ $self->$orig ] };
}
sub get_meta_instance {
- $_[0]{__immutable}{get_meta_instance} ||= shift->next::method;
+ my $orig = shift;
+ my $self = shift;
+ $self->{__immutable}{get_meta_instance} ||= $self->$orig;
}
sub get_method_map {
- $_[0]{__immutable}{get_method_map} ||= shift->next::method;
+ my $orig = shift;
+ my $self = shift;
+ $self->{__immutable}{get_method_map} ||= $self->$orig;
}
sub add_package_symbol {
+ my $orig = shift;
+ my $self = shift;
confess "Cannot add package symbols to an immutable metaclass"
- unless ( caller(1) )[3] eq 'Class::MOP::Package::get_package_symbol';
+ unless ( caller(3) )[3] eq 'Class::MOP::Package::get_package_symbol';
- shift->next::method(@_);
+ $self->$orig(@_);
}
1;
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=39281&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 Fri Jul 3 23:27:25 2009
@@ -6,7 +6,7 @@
use Scalar::Util 'weaken', 'blessed';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -177,7 +177,7 @@
sub inline_slot_access {
my ($self, $instance, $slot_name) = @_;
- sprintf q[%s->{"%s"}], $instance, quotemeta($slot_name);
+ sprintf q[%s->{'%s'}], $instance, quotemeta($slot_name);
}
sub inline_get_slot_value {
@@ -212,6 +212,11 @@
sub inline_strengthen_slot_value {
my ($self, $instance, $slot_name) = @_;
$self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name));
+}
+
+sub inline_rebless_instance_structure {
+ my ($self, $instance, $class_variable) = @_;
+ "bless $instance => $class_variable";
}
1;
@@ -385,6 +390,12 @@
The method returns a snippet of code that, when inlined, performs some
operation on the instance.
+=item B<< $metainstance->inline_rebless_instance_structure($instance_variable, $class_variable) >>
+
+This takes the name of a variable that will, when inlined, represent the object
+instance, and the name of a variable that will represent the class to rebless
+into, and returns code to rebless an instance into a class.
+
=back
=head2 Introspection
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=39281&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 Jul 3 23:27:25 2009
@@ -5,9 +5,9 @@
use warnings;
use Carp 'confess';
-use Scalar::Util 'weaken';
-
-our $VERSION = '0.88';
+use Scalar::Util 'weaken', 'reftype';
+
+our $VERSION = '0.89';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -28,7 +28,7 @@
my %params = @args;
my $code = $params{body};
- ('CODE' eq ref($code))
+ (ref $code && 'CODE' eq reftype($code))
|| confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
($params{package_name} && $params{name})
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=39281&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 Jul 3 23:27:25 2009
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
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=39281&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 Jul 3 23:27:25 2009
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
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=39281&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 Jul 3 23:27:25 2009
@@ -6,7 +6,7 @@
use Carp 'confess';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
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=39281&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 Fri Jul 3 23:27:25 2009
@@ -6,7 +6,7 @@
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
@@ -77,7 +77,8 @@
# otherwise we have to check that the actual method is an inlined
# version of what we're expecting
if ( $inherited_method->isa(__PACKAGE__) ) {
- if ( refaddr( $inherited_method->_uninlined_body )
+ if ( $inherited_method->_uninlined_body
+ && refaddr( $inherited_method->_uninlined_body )
== refaddr($expected_method) ) {
return 1;
}
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=39281&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 Fri Jul 3 23:27:25 2009
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$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=39281&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 Fri Jul 3 23:27:25 2009
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
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=39281&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 Fri Jul 3 23:27:25 2009
@@ -6,7 +6,7 @@
use Scalar::Util 'blessed';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$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=39281&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 Jul 3 23:27:25 2009
@@ -8,7 +8,7 @@
use Scalar::Util 'blessed';
use Carp 'confess';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$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=39281&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/lib/metaclass.pm (original)
+++ branches/upstream/libclass-mop-perl/current/lib/metaclass.pm Fri Jul 3 23:27:25 2009
@@ -7,7 +7,7 @@
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.88';
+our $VERSION = '0.89';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
Modified: branches/upstream/libclass-mop-perl/current/t/030_method.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/t/030_method.t?rev=39281&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/t/030_method.t (original)
+++ branches/upstream/libclass-mop-perl/current/t/030_method.t Fri Jul 3 23:27:25 2009
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 46;
+use Test::More tests => 47;
use Test::Exception;
use Class::MOP;
@@ -70,6 +70,10 @@
Class::MOP::Method->wrap(sub { 'FAIL' }, name => '__ANON__')
} '... bad args for &wrap';
+lives_ok {
+ Class::MOP::Method->wrap(bless(sub { 'FAIL' }, "Foo"), name => '__ANON__', package_name => 'Foo::Bar')
+} '... blessed coderef to &wrap';
+
my $clone = $method->clone(
package_name => 'NewPackage',
name => 'new_name',
Modified: branches/upstream/libclass-mop-perl/current/t/061_instance_inline.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/t/061_instance_inline.t?rev=39281&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/t/061_instance_inline.t (original)
+++ branches/upstream/libclass-mop-perl/current/t/061_instance_inline.t Fri Jul 3 23:27:25 2009
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 8;
use Test::Exception;
use Class::MOP::Instance;
@@ -12,13 +12,17 @@
my $instance = '$self';
my $slot_name = 'foo';
my $value = '$value';
+ my $class = '$class';
+ is($C->inline_create_instance($class),
+ 'bless {} => $class',
+ '... got the right code for create_instance');
is($C->inline_get_slot_value($instance, $slot_name),
- '$self->{"foo"}',
+ "\$self->{'foo'}",
'... got the right code for get_slot_value');
is($C->inline_set_slot_value($instance, $slot_name, $value),
- '$self->{"foo"} = $value',
+ "\$self->{'foo'} = \$value",
'... got the right code for set_slot_value');
is($C->inline_initialize_slot($instance, $slot_name),
@@ -26,16 +30,19 @@
'... got the right code for initialize_slot');
is($C->inline_is_slot_initialized($instance, $slot_name),
- 'exists $self->{"foo"}',
+ "exists \$self->{'foo'}",
'... got the right code for get_slot_value');
is($C->inline_weaken_slot_value($instance, $slot_name),
- 'Scalar::Util::weaken( $self->{"foo"} )',
+ "Scalar::Util::weaken( \$self->{'foo'} )",
'... got the right code for weaken_slot_value');
is($C->inline_strengthen_slot_value($instance, $slot_name),
- '$self->{"foo"} = $self->{"foo"}',
+ "\$self->{'foo'} = \$self->{'foo'}",
'... got the right code for strengthen_slot_value');
+ is($C->inline_rebless_instance_structure($instance, $class),
+ "bless \$self => \$class",
+ '... got the right code for rebless_instance_structure');
}
Modified: branches/upstream/libclass-mop-perl/current/t/070_immutable_metaclass.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/t/070_immutable_metaclass.t?rev=39281&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/t/070_immutable_metaclass.t (original)
+++ branches/upstream/libclass-mop-perl/current/t/070_immutable_metaclass.t Fri Jul 3 23:27:25 2009
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 75;
+use Test::More tests => 73;
use Test::Exception;
use Class::MOP;
@@ -44,18 +44,14 @@
my $immutable_metaclass = $meta->_immutable_metaclass->meta;
- my $obj = $immutable_metaclass->name;
-
- ok( !$obj->is_mutable, '... immutable_metaclass is not mutable' );
- ok( $obj->is_immutable, '... immutable_metaclass is immutable' );
- ok( !$obj->make_immutable,
- '... immutable_metaclass make_mutable is noop' );
- is( $obj->meta, $immutable_metaclass,
+ my $immutable_class_name = $immutable_metaclass->name;
+
+ ok( !$immutable_class_name->is_mutable, '... immutable_metaclass is not mutable' );
+ ok( $immutable_class_name->is_immutable, '... immutable_metaclass is immutable' );
+ is( $immutable_class_name->meta, $immutable_metaclass,
'... immutable_metaclass meta hack works' );
- isa_ok( $meta, "Class::MOP::Class::Immutable::Trait" );
isa_ok( $meta, "Class::MOP::Class" );
-
}
{
Added: branches/upstream/libclass-mop-perl/current/t/074_immutable_custom_trait.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/t/074_immutable_custom_trait.t?rev=39281&op=file
==============================================================================
--- branches/upstream/libclass-mop-perl/current/t/074_immutable_custom_trait.t (added)
+++ branches/upstream/libclass-mop-perl/current/t/074_immutable_custom_trait.t Fri Jul 3 23:27:25 2009
@@ -1,0 +1,76 @@
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+use Test::Exception;
+
+use Class::MOP;
+
+{
+
+ package My::Meta;
+
+ use strict;
+ use warnings;
+ use metaclass;
+
+ use base 'Class::MOP::Class';
+
+ sub initialize {
+ shift->SUPER::initialize(
+ @_,
+ immutable_trait => 'My::Meta::Class::Immutable::Trait',
+ );
+ }
+}
+
+{
+ package My::Meta::Class::Immutable::Trait;
+
+ use MRO::Compat;
+ use base 'Class::MOP::Class::Immutable::Trait';
+
+ sub another_method { 42 }
+
+ sub superclasses {
+ my $orig = shift;
+ my $self = shift;
+ $self->$orig(@_);
+ }
+}
+
+{
+ package Foo;
+
+ use strict;
+ use warnings;
+ use metaclass;
+
+ __PACKAGE__->meta->add_attribute('foo');
+
+ __PACKAGE__->meta->make_immutable;
+}
+
+{
+ package Bar;
+
+ use strict;
+ use warnings;
+ use metaclass 'My::Meta';
+
+ use base 'Foo';
+
+ __PACKAGE__->meta->add_attribute('bar');
+
+ ::lives_ok { __PACKAGE__->meta->make_immutable }
+ 'can safely make a class immutable when it has a custom metaclass and immutable trait';
+}
+
+{
+ can_ok( Bar->meta, 'another_method' );
+ is( Bar->meta->another_method, 42, 'another_method returns expected value' );
+ is_deeply(
+ [ Bar->meta->superclasses ], ['Foo'],
+ 'Bar->meta->superclasses returns expected value after immutabilization'
+ );
+}
Modified: branches/upstream/libclass-mop-perl/current/xs/Class.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libclass-mop-perl/current/xs/Class.xs?rev=39281&op=diff
==============================================================================
--- branches/upstream/libclass-mop-perl/current/xs/Class.xs (original)
+++ branches/upstream/libclass-mop-perl/current/xs/Class.xs Fri Jul 3 23:27:25 2009
@@ -91,15 +91,17 @@
UV current;
SV *cache_flag;
SV *map_ref;
- INIT:
+ PPCODE:
if (!stash) {
- XSRETURN_EMPTY;
+ mXPUSHs(newRV_noinc((SV *)newHV()));
+ return;
}
+
current = mop_check_package_cache_flag(aTHX_ stash);
cache_flag = HeVAL( hv_fetch_ent(obj, KEY_FOR(package_cache_flag), TRUE, HASH_FOR(package_cache_flag)));
map_ref = HeVAL( hv_fetch_ent(obj, KEY_FOR(methods), TRUE, HASH_FOR(methods)));
- PPCODE:
- /* in $self->{methods} does not yet exist (or got deleted) */
+
+ /* $self->{methods} does not yet exist (or got deleted) */
if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) {
SV *new_map_ref = newRV_noinc((SV *)newHV());
sv_2mortal(new_map_ref);
More information about the Pkg-perl-cvs-commits
mailing list