use strict;
use warnings;
use Test::More 0.88;
use if $ENV{AUTHOR_TESTING}, 'Test::Warnings';
use Test::Fatal;
use B 'svref_2object';
BEGIN {
package P1;
sub new { bless {}, shift }
sub m1 { 'P1/m1' }
package P2;
our @ISA = 'P1';
use Class::Method::Modifiers 'fresh';
sub m6 { 'P2/m6' }
fresh m2 => sub { 'P2/m2' };
fresh [qw(m3 m4)] => sub { 'P2/m3/m4' };
my $closee = 'closee';
fresh m5 => sub { "P2/m5/$closee" };
}
BEGIN {
package P3; # like P2, but using install_modifier
our @ISA = 'P1';
sub m6 { 'P3/m6' }
package main;
use Class::Method::Modifiers 'install_modifier';
install_modifier P3 => fresh => m2 => sub { 'P3/m2' };
install_modifier P3 => fresh => [qw(m3 m4)] => sub { 'P3/m3/m4' };
my $closee = 'closee';
install_modifier P3 => fresh => m5 => sub { "P3/m5/$closee" };
}
can_ok(P2->new, @$_) for [
qw(m2), # single-name call to fresh
qw(m3 m4), # multi-name call
qw(m5), # code ref is closure
];
is(P2->new->m5, 'P2/m5/closee', 'closure works');
can_ok(P3->new, qw(m2 m3 m4 m5));
is(P3->new->m5, 'P3/m5/closee', 'closure works with install_modifier');
for my $class (qw(P2 P3)) {
my $method = $class->can('m5');
is(svref_2object($method)->GV->STASH->NAME, $class,
"method installed in $class has correct stash name");
}
{
package P2;
::like(::exception { fresh m1 => sub {} },
qr/^Class P2 already has a method named 'm1'/,
'fresh: exception when inherited method exists');
::like(::exception { fresh m6 => sub {} },
qr/^Class P2 already has a method named 'm6'/,
'fresh: exception when local method exists');
::like(::exception { fresh '=:=' => sub {} },
qr/^Invalid method name '=:='/,
'fresh: exception when name invalid');
}
like(exception { install_modifier P3 => fresh => m1 => sub {} },
qr/^Class P3 already has a method named 'm1'/,
'install_modifier: exception when inherited method exists');
like(exception { install_modifier P3 => fresh => m6 => sub {} },
qr/^Class P3 already has a method named 'm6'/,
'install_modifier: exception when local method exists');
like(exception { install_modifier P3 => fresh => '=:=' => sub {} },
qr/^Invalid method name '=:='/,
'install_modifier: exception when name invalid');
done_testing;