File Manager - BorneoXploit

Editing: 120-fresh.t

#!/usr/bin/perl
use strict;
use warnings;

use Test::More 0.88;
use if $ENV{AUTHOR_TESTING}, 'Test::Warnings';

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;

eval { fresh m1 => sub {} };
    ::like($@,
           qr/^Class P2 already has a method named 'm1'/,
           'fresh: exception when inherited method exists');

eval { fresh m6 => sub {} };
    ::like($@,
           qr/^Class P2 already has a method named 'm6'/,
           'fresh: exception when local method exists');

eval { fresh '=:=' => sub {} };
    ::like($@,
           qr/^Invalid method name '=:='/,
           'fresh: exception when name invalid');
}

eval { install_modifier P3 => fresh => m1 => sub {} };
like($@,
     qr/^Class P3 already has a method named 'm1'/,
     'install_modifier: exception when inherited method exists');

eval { install_modifier P3 => fresh => m6 => sub {} };
like($@,
     qr/^Class P3 already has a method named 'm6'/,
     'install_modifier: exception when local method exists');

eval { install_modifier P3 => fresh => '=:=' => sub {} };
like($@,
     qr/^Invalid method name '=:='/,
     'install_modifier: exception when name invalid');

done_testing;

Cancel