view release on metacpan or  search on metacpan

t/3-coderef.t  view on Meta::CPAN

use strict;
use Config;
use Test::More;
BEGIN {
    if ($] < 5.010) {
        plan skip_all => "modifying coderef hints doesn't work properly on 5.8";
    }
    else {
        plan tests => 39;
    }
}
use ok 'Devel::Hints', ':all';
use Carp;


my ($sub, $line, $warning_bits, $open);
{
    package Foo;
    use warnings;
    no warnings 'deprecated';
    use open IO => ':utf8';
    BEGIN {
        $warning_bits = ${^WARNING_BITS};
        $open = ${^OPEN};
    }

    $[ = 10;
    $line = __LINE__ + 3;

    $sub = sub {
        warn 'foo';
        reset 'X';
        my @a = (1..10);
        /blarg/ || warn 'foo';
        if (sub { 1 }->()) {
            warn 'foo';
        }
        else {
            warn 'bar';
        }
        if (sub { 0 }->()) {
            warn 'bar';
        }
        else {
            warn 'foo';
        }
        for (1..3) {
            warn 'foo';
        }
        return (bless {}), $a[1], (warnings::enabled('redefine'));
    };
}

is(cop_label($sub), undef, 'cop_label');

is(cop_file($sub), __FILE__, 'cop_file');

is(cop_filegv($sub), \$::{'_<' . __FILE__}, 'cop_filegv');

is(cop_stashpv($sub), 'Foo', 'cop_stashpv');

{
    no strict 'refs';
    is_deeply(cop_stash($sub), \%{'Foo::'}, 'cop_stash');
}

ok(cop_seq($sub), 'cop_seq');

is(cop_arybase($sub), 10, 'cop_arybase');

is(cop_line($sub), $line, 'cop_line');

SKIP: {
    skip('cop_warnings() not available', 1) unless defined cop_warnings();

    is(cop_warnings($sub), $warning_bits, 'cop_warnings');
}

SKIP: {
    skip('cop_io() not available', 1) unless defined cop_io();

    is(cop_io($sub), $open, 'cop_io - empty string when not set');
}

my ($Topic, $TopicRV);
foreach (qw(label file filegv stashpv stash seq arybase line warnings io)) {
    no strict 'refs';