Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
bproto.t	939 B	-r--r--r--	2014-12-27 11:49
cmdopt.t	3.14 KB	-r--r--r--	2014-12-27 11:49
colon.t	3.24 KB	-r--r--r--	2014-12-27 11:49
decl.t	549 B	-r--r--r--	2014-12-27 11:49
final_line_num.t	364 B	-r--r--r--	2014-12-27 11:49
fold.t	4.71 KB	-r--r--r--	2014-12-27 11:49
form_scope.t	4.24 KB	-r--r--r--	2014-12-27 11:49
hints.aux	93 B	-r--r--r--	2014-12-27 11:49
hints.t	7.91 KB	-r--r--r--	2014-12-27 11:49
line_debug.t	793 B	-r--r--r--	2014-12-27 11:49
line_debug_0.aux	273 B	-r--r--r--	2014-12-27 11:49
multiline.t	1.7 KB	-r--r--r--	2014-12-27 11:49
opsubs.t	5.67 KB	-r--r--r--	2014-12-27 11:49
our.t	1.5 KB	-r--r--r--	2014-12-27 11:49
package.t	1.5 KB	-r--r--r--	2014-12-27 11:49
package_block.t	2.68 KB	-r--r--r--	2014-12-27 11:49
parser.t	17.53 KB	-r--r--r--	2015-01-15 22:12
proto.t	21.63 KB	-r--r--r--	2014-12-27 11:49
redef.t	2.02 KB	-r--r--r--	2014-12-27 11:49
require.t	11.07 KB	-r--r--r--	2014-12-27 11:49
retainedlines.t	4.08 KB	-r--r--r--	2014-12-27 11:49
term.t	2.29 KB	-r--r--r--	2014-12-27 11:49
uproto.t	3.53 KB	-r--r--r--	2014-12-27 11:49
use.t	7.43 KB	-r--r--r--	2014-12-27 11:49
utf.t	3.13 KB	-r--r--r--	2014-12-27 11:49

#!./perl -w
#
# Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>

BEGIN {
    $warn = "";
    $SIG{__WARN__} = sub { $warn .= join("",@_) }
}

sub ok ($$) { 
    print $_[1] ? "ok " : "not ok ", $_[0], "\n";
}

print "1..20\n";

my $NEWPROTO = 'Prototype mismatch:';

sub sub0 { 1 }
sub sub0 { 2 }

ok 1, $warn =~ s/Subroutine sub0 redefined[^\n]+\n//s;

sub sub1    { 1 }
sub sub1 () { 2 }

ok 2, $warn =~ s/$NEWPROTO \Qsub main::sub1: none vs ()\E[^\n]+\n//s;
ok 3, $warn =~ s/Subroutine sub1 redefined[^\n]+\n//s;

sub sub2     { 1 }
sub sub2 ($) { 2 }

ok 4, $warn =~ s/$NEWPROTO \Qsub main::sub2: none vs ($)\E[^\n]+\n//s;
ok 5, $warn =~ s/Subroutine sub2 redefined[^\n]+\n//s;

sub sub3 () { 1 }
sub sub3    { 2 }

ok 6, $warn =~ s/$NEWPROTO \Qsub main::sub3 () vs none\E[^\n]+\n//s;
ok 7, $warn =~ s/Constant subroutine sub3 redefined[^\n]+\n//s;

sub sub4 () { 1 }
sub sub4 () { 2 }

ok 8, $warn =~ s/Constant subroutine sub4 redefined[^\n]+\n//s;

sub sub5 ()  { 1 }
sub sub5 ($) { 2 }

ok  9, $warn =~ s/$NEWPROTO \Qsub main::sub5 () vs ($)\E[^\n]+\n//s;
ok 10, $warn =~ s/Constant subroutine sub5 redefined[^\n]+\n//s;

sub sub6 ($) { 1 }
sub sub6     { 2 }

ok 11, $warn =~ s/$NEWPROTO \Qsub main::sub6 ($) vs none\E[^\n]+\n//s;
ok 12, $warn =~ s/Subroutine sub6 redefined[^\n]+\n//s;

sub sub7 ($) { 1 }
sub sub7 ()  { 2 }

ok 13, $warn =~ s/$NEWPROTO \Qsub main::sub7 ($) vs ()\E[^\n]+\n//s;
ok 14, $warn =~ s/Subroutine sub7 redefined[^\n]+\n//s;

sub sub8 ($) { 1 }
sub sub8 ($) { 2 }

ok 15, $warn =~ s/Subroutine sub8 redefined[^\n]+\n//s;

sub sub9 ($@) { 1 }
sub sub9 ($)  { 2 }

ok 16, $warn =~ s/$NEWPROTO sub main::sub9 \(\$\Q@) vs ($)\E[^\n]+\n//s;
ok 17, $warn =~ s/Subroutine sub9 redefined[^\n]+\n//s;

BEGIN {
    local $^W = 0;
    eval qq(sub sub10 () {1} sub sub10 {1});
}

ok 18, $warn =~ s/$NEWPROTO \Qsub main::sub10 () vs none\E[^\n]+\n//s;
ok 19, $warn =~ s/Constant subroutine sub10 redefined[^\n]+\n//s;

ok 20, $warn eq '';

# If we got any errors that we were not expecting, then print them
print $warn if length $warn;