view release on metacpan or  search on metacpan

t/year_imports.t  view on Meta::CPAN

    eval qq|use Modern::Perl $year; sub { given (0) {} }|;
    isnt $@, '', qq|use Modern::Perl $year does not enable switch|;
}

sub test_no_indirect_for {
    my $year = _get_year(shift);

    my $warning = '';
    local $SIG{__WARN__} = sub { $warning = shift };

    eval qq|use Modern::Perl $year; my \$foo = new Modern::Perl;|;
    like $@, qr/syntax error.+near "new Modern::Perl"/,
        qq|use Modern::Perl $year disables indirect method calls|;
}

sub test_no_multidimensional_for {
    my $year = _get_year(shift);

    my $warning = '';
    local $SIG{__WARN__} = sub { $warning = shift };

    eval qq{
        use Modern::Perl $year;
        my (\$x, \$y) = (1, 2);
        my %foo;

        \$foo{\$x, \$y} = 'bar';
    };
    like $@, qr/Multidimensional hash lookup is disabled/,
        qq|use Modern::Perl $year disables multidimensional array emulation|;
}

sub test_say_for {
    my $year = _get_year(shift);

    eval qq|use Modern::Perl $year; sub { say 0 }|;
    is $@, '', qq|use Modern::Perl $year enables say|;
}

sub test_state_for {
    my $year = _get_year(shift);

    eval qq|use Modern::Perl $year; state \$x;|;
    is $@, '', qq|use Modern::Perl $year enables state|;
}

sub test_cur_sub_for {
    my $year = _get_year(shift);

    eval qq|use Modern::Perl $year; sub { return __SUB__ }|;
    is $@, '', qq|use Modern::Perl $year enables current_sub|;
}

sub test_array_base_for {
    my $year = _get_year(shift);

    my $warning = '';
    local $SIG{__WARN__} = sub { $warning = shift };

    if (eval qq|use Modern::Perl $year; \$[ = 10|) {
        like $warning, qr/Use of assignment to \$\[ is deprecated/,
            qq|use Modern::Perl $year disables array_base|;
    }
    else {
        like $@, qr/Assigning non-zero to \$\[ is no longer possible/,
            qq|use Modern::Perl $year works without array_base|;
    }
}

sub test_fc_for {
    my $year = _get_year(shift);

    eval qq|use Modern::Perl $year; fc("tschüß") eq fc("TSCHÜSS")|;
    is $@, '', qq|use Modern::Perl $year enables fc|;
}

sub test_postderef_for {
    my $year = _get_year(shift);

    eval qq|use Modern::Perl $year; my \$r = [ 1, [ 2, 3 ], 4 ]; \$r->[1]->@*|;
    is $@, '', qq|use Modern::Perl $year enables postderef_qq|;
}

sub test_unicode_strings_for {
    my $year = _get_year(shift);

    eval qq{
        use Modern::Perl $year;
        is uc "\xdf", "SS", q|use Modern::Perl $year enables unicode_strings|;
    };
}

sub test_signatures_for {
    my $year = _get_year(shift);

    my @warnings;
    local $SIG{__WARN__} = sub { push @warnings, @_ };

    local $@;
    my ($yearnum) = $year =~ m/(\d+)/;
    eval qq{
        use Modern::Perl $year;
        sub foo_$yearnum( \$bar ) { ... }
    };
    is $@, '', qq|use Modern::Perl $year enables signatures|;
    is @warnings, 0, '... and disables signature warnings';
}

sub test_isa_for {
    my $year = _get_year(shift);

    eval qq{
        use Modern::Perl $year;
        my \$foo = bless {}, 'Some::Class';
        my \$result = \$foo isa 'Some::Class';
    };
    is $@, '', qq|use Modern::Perl $year enables isa|;
}

sub test_warnings_for {