? sub () { 0 }
: sub () { 1 };
- sub HAVE_ISAREV () {
- Carp::cluck("Class::MOP::HAVE_ISAREV is deprecated and will be removed in a future release. It has always returned 1 anyway.");
- return 1;
- }
-
# this is either part of core or set up appropriately by MRO::Compat
*check_package_cache_flag = \&mro::get_pkg_gen;
}
return 0;
}
-sub subname {
- require Sub::Name;
- Carp::carp("Class::MOP::subname is deprecated. Please use Sub::Name directly.");
- goto \&Sub::Name::subname;
-}
-
-sub in_global_destruction {
- require Devel::GlobalDestruction;
- Carp::carp("Class::MOP::in_global_destruction is deprecated. Please use Devel::GlobalDestruction directly.");
- goto \&Devel::GlobalDestruction::in_global_destruction;
-}
-
## ----------------------------------------------------------------------------
## Setting up our environment ...
## ----------------------------------------------------------------------------
),
);
+require Class::MOP::Deprecated unless our $no_deprecated;
# we need the meta instance of the meta instance to be created now, in order
# for the constructor to be able to use it
sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
-sub process_accessors {
- Carp::cluck('The process_accessors method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_process_accessors(@_);
-}
-
sub _process_accessors {
my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
|| $class->_construct_class_instance(package => $package_name, @_);
}
-sub construct_class_instance {
- Carp::cluck('The construct_class_instance method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_construct_class_instance(@_);
-}
-
# NOTE: (meta-circularity)
# this is a special form of _construct_instance
# (see below), which is used to construct class
$self->{'_package_cache_flag'} = Class::MOP::check_package_cache_flag($self->name);
}
-
-sub check_metaclass_compatibility {
- Carp::cluck('The check_metaclass_compatibility method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_check_metaclass_compatibility(@_);
-}
-
sub _check_metaclass_compatibility {
my $self = shift;
return $class->_construct_instance(@_);
}
-sub construct_instance {
- Carp::cluck('The construct_instance method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_construct_instance(@_);
-}
-
sub _construct_instance {
my $class = shift;
my $params = @_ == 1 ? $_[0] : {@_};
$self->{'_meta_instance'} ||= $self->_create_meta_instance();
}
-sub create_meta_instance {
- Carp::cluck('The create_meta_instance method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_create_meta_instance(@_);
-}
-
sub _create_meta_instance {
my $self = shift;
$class->_clone_instance($instance, @_);
}
-sub clone_instance {
- Carp::cluck('The clone_instance method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_clone_instance(@_);
-}
-
sub _clone_instance {
my ($class, $instance, %params) = @_;
(blessed($instance))
# to, and so don't need the fully qualified name.
}
-sub alias_method {
- Carp::cluck("The alias_method method is deprecated. Use add_method instead.\n");
-
- shift->add_method(@_);
-}
-
sub find_method_by_name {
my ($self, $method_name) = @_;
(defined $method_name && $method_name)
return values %methods;
}
-sub compute_all_applicable_methods {
- Carp::cluck('The compute_all_applicable_methods method is deprecated.'
- . " Use get_all_methods instead.\n");
-
- return map {
- {
- name => $_->name,
- class => $_->package_name,
- code => $_, # sigh, overloading
- },
- } shift->get_all_methods(@_);
-}
-
sub get_all_method_names {
my $self = shift;
my %uniq;
return values %attrs;
}
-sub compute_all_applicable_attributes {
- Carp::cluck('The compute_all_applicable_attributes method has been deprecated.'
- . " Use get_all_attributes instead.\n");
-
- shift->get_all_attributes(@_);
-}
-
sub find_attribute_by_name {
my ($self, $attr_name) = @_;
foreach my $class ($self->linearized_isa) {
--- /dev/null
+package Class::MOP::Deprecated;
+
+use strict;
+use warnings;
+use Carp qw(cluck);
+
+our $VERSION = '0.92';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+my %DeprecatedAt = (
+
+ # features deprecated before 0.93
+ 'Class::MOP::HAVE_ISAREV' => 0.93,
+ 'Class::MOP::subname' => 0.93,
+ 'Class::MOP::in_global_destruction' => 0.93,
+
+ 'Class::MOP::Class::construct_class_instance' => 0.93,
+ 'Class::MOP::Class::check_metaclass_compatibility' => 0.93,
+ 'Class::MOP::Class::create_meta_instance' => 0.93,
+ 'Class::MOP::Class::clone_instance' => 0.93,
+ 'Class::MOP::Class::alias_method' => 0.93,
+ 'Class::MOP::Class::compute_all_applicable_methods' => 0.93,
+ 'Class::MOP::Class::compute_all_applicable_attributes' => 0.93,
+
+ 'Class::MOP::Instance::bless_instance_structure' => 0.93,
+
+ 'Class::MOP::Attribute::process_accessors' => 0.93,
+
+ 'Class::MOP::Method::Accessor::initialize_body' => 0.93,
+ 'Class::MOP::Method::Accessor::generate_accessor_method' => 0.93,
+ 'Class::MOP::Method::Accessor::generate_reader_method' => 0.93,
+ 'Class::MOP::Method::Accessor::generate_writer_method' => 0.93,
+ 'Class::MOP::Method::Accessor::generate_predicate_method' => 0.93,
+ 'Class::MOP::Method::Accessor::generate_clearer_method' => 0.93,
+ 'Class::MOP::Method::Accessor::generate_accessor_method_inline' => 0.93,
+ 'Class::MOP::Method::Accessor::generate_reader_method_inline' => 0.93,
+ 'Class::MOP::Method::Accessor::generate_writer_method_inline' => 0.93,
+ 'Class::MOP::Method::Accessor::generate_clearer_method_inline' => 0.93,
+ 'Class::MOP::Method::Accessor::generate_predicate_method_inline' => 0.93,
+
+ 'Class::MOP::Method::Constructor::meta_instance' => 0.93,
+ 'Class::MOP::Method::Constructor::attributes' => 0.93,
+ 'Class::MOP::Method::Constructor::initialize_body' => 0.93,
+ 'Class::MOP::Method::Constructor::generate_constructor_method' => 0.93,
+ 'Class::MOP::Method::Constructor::generate_constructor_method_inline' =>
+ 0.93,
+
+ # features deprecated after 0.93
+ # ...
+);
+
+my %Registry;
+
+sub import {
+ my ( $class, %args ) = @_;
+
+ if ( defined( my $compat_version = delete $args{-compatible} ) ) {
+ $Registry{ (caller) } = $compat_version;
+ }
+
+ if (%args) {
+ my $unknowns = join q{ }, keys %args;
+ cluck "Unknown argument(s) for $class->import: $unknowns.\n";
+ }
+ return;
+}
+
+sub warn {
+ my ( $package, undef, undef, $feature ) = caller(1);
+
+ my $compat_version;
+ while ( $package && !defined( $compat_version = $Registry{$package} ) ) {
+ $package =~ s/ :: \w+ \z//xms or last;
+ }
+
+ my $deprecated_at = $DeprecatedAt{$feature}
+ or die "Unregistered deprecated feature: $feature";
+
+ if ( !defined($compat_version)
+ || $compat_version >= $DeprecatedAt{$feature} ) {
+ goto &cluck;
+ }
+}
+
+package
+ Class::MOP;
+
+sub HAVE_ISAREV () {
+ Class::MOP::Deprecated::warn(
+ "Class::MOP::HAVE_ISAREV is deprecated and will be removed in a future release. It has always returned 1 anyway."
+ );
+ return 1;
+}
+
+sub subname {
+ Class::MOP::Deprecated::warn(
+ "Class::MOP::subname is deprecated. Please use Sub::Name directly.");
+ require Sub::Name;
+ goto \&Sub::Name::subname;
+}
+
+sub in_global_destruction {
+ Class::MOP::Deprecated::warn(
+ "Class::MOP::in_global_destruction is deprecated. Please use Devel::GlobalDestruction directly."
+ );
+ require Devel::GlobalDestruction;
+ goto \&Devel::GlobalDestruction::in_global_destruction;
+}
+
+package
+ Class::MOP::Package;
+
+package
+ Class::MOP::Module;
+
+package
+ Class::MOP::Class;
+
+sub construct_class_instance {
+ Class::MOP::Deprecated::warn(
+ 'The construct_class_instance method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_construct_class_instance(@_);
+}
+
+sub check_metaclass_compatibility {
+ Class::MOP::Deprecated::warn(
+ 'The check_metaclass_compatibility method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_check_metaclass_compatibility(@_);
+}
+
+sub construct_instance {
+ Class::MOP::Deprecated::warn(
+ 'The construct_instance method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_construct_instance(@_);
+}
+
+sub create_meta_instance {
+ Class::MOP::Deprecated::warn(
+ 'The create_meta_instance method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_create_meta_instance(@_);
+}
+
+sub clone_instance {
+ Class::MOP::Deprecated::warn(
+ 'The clone_instance method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_clone_instance(@_);
+}
+
+sub alias_method {
+ Class::MOP::Deprecated::warn(
+ "The alias_method method is deprecated. Use add_method instead.\n");
+
+ shift->add_method(@_);
+}
+
+sub compute_all_applicable_methods {
+ Class::MOP::Deprecated::warn(
+ 'The compute_all_applicable_methods method is deprecated.'
+ . " Use get_all_methods instead.\n" );
+
+ return map {
+ {
+ name => $_->name,
+ class => $_->package_name,
+ code => $_, # sigh, overloading
+ },
+ } shift->get_all_methods(@_);
+}
+
+sub compute_all_applicable_attributes {
+ Class::MOP::Deprecated::warn(
+ 'The compute_all_applicable_attributes method has been deprecated.'
+ . " Use get_all_attributes instead.\n" );
+
+ shift->get_all_attributes(@_);
+}
+
+package
+ Class::MOP::Instance;
+
+sub bless_instance_structure {
+ Class::MOP::Deprecated::warn(
+ 'The bless_instance_structure method is deprecated.'
+ . " It will be removed in a future release.\n" );
+
+ my ( $self, $instance_structure ) = @_;
+ bless $instance_structure, $self->_class_name;
+}
+
+package
+ Class::MOP::Attribute;
+
+sub process_accessors {
+ Class::MOP::Deprecated::warn(
+ 'The process_accessors method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_process_accessors(@_);
+}
+
+package
+ Class::MOP::Method::Accessor;
+
+sub initialize_body {
+ Class::MOP::Deprecated::warn(
+ 'The initialize_body method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_initialize_body;
+}
+
+sub generate_accessor_method {
+ Class::MOP::Deprecated::warn(
+ 'The generate_accessor_method method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_generate_accessor_method;
+}
+
+sub generate_reader_method {
+ Class::MOP::Deprecated::warn(
+ 'The generate_reader_method method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_generate_reader_method;
+}
+
+sub generate_writer_method {
+ Class::MOP::Deprecated::warn(
+ 'The generate_writer_method method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_generate_writer_method;
+}
+
+sub generate_predicate_method {
+ Class::MOP::Deprecated::warn(
+ 'The generate_predicate_method method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_generate_predicate_method;
+}
+
+sub generate_clearer_method {
+ Class::MOP::Deprecated::warn(
+ 'The generate_clearer_method method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_generate_clearer_method;
+}
+
+sub generate_accessor_method_inline {
+ Class::MOP::Deprecated::warn(
+ 'The generate_accessor_method_inline method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_generate_accessor_method_inline;
+}
+
+sub generate_reader_method_inline {
+ Class::MOP::Deprecated::warn(
+ 'The generate_reader_method_inline method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_generate_reader_method_inline;
+}
+
+sub generate_writer_method_inline {
+ Class::MOP::Deprecated::warn(
+ 'The generate_writer_method_inline method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_generate_writer_method_inline;
+}
+
+sub generate_predicate_method_inline {
+ Class::MOP::Deprecated::warn(
+ 'The generate_predicate_method_inline method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_generate_predicate_method_inline;
+}
+
+sub generate_clearer_method_inline {
+ Class::MOP::Deprecated::warn(
+ 'The generate_clearer_method_inline method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_generate_clearer_method_inline;
+}
+
+package
+ Class::MOP::Method::Constructor;
+
+sub meta_instance {
+ Class::MOP::Deprecated::warn(
+ 'The meta_instance method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_meta_instance;
+}
+
+sub attributes {
+ Class::MOP::Deprecated::warn(
+ 'The attributes method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+
+ return shift->_attributes;
+}
+
+sub initialize_body {
+ Class::MOP::Deprecated::warn(
+ 'The initialize_body method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_initialize_body;
+}
+
+sub generate_constructor_method {
+ Class::MOP::Deprecated::warn(
+ 'The generate_constructor_method method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_generate_constructor_method;
+}
+
+sub generate_constructor_method_inline {
+ Class::MOP::Deprecated::warn(
+ 'The generate_constructor_method_inline method has been made private.'
+ . " The public version is deprecated and will be removed in a future release.\n"
+ );
+ shift->_generate_constructor_method_inline;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Class::MOP::Deprecated - List of deprecated methods
+
+=head1 DESCRIPTION
+
+ use Class::MOP::Deprecated -compatible => $version;
+
+=head1 FUNCTIONS
+
+This class provides methods that have been deprecated but remain for backward compatibility.
+
+If you specify C<< -compatible => $version >>, you can use deprecated features without warnings.
+Note that this special treatment is package-scoped.
+
+=over 4
+
+=item B<Class::MOP::Deprecated::warn($message)>
+
+Checks compatibility for the caller feature, and produces warnings if needed.
+
+This function is used in internals.
+
+=back
+
+=head1 AUTHORS
+
+Goro Fuji E<lt>gfuji@cpan.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2009 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
## factory
-sub initialize_body {
- Carp::cluck('The initialize_body method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_initialize_body;
-}
-
sub _initialize_body {
my $self = shift;
}
return $self->_generate_accessor_method_basic();
+<<<<<<< HEAD:lib/Class/MOP/Method/Accessor.pm
}
sub _generate_reader_method {
## basic generators
-sub generate_accessor_method {
- Carp::cluck('The generate_accessor_method method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_generate_accessor_method_basic;
+=======
+}
+
+sub _generate_reader_method {
+ my ($self) = @_;
+
+ if(my $xs = $self->associated_metaclass->instance_metaclass->can_xs()){
+ return $self->_generate_reader_method_xs($xs);
+ }
+
+ if($self->is_inline){
+ return $self->_generate_reader_method_inline();
+ }
+
+ return $self->_generate_reader_method_basic();
+}
+
+sub _generate_writer_method {
+ my ($self) = @_;
+
+ if(my $xs = $self->associated_metaclass->instance_metaclass->can_xs()){
+ return $self->_generate_writer_method_xs($xs);
+ }
+
+ if($self->is_inline){
+ return $self->_generate_writer_method_inline();
+ }
+
+ return $self->_generate_writer_method_basic();
}
+sub _generate_clearer_method {
+ my ($self) = @_;
+
+ if(my $xs = $self->associated_metaclass->instance_metaclass->can_xs()){
+ return $self->_generate_clearer_method_xs($xs);
+ }
+
+ if($self->is_inline){
+ return $self->_generate_clearer_method_inline();
+ }
+
+ return $self->_generate_clearer_method_basic();
+}
+
+sub _generate_predicate_method {
+ my ($self) = @_;
+
+ if(my $xs = $self->associated_metaclass->instance_metaclass->can_xs()){
+ return $self->_generate_predicate_method_xs($xs);
+ }
+
+ if($self->is_inline){
+ return $self->_generate_predicate_method_inline();
+ }
+
+ return $self->_generate_predicate_method_basic();
+}
+
+
+## basic generators
+
sub _generate_accessor_method_basic {
my $attr = (shift)->associated_attribute;
return sub {
};
}
-sub generate_reader_method {
- Carp::cluck('The generate_reader_method method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_generate_reader_method_basic;
-}
-
sub _generate_reader_method_basic {
my $attr = (shift)->associated_attribute;
return sub {
};
}
-sub generate_writer_method {
- Carp::cluck('The generate_writer_method method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_generate_writer_method_basic;
-}
-
sub _generate_writer_method_basic {
my $attr = (shift)->associated_attribute;
return sub {
};
}
-sub generate_predicate_method {
- Carp::cluck('The generate_predicate_method method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_generate_predicate_method_basic;
-}
-
sub _generate_predicate_method_basic {
my $attr = (shift)->associated_attribute;
return sub {
};
}
-sub generate_clearer_method {
- Carp::cluck('The generate_clearer_method method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_generate_clearer_method_basic;
-}
-
sub _generate_clearer_method_basic {
my $attr = (shift)->associated_attribute;
return sub {
## Inline methods
-sub generate_accessor_method_inline {
- Carp::cluck('The generate_accessor_method_inline method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_generate_accessor_method_inline;
-}
-
sub _generate_accessor_method_inline {
my $self = shift;
my $attr = $self->associated_attribute;
return $code;
}
-sub generate_reader_method_inline {
- Carp::cluck('The generate_reader_method_inline method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_generate_reader_method_inline;
-}
-
sub _generate_reader_method_inline {
my $self = shift;
my $attr = $self->associated_attribute;
return $code;
}
-sub generate_writer_method_inline {
- Carp::cluck('The generate_writer_method_inline method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_generate_writer_method_inline;
-}
-
sub _generate_writer_method_inline {
my $self = shift;
my $attr = $self->associated_attribute;
return $code;
}
-sub generate_predicate_method_inline {
- Carp::cluck('The generate_predicate_method_inline method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_generate_predicate_method_inline;
-}
-
sub _generate_predicate_method_inline {
my $self = shift;
my $attr = $self->associated_attribute;
return $code;
}
-sub generate_clearer_method_inline {
- Carp::cluck('The generate_clearer_method_inline method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_generate_clearer_method_inline;
-}
-
sub _generate_clearer_method_inline {
my $self = shift;
my $attr = $self->associated_attribute;
## cached values ...
-sub meta_instance {
- Carp::cluck('The meta_instance method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_meta_instance;
-}
-
sub _meta_instance {
my $self = shift;
$self->{'meta_instance'} ||= $self->associated_metaclass->get_meta_instance;
}
-sub attributes {
- Carp::cluck('The attributes method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
-
- return shift->_attributes;
-}
-
sub _attributes {
my $self = shift;
$self->{'attributes'} ||= [ $self->associated_metaclass->get_all_attributes ]
## method
-sub initialize_body {
- Carp::cluck('The initialize_body method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_initialize_body;
-}
-
sub _initialize_body {
my $self = shift;
$self->{'body'} = $self->_generate_constructor_method();
}
-sub generate_constructor_method {
- Carp::cluck('The generate_constructor_method method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_generate_constructor_method;
-}
-
sub _generate_constructor_method {
my ($self) = @_;
return sub { Class::MOP::Class->initialize(shift)->new_object(@_) }
}
-sub generate_constructor_method_inline {
- Carp::cluck('The generate_constructor_method_inline method has been made private.'
- . " The public version is deprecated and will be removed in a future release.\n");
- shift->_generate_constructor_method_inline;
-}
-
sub _generate_constructor_method_inline {
my $self = shift;
} keys %$__captures
),
$_[2];
- print STDERR $_[0]->name, ' ', $source, "\n" if _PRINT_SOURCE;
+ print STDERR "\n", $_[0]->name, ":\n", $source, "\n" if _PRINT_SOURCE;
$code = eval $source;
$@;
};
use Class::MOP;
use Class::MOP::Class;
-use Test::More qw/no_plan/;
+use Test::More tests => 9;
use Test::Exception;
my %results;
{
+
package Base;
use metaclass;
sub hey { $results{base}++ }
for my $wrap (qw(before after)) {
my $meta = Class::MOP::Class->create_anon_class(
- superclasses => ['Base', 'Class::MOP::Object']
- );
+ superclasses => [ 'Base', 'Class::MOP::Object' ] );
my $alter = "add_${wrap}_method_modifier";
- $meta->$alter('hey' => sub {
- $results{wrapped}++;
- $_ = 'barf'; # 'barf' would replace the cached wrapper subref
- });
+ $meta->$alter(
+ 'hey' => sub {
+ $results{wrapped}++;
+ $_ = 'barf'; # 'barf' would replace the cached wrapper subref
+ }
+ );
%results = ();
my $o = $meta->get_meta_instance->create_instance;
- isa_ok($o, 'Base');
+ isa_ok( $o, 'Base' );
lives_ok {
$o->hey;
- $o->hey; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
- } 'wrapped doesn\'t die when $_ gets changed';
- is_deeply(\%results, {base=>2,wrapped=>2});
+ $o->hey
+ ; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
+ }
+ 'wrapped doesn\'t die when $_ gets changed';
+ is_deeply(
+ \%results, { base => 2, wrapped => 2 },
+ 'saw expected calls to wrappers'
+ );
}
{
my $meta = Class::MOP::Class->create_anon_class(
- superclasses => ['Base', 'Class::MOP::Object']
- );
+ superclasses => [ 'Base', 'Class::MOP::Object' ] );
for my $wrap (qw(before after)) {
my $alter = "add_${wrap}_method_modifier";
- $meta->$alter('hey' => sub {
- $results{wrapped}++;
- $_ = 'barf'; # 'barf' would replace the cached wrapper subref
- });
+ $meta->$alter(
+ 'hey' => sub {
+ $results{wrapped}++;
+ $_ = 'barf'; # 'barf' would replace the cached wrapper subref
+ }
+ );
}
%results = ();
my $o = $meta->get_meta_instance->create_instance;
- isa_ok($o, 'Base');
+ isa_ok( $o, 'Base' );
lives_ok {
$o->hey;
- $o->hey; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
- } 'double-wrapped doesn\'t die when $_ gets changed';
- is_deeply(\%results, {base=>2,wrapped=>4});
+ $o->hey
+ ; # this would die with 'Can't use string ("barf") as a subroutine ref while "strict refs" in use'
+ }
+ 'double-wrapped doesn\'t die when $_ gets changed';
+ is_deeply(
+ \%results, { base => 2, wrapped => 4 },
+ 'saw expected calls to wrappers'
+ );
}
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use Test::Exception;
+
+use Carp;
+
+$SIG{__WARN__} = \&croak;
+
+{
+ package Foo;
+ use Test::More;
+ use Test::Exception;
+
+ throws_ok {
+ Class::MOP::in_global_destruction();
+ } qr/\b deprecated \b/xmsi, 'complained';
+}
+
+{
+ package Bar;
+ use Test::More;
+ use Test::Exception;
+
+ use Class::MOP::Deprecated -compatible => 0.93;
+
+ throws_ok {
+ Class::MOP::in_global_destruction();
+ } qr/\b deprecated \b/xmsi, 'complained';
+}
+
+{
+ package Baz;
+ use Test::More;
+ use Test::Exception;
+
+ use Class::MOP::Deprecated -compatible => 0.92;
+
+ lives_ok {
+ Class::MOP::in_global_destruction();
+ } 'safe';
+}
+
+
+{
+ package Baz::Inner;
+ use Test::More;
+ use Test::Exception;
+
+ lives_ok {
+ Class::MOP::in_global_destruction();
+ } 'safe in an inner class';
+}
+
EXTERN_C XS(boot_Class__MOP__Package);
EXTERN_C XS(boot_Class__MOP__Class);
EXTERN_C XS(boot_Class__MOP__Attribute);
-EXTERN_C XS(boot_Class__MOP__Method);
EXTERN_C XS(boot_Class__MOP__Instance);
+EXTERN_C XS(boot_Class__MOP__Method);
EXTERN_C XS(boot_Class__MOP__Method__Accessor);
EXTERN_C XS(boot_Class__MOP__Method__Constructor);
BOOT:
mop_method_metaclass = MAKE_KEYSV(method_metaclass);
- mop_wrap = MAKE_KEYSV(wrap);
mop_associated_metaclass = MAKE_KEYSV(associated_metaclass);
mop_associated_attribute = MAKE_KEYSV(associated_attribute);
+ mop_wrap = MAKE_KEYSV(wrap);
mop_methods = MAKE_KEYSV(methods);
mop_name = MAKE_KEYSV(name);
mop_body = MAKE_KEYSV(body);
Vilain
wreis
Yuval
+Goro
## proper names
AOP
projects / gitmo/Class-MOP.git / commitdiff