xref: /openbsd-src/gnu/usr.bin/perl/t/op/protowarn.t (revision f2da64fbbbf1b03f09f390ab01267c93dfd77c4c)
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