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