use strict;
use warnings;
-use Test::More tests => 67;
-use Test::Exception;
+use Test::More;
+use Test::Fatal;
use Scalar::Util qw/reftype/;
use Sub::Name;
my $Foo = Class::MOP::Class->initialize('Foo');
+is join(' ', sort $Foo->get_method_list),
+ 'FOO_CONSTANT baaz bang bar baz blah cake evaled_foo floob pie';
+
ok( $Foo->has_method('pie'), '... got the method stub pie' );
ok( $Foo->has_method('cake'), '... got the constant method stub cake' );
ok( !UNIVERSAL::isa( $foo, 'Class::MOP::Method' ),
'... our method is not yet blessed' );
-lives_ok {
+is( exception {
$Foo->add_method( 'foo' => $foo );
-}
-'... we added the method successfully';
+}, undef, '... we added the method successfully' );
my $foo_method = $Foo->get_method('foo');
is( $Foo->remove_method('foo')->body, $foo, '... removed the foo method' );
ok( !$Foo->has_method('foo'),
'... !Foo->has_method(foo) we just removed it' );
-ok( !$Foo->get_method_map->{foo}, 'foo is not in the method map' );
-dies_ok { Foo->foo } '... cannot call Foo->foo because it is not there';
+isnt( exception { Foo->foo }, undef, '... cannot call Foo->foo because it is not there' );
is_deeply(
[ sort $Foo->get_method_list ],
is( Bar->foo, 'Bar::foo', '... Bar->foo == Bar::foo' );
is( Bar->bar, 'Bar::bar', '... Bar->bar == Bar::bar' );
-lives_ok {
+is( exception {
$Bar->add_method( 'foo' => sub {'Bar::foo v2'} );
-}
-'... overwriting a method is fine';
+}, undef, '... overwriting a method is fine' );
is_deeply( [ Class::MOP::get_code_info( $Bar->get_method('foo')->body ) ],
[ "Bar", "foo" ], "subname applied to anonymous method" );
isnt( $method, $new_method,
'add_method clones method objects as they are added' );
is( $new_method->original_method, $method,
- '... the cloned method has the correct original method' );
+ '... the cloned method has the correct original method' )
+ or diag $new_method->dump;
{
package CustomAccessor;
}
);
- $meta->add_method( 'new', sub { return bless {}, shift } );
+ sub new {
+ return bless {}, shift;
+ }
}
{
is(
$o->{custom_store}, $str,
- 'Custom glob-assignment-created accessor is still method modifier is added'
+ 'Custom glob-assignment-created accessor still has method modifier'
);
}
+
+{
+ # Since the sub reference below is not a closure, Perl caches it and uses
+ # the same reference each time through the loop. See RT #48985 for the
+ # bug.
+ foreach my $ns ( qw( Foo2 Bar2 Baz2 ) ) {
+ my $meta = Class::MOP::Class->create($ns);
+
+ my $sub = sub { };
+
+ $meta->add_method( 'foo', $sub );
+
+ my $method = $meta->get_method('foo');
+ ok( $method, 'Got the foo method back' );
+ }
+}
+
+{
+ package HasConstants;
+
+ use constant FOO => 1;
+ use constant BAR => [];
+ use constant BAZ => {};
+ use constant UNDEF => undef;
+
+ sub quux {1}
+ sub thing {1}
+}
+
+my $HC = Class::MOP::Class->initialize('HasConstants');
+
+is_deeply(
+ [ sort $HC->get_method_list ],
+ [qw( BAR BAZ FOO UNDEF quux thing )],
+ 'get_method_list handles constants properly'
+);
+
+is_deeply(
+ [ sort map { $_->name } $HC->_get_local_methods ],
+ [qw( BAR BAZ FOO UNDEF quux thing )],
+ '_get_local_methods handles constants properly'
+);
+
+{
+ package DeleteFromMe;
+ sub foo { 1 }
+}
+
+{
+ my $DFMmeta = Class::MOP::Class->initialize('DeleteFromMe');
+ ok($DFMmeta->get_method('foo'));
+
+ delete $DeleteFromMe::{foo};
+
+ ok(!$DFMmeta->get_method('foo'));
+ ok(!DeleteFromMe->can('foo'));
+}
+
+
+done_testing;