Revision history for Perl extension Class-MOP.
0.56
+ * Class::MOP
+ - we now get the &check_package_cache_flag
+ function from MRO::Compat
+
* Class::MOP::Attribute
- add has_read_method and has_write_method
#include "ppport.h"
/*
-check_method_cache_flag:
- check the PL_sub_generation
- ISA/method cache thing
-
get_code_info:
Pass in a coderef, returns:
[ $pkg_name, $coderef_name ] ie:
PROTOTYPES: ENABLE
-SV*
-check_package_cache_flag(pkg)
- SV* pkg
- CODE:
- RETVAL = newSViv(PL_sub_generation);
- OUTPUT:
- RETVAL
-
void
get_code_info(coderef)
SV* coderef
use XSLoader;
XSLoader::load( 'Class::MOP', $VERSION );
- unless ($] < 5.009_005) {
- require mro;
- no warnings 'redefine', 'prototype';
- *check_package_cache_flag = \&mro::get_pkg_gen;
- *IS_RUNNING_ON_5_10 = sub () { 1 };
- }
- else {
- *IS_RUNNING_ON_5_10 = sub () { 0 };
- }
+ *IS_RUNNING_ON_5_10 = ($] < 5.009_005)
+ ? sub () { 0 }
+ : sub () { 1 };
+
+ # get it from MRO::Compat now ...
+ *check_package_cache_flag = \&mro::get_pkg_gen;
}
{
if ($options{inline_destructor} && $immutable->has_method('DESTROY')) {
$immutable->remove_method('DESTROY')
- if $immutable->get_method('DESTROY')->blessed eq $options{destructor_class};
+ if blessed($immutable->get_method('DESTROY')) eq $options{destructor_class};
}
# NOTE:
# 14:26 <@stevan> the only user of ::Method::Constructor is immutable
# 14:27 <@stevan> if someone uses it outside of immutable,.. they are either: mst or groditi
# 14:27 <@stevan> so I am not worried
- if ($options{inline_constructor}) {
+ if ($options{inline_constructor} && $immutable->has_method($options{constructor_name})) {
my $constructor_class = $options{constructor_class} || 'Class::MOP::Method::Constructor';
$immutable->remove_method( $options{constructor_name} )
- if $immutable->get_method($options{constructor_name})->blessed eq $constructor_class;
+ if blessed($immutable->get_method($options{constructor_name})) eq $constructor_class;
}
}
my $anon_class = Class::MOP::Class->create_anon_class(superclasses => [$class]);
$anon_class_name = $anon_class->name;
- $anon_meta_name = $anon_class->blessed;
+ $anon_meta_name = Scalar::Util::blessed($anon_class);
$anon_class->add_attribute( $_, reader => $_ ) for qw/bar baz/;
my $obj = $anon_class->new_object(bar => 'a', baz => 'b');
is_deeply(
[ $immutable_metaclass->superclasses ],
- [ $meta->blessed ],
+ [ Scalar::Util::blessed($meta) ],
'... immutable_metaclass superclasses are correct'
);
ok($immutable_metaclass->has_method('get_mutable_metaclass_name'));
{
my $meta = Baz->meta;
ok($meta->is_mutable, '... Baz is mutable');
- is(Foo->meta->blessed, Bar->meta->blessed, 'Foo and Bar immutable metaclasses match');
- is($meta->blessed, 'MyMetaClass', 'Baz->meta blessed as MyMetaClass');
+ is(Scalar::Util::blessed(Foo->meta), Scalar::Util::blessed(Bar->meta), 'Foo and Bar immutable metaclasses match');
+ is(Scalar::Util::blessed($meta), 'MyMetaClass', 'Baz->meta blessed as MyMetaClass');
ok(Baz->can('mymetaclass_attributes'), '... Baz can do method before immutable');
ok($meta->can('mymetaclass_attributes'), '... meta can do method before immutable');
lives_ok { $meta->make_immutable } "Baz is now immutable";
isa_ok($meta, 'MyMetaClass', 'Baz->meta');
ok(Baz->can('mymetaclass_attributes'), '... Baz can do method after imutable');
ok($meta->can('mymetaclass_attributes'), '... meta can do method after immutable');
- isnt(Baz->meta->blessed, Bar->meta->blessed, 'Baz and Bar immutable metaclasses are different');
+ isnt(Scalar::Util::blessed(Baz->meta), Scalar::Util::blessed(Bar->meta), 'Baz and Bar immutable metaclasses are different');
lives_ok { $meta->make_mutable } "Baz is now mutable";
ok($meta->is_mutable, '... Baz is mutable again');
}