xref: /openbsd-src/gnu/usr.bin/perl/lib/diagnostics.t (revision 50b7afb2c2c0993b0894d4e34bf857cb13ed9c80)
1#!./perl -w
2
3BEGIN {
4    chdir '..' if -d '../pod' && -d '../t';
5    @INC = 'lib';
6    require './t/test.pl';
7    plan(24);
8}
9
10BEGIN {
11    my $w;
12    $SIG{__WARN__} = sub { $w = shift };
13    use_ok('diagnostics');
14    is $w, undef, 'no warnings when loading diagnostics.pm';
15}
16
17require base;
18
19eval {
20    'base'->import(qw(I::do::not::exist));
21};
22
23like( $@, qr/^Base class package "I::do::not::exist" is empty/,
24         'diagnostics not tripped up by "use base qw(Dont::Exist)"');
25
26open *whatever, ">", \my $warning
27    or die "Couldn't redirect STDERR to var: $!";
28my $old_stderr = *STDERR{IO};
29*STDERR = *whatever{IO};
30
31# Test for %.0f patterns in perldiag, added in 5.11.0
32warn('gmtime(nan) too large');
33like $warning, qr/\(W overflow\) You called/, '%0.f patterns';
34
35# L<foo/bar> links
36seek STDERR, 0,0;
37$warning = '';
38warn("accept() on closed socket spanner");
39like $warning, qr/"accept" in perlfunc/, 'L<foo/bar> links';
40
41# L<foo|bar/baz> links
42seek STDERR, 0,0;
43$warning = '';
44warn
45 'Lexing code attempted to stuff non-Latin-1 character into Latin-1 input';
46like $warning, qr/using lex_stuff_pvn or similar/, 'L<foo|bar/baz>';
47
48# Multiple messages with the same description
49seek STDERR, 0,0;
50$warning = '';
51warn 'Code point 0xBEE5 is not Unicode, may not be portable';
52like $warning, qr/S utf8/,
53   'Message sharing its description with the following message';
54
55# Periods at end of entries in perldiag.pod get matched correctly
56seek STDERR, 0,0;
57$warning = '';
58warn "Execution of -e aborted due to compilation errors.\n";
59like $warning, qr/The final summary message/, 'Periods at end of line';
60
61# Test for %d/%u
62seek STDERR, 0,0;
63$warning = '';
64warn "Bad arg length for us, is 4, should be 42";
65like $warning, qr/In C parlance/, '%u works';
66
67# Test for %X
68seek STDERR, 0,0;
69$warning = '';
70warn "Unicode surrogate U+C0FFEE is illegal in UTF-8";
71like $warning, qr/You had a UTF-16 surrogate/, '%X';
72
73# Test for %p
74seek STDERR, 0,0;
75$warning = '';
76warn "Slab leaked from cv fadedc0ffee";
77like $warning, qr/bookkeeping of op trees/, '%p';
78
79# Strip S<>
80seek STDERR, 0,0;
81$warning = '';
82warn "syntax error";
83like $warning, qr/cybernetic version of 20 questions/s, 'strip S<>';
84
85# Errors ending with dots
86seek STDERR, 0,0;
87$warning = '';
88warn "I had compilation errors.\n";
89like $warning, qr/final summary message/, 'dotty errors';
90
91# Multiline errors
92seek STDERR, 0,0;
93$warning = '';
94warn "Attempt to reload weapon aborted.\nCompilation failed in require";
95like $warning,
96     qr/You tried to load a file.*Perl could not compile/s,
97    'multiline errors';
98
99# Multiline entry in perldiag.pod
100seek STDERR, 0,0;
101$warning = '';
102warn "Using just the first character returned by \\N{} in character class in regex; marked by <-- HERE in m/%s/";
103like $warning,
104    qr/A charnames handler may return a sequence/s,
105    'multi-line entries in perldiag.pod match';
106
107# ; at end of entry in perldiag.pod
108seek STDERR, 0,0;
109$warning = '';
110warn "Perl folding rules are not up-to-date for 0xA; please use the perlbug utility to report; in regex; marked by <-- HERE in m/\ <-- HERE q/";
111like $warning,
112    qr/regular expression folding rules/s,
113    '; works at the end of entries in perldiag.pod';
114
115# Differences in spaces in warnings (Why not be nice and accept them?)
116seek STDERR, 0,0;
117$warning = '';
118warn "Assignment     to both a list and a scalar\n";
119like $warning,
120    qr/2nd and 3rd/s,
121    'spaces in warnings are matched lightly';
122
123# Differences in spaces in warnings with a period at the end
124seek STDERR, 0,0;
125$warning = '';
126warn "perl: warning: Setting locale failed.\n";
127like $warning,
128    qr/The whole warning/s,
129    'spaces in warnings with periods at the end are matched lightly';
130
131
132*STDERR = $old_stderr;
133
134# These tests use a panic under the hope that the description is not likely
135# to change.
136@runperl_args = (
137        switches => [ '-Ilib', '-Mdiagnostics' ],
138        stderr => 1,
139        nolib => 1, # -I../lib would go outside the build dir
140);
141$subs =
142 "sub foo{bar()}sub bar{baz()}sub baz{die q _panic: gremlins_}foo()";
143is runperl(@runperl_args, prog => $subs),
144   << 'EOT', 'internal error with backtrace';
145panic: gremlins at -e line 1 (#1)
146    (P) An internal error.
147
148Uncaught exception from user code:
149	panic: gremlins at -e line 1.
150	main::baz() called at -e line 1
151	main::bar() called at -e line 1
152	main::foo() called at -e line 1
153EOT
154is runperl(@runperl_args, prog => $subs =~ s/panic\K/k/r),
155   << 'EOU', 'user error with backtrace';
156Uncaught exception from user code:
157	panick: gremlins at -e line 1.
158	main::baz() called at -e line 1
159	main::bar() called at -e line 1
160	main::foo() called at -e line 1
161EOU
162is runperl(@runperl_args, prog => 'die q _panic: gremlins_'),
163   << 'EOV', 'no backtrace from top-level internal error';
164panic: gremlins at -e line 1 (#1)
165    (P) An internal error.
166
167Uncaught exception from user code:
168	panic: gremlins at -e line 1.
169EOV
170is runperl(@runperl_args, prog => 'die q _panick: gremlins_'),
171   << 'EOW', 'no backtrace from top-level user error';
172Uncaught exception from user code:
173	panick: gremlins at -e line 1.
174EOW
175like runperl(
176      @runperl_args,
177      prog => $subs =~
178         s[q _panic: gremlins_]
179          [qq _Attempt to reload foo aborted.\\nCompilation failed in require_]r,
180     ),
181     qr/Uncaught exception from user code:
182	Attempt to reload foo aborted\.
183	Compilation failed in require at -e line \d+\.
184	main::baz\(\) called at -e line \d+
185	main::bar\(\) called at -e line \d+
186	main::foo\(\) called at -e line \d+
187/,  'backtrace from multiline error';
188is runperl(@runperl_args, prog => 'BEGIN { die q _panic: gremlins_ }'),
189   << 'EOX', 'BEGIN{die} does not suppress diagnostics';
190panic: gremlins at -e line 1.
191BEGIN failed--compilation aborted at -e line 1 (#1)
192    (P) An internal error.
193
194Uncaught exception from user code:
195	panic: gremlins at -e line 1.
196	BEGIN failed--compilation aborted at -e line 1.
197EOX
198