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