Gecko [ www.thearyasamaj.org ]

Name	Size	Permission
00-report-prereqs.dd	8.98 KB	-rw-r--r--
00-report-prereqs.t	5.57 KB	-rw-r--r--
000-load.t	310 B	-rw-r--r--
001-error.t	1010 B	-rw-r--r--
002-cache.t	2.02 KB	-rw-r--r--
003-basic.t	2.06 KB	-rw-r--r--
004-around.t	1.31 KB	-rw-r--r--
005-return.t	457 B	-rw-r--r--
010-before-args.t	687 B	-rw-r--r--
011-after-args.t	769 B	-rw-r--r--
012-around-args.t	731 B	-rw-r--r--
020-multiple-inheritance.t	3.54 KB	-rw-r--r--
030-multiple-before.t	629 B	-rw-r--r--
031-multiple-after.t	622 B	-rw-r--r--
032-multiple-around.t	859 B	-rw-r--r--
034-multiple-everything.t	1.33 KB	-rw-r--r--
035-multiple-everything-twice....	2.33 KB	-rw-r--r--
040-twice-orig.t	487 B	-rw-r--r--
041-modify-parent.t	978 B	-rw-r--r--
051-undef-list-ctxt.t	912 B	-rw-r--r--
060-caller.t	1.15 KB	-rw-r--r--
070-modify-multiple-at-once.t	967 B	-rw-r--r--
080-multiple-modifiers.t	1.56 KB	-rw-r--r--
081-sub-and-modifier.t	3.07 KB	-rw-r--r--
090-diamond.t	683 B	-rw-r--r--
100-class-mop-method-modifiers...	1.95 KB	-rw-r--r--
110-namespace-clean.t	1.61 KB	-rw-r--r--
120-fresh.t	2.43 KB	-rw-r--r--
130-clean-underscore.t	1.74 KB	-rw-r--r--
140-lvalue.t	1.59 KB	-rw-r--r--

Code Editor : 120-fresh.t

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;

${this.title}

Code Editor : 120-fresh.t