RT #75468: readline ignores <> overloading when arg is tied

[perl5.git] / t / op / protowarn.t

#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = qw(. ../lib);
}

use strict;
use warnings;

BEGIN {
    require 'test.pl';
    plan( tests => 12 );
}

use vars qw{ @warnings $sub $warn };

BEGIN {
    $warn = 'Illegal character in prototype';
}

sub one_warning_ok {
    cmp_ok(scalar(@warnings), '==', 1, 'One warning');
    cmp_ok(substr($warnings[0],0,length($warn)),'eq',$warn,'warning message');
    @warnings = ();
}

sub no_warnings_ok {
    cmp_ok(scalar(@warnings), '==', 0, 'No warnings');
    @warnings = ();
}

BEGIN {
    $SIG{'__WARN__'} = sub { push @warnings, @_ };
    $| = 1;
}

BEGIN { @warnings = () }

$sub = sub (x) { };

BEGIN {
    one_warning_ok;
}

{
    no warnings 'syntax';
    $sub = sub (x) { };
}

BEGIN {
    no_warnings_ok;
}

{
    no warnings 'illegalproto';
    $sub = sub (x) { };
}

BEGIN {
    no_warnings_ok;
}

{
    no warnings 'syntax';
    use warnings 'illegalproto';
    $sub = sub (x) { };
}

BEGIN {
    one_warning_ok;
}

BEGIN {
    $warn = q{Prototype after '@' for};
}

$sub = sub (@$) { };

BEGIN {
    one_warning_ok;
}

{
    no warnings 'syntax';
    $sub = sub (@$) { };
}

BEGIN {
    no_warnings_ok;
}

{
    no warnings 'illegalproto';
    $sub = sub (@$) { };
}

BEGIN {
    no_warnings_ok;
}

{
    no warnings 'syntax';
    use warnings 'illegalproto';
    $sub = sub (@$) { };
}

BEGIN {
    one_warning_ok;
}