1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = qw(. ../lib); 6} 7 8use strict; 9use warnings; 10 11BEGIN { 12 require 'test.pl'; 13 plan( tests => 12 ); 14} 15 16use vars qw{ @warnings $sub $warn }; 17 18BEGIN { 19 $warn = 'Illegal character in prototype'; 20} 21 22sub one_warning_ok { 23 cmp_ok(scalar(@warnings), '==', 1, 'One warning'); 24 cmp_ok(substr($warnings[0],0,length($warn)),'eq',$warn,'warning message'); 25 @warnings = (); 26} 27 28sub no_warnings_ok { 29 cmp_ok(scalar(@warnings), '==', 0, 'No warnings'); 30 @warnings = (); 31} 32 33BEGIN { 34 $SIG{'__WARN__'} = sub { push @warnings, @_ }; 35 $| = 1; 36} 37 38BEGIN { @warnings = () } 39 40$sub = sub (x) { }; 41 42BEGIN { 43 one_warning_ok; 44} 45 46{ 47 no warnings 'syntax'; 48 $sub = sub (x) { }; 49} 50 51BEGIN { 52 no_warnings_ok; 53} 54 55{ 56 no warnings 'illegalproto'; 57 $sub = sub (x) { }; 58} 59 60BEGIN { 61 no_warnings_ok; 62} 63 64{ 65 no warnings 'syntax'; 66 use warnings 'illegalproto'; 67 $sub = sub (x) { }; 68} 69 70BEGIN { 71 one_warning_ok; 72} 73 74BEGIN { 75 $warn = q{Prototype after '@' for}; 76} 77 78$sub = sub (@$) { }; 79 80BEGIN { 81 one_warning_ok; 82} 83 84{ 85 no warnings 'syntax'; 86 $sub = sub (@$) { }; 87} 88 89BEGIN { 90 no_warnings_ok; 91} 92 93{ 94 no warnings 'illegalproto'; 95 $sub = sub (@$) { }; 96} 97 98BEGIN { 99 no_warnings_ok; 100} 101 102{ 103 no warnings 'syntax'; 104 use warnings 'illegalproto'; 105 $sub = sub (@$) { }; 106} 107 108BEGIN { 109 one_warning_ok; 110} 111