141-prototype.t

use strict;
use warnings;
use Test::More 0.88;

use Class::Method::Modifiers;

{
    sub foo ($) { scalar @_ }

    my $after;
    after foo => sub { $after = @_ };

    is eval q{ foo( @{[10, 20]} ) }, 1,
        'after wrapped sub maintains prototype';
    is $after, 1,
        'after modifier applied';
}

{
    my $bar;
    my $guff;
    sub bar ($) :lvalue { $guff = @_; $bar }

    my $after;
    after bar => sub { $after = @_ };

    eval q{ bar( @{[10, 20]} ) = 5 };
    is $guff, 1,
        'after wrapped lvalue sub maintains prototype';
    is $bar, 5,
        'after wrapped lvalue sub maintains lvalue';
    is $after, 1,
        'after modifier applied';
}

{
    my $around;

    sub bog ($) { scalar @_ }
    my $wrap_bog = sub ($$) {
        my $orig = shift;
        $around = @_;
        $orig->(@_);
    };

    my $warn_line;
    my @warn;
    {
        local $SIG{__WARN__} = sub { push @warn, @_ };
        $warn_line = __LINE__ + 1;
        around bog => $wrap_bog;
    }

    is eval q{ bog( @{[5, 6]}, @{[10, 11]} ) }, 2,
        'around wrapped lvalue sub takes modifier prototype';
    is $around, 2,
        'around modifier applied';
    my $warn = join '', @warn;
    like $warn, qr/Prototype mismatch/,
        'changing prototype throws warning';
    like $warn, qr/\Q${\__FILE__}\E line $warn_line\b/,
        'warning is reported from correct location';
}

{
    sub brog ($) { scalar @_ }
    my $wrap_brog = sub ($$) {
        my $orig = shift;
        $orig->(@_);
    };

    my @warn;
    {
        local $SIG{__WARN__} = sub { push @warn, @_ };
        no warnings;
        around brog => $wrap_brog;
    }

    is 0+@warn, 0,
        'warnings controllable via warning pragma';
}

{
    my $around;

    require List::Util;
    List::Util->import('sum');
    my $wrap_sum = sub :prototype(@) {
        my $orig = shift;
        $around = @_;
        return 2 * $orig->(@_);
    };


    my @warn;
    {
        local $SIG{__WARN__} = sub { push @warn, @_ };
        around sum => $wrap_sum;
    }

    is eval q{sum(11, 1, 4, 5, 9)}, 60,
        'result from around xs function';
    is $around, 5, 'prototype @ wrapped';
    is 0+@warn, 0, 'no warnings';
}

done_testing;
# vim: set ts=8 sts=4 sw=4 tw=115 et :