Commit | Line | Data |
fe13d51d |
1 | #!/usr/bin/perl |
2 | use warnings; |
3 | use strict; |
f7b649f0 |
4 | |
5 | require './test.pl'; |
6 | |
7 | plan('no_plan'); |
8 | |
fe13d51d |
9 | $|=1; |
10 | |
f7223e8e |
11 | my $make_exceptions_list = ($ARGV[0]||'') eq '--make-exceptions-list'; |
87a63fff |
12 | |
38ec24b4 |
13 | open my $diagfh, "<", "../pod/perldiag.pod" |
87a63fff |
14 | or die "Can't open ../pod/perldiag.pod: $!"; |
fe13d51d |
15 | |
16 | my %entries; |
87a63fff |
17 | while (<DATA>) { |
18 | chomp; |
19 | $entries{$_}{todo}=1; |
20 | } |
21 | |
fe13d51d |
22 | my $cur_entry; |
23 | while (<$diagfh>) { |
24 | if (m/^=item (.*)/) { |
25 | $cur_entry = $1; |
26 | } elsif (m/^\((.)(?: ([a-z]+?))?\)/ and !$entries{$cur_entry}{severity}) { |
87a63fff |
27 | # Make sure to init this here, so an actual entry in perldiag overwrites |
28 | # one in DATA. |
29 | $entries{$cur_entry}{todo} = 0; |
fe13d51d |
30 | $entries{$cur_entry}{severity} = $1; |
31 | $entries{$cur_entry}{category} = $2; |
32 | } |
33 | } |
34 | |
87a63fff |
35 | my @todo = ('..'); |
fe13d51d |
36 | while (@todo) { |
37 | my $todo = shift @todo; |
a193a2db |
38 | next if $todo ~~ ['../t', '../lib', '../ext', '../dist', '../cpan']; |
fe13d51d |
39 | # opmini.c is just a copy of op.c, so there's no need to check again. |
87a63fff |
40 | next if $todo eq '../opmini.c'; |
fe13d51d |
41 | if (-d $todo) { |
42 | push @todo, glob "$todo/*"; |
87a63fff |
43 | } elsif ($todo =~ m/\.[ch]$/) { |
fe13d51d |
44 | check_file($todo); |
45 | } |
46 | } |
47 | |
48 | sub check_file { |
49 | my ($codefn) = @_; |
50 | |
f7223e8e |
51 | print "# $codefn\n"; |
fe13d51d |
52 | |
38ec24b4 |
53 | open my $codefh, "<", $codefn |
fe13d51d |
54 | or die "Can't open $codefn: $!"; |
55 | |
56 | my $listed_as; |
57 | my $listed_as_line; |
58 | my $sub = 'top of file'; |
59 | while (<$codefh>) { |
60 | chomp; |
61 | # Getting too much here isn't a problem; we only use this to skip |
62 | # errors inside of XS modules, which should get documented in the |
63 | # docs for the module. |
64 | if (m<^([^#\s].*)> and $1 !~ m/^[{}]*$/) { |
65 | $sub = $1; |
66 | } |
67 | next if $sub =~ m/^XS/; |
68 | if (m</\* diag_listed_as: (.*) \*/>) { |
69 | $listed_as = $1; |
70 | $listed_as_line = $.+1; |
71 | } |
72 | next if /^#/; |
73 | next if /^ * /; |
74 | while (m/\bDIE\b|Perl_(croak|die|warn(er)?)/ and not m/\);$/) { |
75 | my $nextline = <$codefh>; |
76 | # Means we fell off the end of the file. Not terribly surprising; |
77 | # this code tries to merge a lot of things that aren't regular C |
78 | # code (preprocessor stuff, long comments). That's OK; we don't |
79 | # need those anyway. |
80 | last if not defined $nextline; |
81 | chomp $nextline; |
82 | $nextline =~ s/^\s+//; |
83 | # Note that we only want to do this where *both* are true. |
84 | $_ =~ s/\\$//; |
85 | if ($_ =~ m/"$/ and $nextline =~ m/^"/) { |
86 | $_ =~ s/"$//; |
87 | $nextline =~ s/^"//; |
88 | } |
89 | $_ = "$_$nextline"; |
90 | } |
91 | # This should happen *after* unwrapping, or we don't reformat the things |
92 | # in later lines. |
93 | # List from perlguts.pod "Formatted Printing of IVs, UVs, and NVs" |
94 | my %specialformats = (IVdf => 'd', |
95 | UVuf => 'd', |
96 | UVof => 'o', |
97 | UVxf => 'x', |
98 | UVXf => 'X', |
99 | NVef => 'f', |
100 | NVff => 'f', |
101 | NVgf => 'f', |
102 | SVf => 's'); |
103 | for my $from (keys %specialformats) { |
104 | s/%"\s*$from\s*"/\%$specialformats{$from}/g; |
105 | s/%"\s*$from/\%$specialformats{$from}"/g; |
106 | } |
107 | # The %"foo" thing needs to happen *before* this regex. |
108 | if (m/(?:DIE|Perl_(croak|die|warn|warner))(?:_nocontext)? \s* |
109 | \(aTHX_ \s* |
110 | (?:packWARN\d*\((.*?)\),)? \s* |
111 | "((?:\\"|[^"])*?)"/x) { |
112 | # diag($_); |
113 | # DIE is just return Perl_die |
114 | my $severity = {croak => [qw/P F/], |
115 | die => [qw/P F/], |
116 | warn => [qw/W D S/], |
117 | }->{$1||'die'}; |
118 | my @categories; |
119 | if ($2) { |
120 | @categories = map {s/^WARN_//; lc $_} split /\s*[|,]\s*/, $2; |
121 | } |
122 | my $name; |
123 | if ($listed_as and $listed_as_line == $.) { |
124 | $name = $listed_as; |
125 | } else { |
126 | $name = $3; |
127 | # The form listed in perldiag ignores most sorts of fancy printf formatting, |
128 | # or makes it more perlish. |
129 | $name =~ s/%%/\\%/g; |
130 | $name =~ s/%l[ud]/%d/g; |
131 | $name =~ s/%\.(\d+|\*)s/\%s/g; |
132 | $name =~ s/\\"/"/g; |
133 | $name =~ s/\\t/\t/g; |
87a63fff |
134 | $name =~ s/\\n/ /g; |
135 | $name =~ s/\s+$//; |
fe13d51d |
136 | } |
137 | |
87a63fff |
138 | # Extra explanatory info on an already-listed error, doesn't |
139 | # need it's own listing. |
fe13d51d |
140 | next if $name =~ m/^\t/; |
141 | |
142 | # Happens fairly often with PL_no_modify. |
143 | next if $name eq '%s'; |
144 | |
87a63fff |
145 | # Special syntax for magic comment, allows ignoring the fact |
146 | # that it isn't listed. Only use in very special circumstances, |
147 | # like this script failing to notice that the Perl_croak call is |
148 | # inside an #if 0 block. |
fe13d51d |
149 | next if $name eq 'SKIPME'; |
150 | |
87a63fff |
151 | if (exists $entries{$name}) { |
152 | if ($entries{$name}{todo}) { |
153 | TODO: { |
f7b649f0 |
154 | no warnings 'once'; |
155 | local $::TODO = 'in DATA'; |
87a63fff |
156 | fail("Presence of '$name' from $codefn line $."); |
157 | } |
fe13d51d |
158 | } else { |
87a63fff |
159 | ok("Presence of '$name' from $codefn line $."); |
fe13d51d |
160 | } |
87a63fff |
161 | # Later, should start checking that the severity is correct, too. |
162 | } elsif ($name =~ m/^panic: /) { |
163 | # Just too many panic:s, they are hard to diagnose, and there |
164 | # is a generic "panic: %s" entry. Leave these for another |
165 | # pass. |
166 | ok("Presence of '$name' from $codefn line $., covered by panic: %s entry"); |
fe13d51d |
167 | } else { |
87a63fff |
168 | if ($make_exceptions_list) { |
169 | print STDERR "$name\n"; |
170 | } else { |
171 | fail("Presence of '$name' from $codefn line $."); |
172 | } |
fe13d51d |
173 | } |
174 | |
175 | die if $name =~ /%$/; |
176 | } |
177 | } |
178 | } |
f7223e8e |
179 | # Lists all missing things as of the inaguration of this script, so we |
87a63fff |
180 | # don't have to go from "meh" to perfect all at once. |
181 | __DATA__ |
182 | Ambiguous call resolved as CORE::%s(), %s |
183 | Ambiguous use of %c resolved as operator %c |
184 | Ambiguous use of %c{%s} resolved to %c%s |
185 | Ambiguous use of %c{%s%s} resolved to %c%s%s |
186 | Ambiguous use of -%s resolved as -&%s() |
187 | Argument "%s" isn't numeric |
188 | Argument "%s" isn't numeric in %s |
189 | Assertion: marks beyond string end |
190 | Assertion: string is shorter than advertised |
191 | Attempt to clear deleted array |
192 | Attempt to free non-arena SV: 0x%x |
193 | Attempt to free non-existent shared string '%s'%s |
194 | Attempt to free temp prematurely: SV 0x%x |
195 | Attempt to free unreferenced scalar: SV 0x%x |
196 | Attempt to reload %s aborted. Compilation failed in require |
197 | av_reify called on tied array |
198 | Bad name after %s%s |
d5713896 |
199 | Bad symbol for %s |
87a63fff |
200 | bad top format reference |
201 | Bizarre copy of %s |
202 | Bizarre SvTYPE [%d] |
203 | Cannot copy to %s |
204 | Can't call method "%s" %s |
205 | Can't coerce readonly %s to string |
206 | Can't coerce readonly %s to string in %s |
207 | Can't fix broken locale name "%s" |
208 | Can't get short module name from a handle |
209 | Can't goto subroutine from an eval-block |
210 | Can't goto subroutine from an eval-string |
211 | Can't locate object method "%s" via package "%s" (perhaps you forgot to load "%s"?) |
212 | Can't modify non-existent substring |
213 | Can't open |
214 | Can't open perl script "%s": %s |
215 | Can't open %s |
216 | Can't reset \%ENV on this system |
217 | Can't return array to lvalue scalar context |
218 | Can't return a %s from lvalue subroutine |
219 | Can't return hash to lvalue scalar context |
220 | Can't spawn "%s": %s |
221 | Can't %s script `%s' with ARGV[0] being `%s' |
222 | Can't %s "%s": %s |
223 | Can't %s %s%s%s |
224 | Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found) |
225 | Can't take %s of %f |
226 | Can't use '%c' after -mname |
227 | Can't use \\%c to mean $%c in expression |
228 | Can't use when() outside a topicalizer |
229 | \\%c better written as $%c |
230 | Character(s) in '%c' format wrapped in %s |
231 | $%c is no longer supported |
232 | Cloning substitution context is unimplemented |
233 | Code missing after '/' in pack |
234 | Code missing after '/' in unpack |
235 | Compilation failed in require |
236 | Corrupted regexp opcode %d > %d |
237 | '%c' outside of string in pack |
238 | Debug leaking scalars child failed%s%s with errno %d: %s |
239 | Deep recursion on anonymous subroutine |
240 | defined(\%hash) is deprecated |
241 | Don't know how to handle magic of type \\%o |
242 | -Dp not implemented on this platform |
243 | entering effective gid failed |
244 | entering effective uid failed |
245 | Error reading "%s": %s |
246 | Exiting %s via %s |
247 | Filehandle opened only for %sput |
248 | Filehandle %s opened only for %sput |
249 | Filehandle STD%s reopened as %s only for input |
250 | YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET! FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP! |
251 | Format STDOUT redefined |
252 | Free to wrong pool %p not %p |
253 | get %s %p %p %p |
254 | glob failed (can't start child: %s) |
255 | glob failed (child exited with status %d%s) |
256 | Goto undefined subroutine |
257 | Goto undefined subroutine &%s |
258 | Hash \%%s missing the \% in argument %d of %s() |
259 | Illegal character \\%03o (carriage return) |
260 | Illegal character %sin prototype for %s : %s |
261 | Integer overflow in decimal number |
262 | Integer overflow in version %d |
263 | internal \%<num>p might conflict with future printf extensions |
264 | invalid control request: '\\%03o' |
265 | Invalid module name %s with -%c option: contains single ':' |
266 | invalid option -D%c, use -D'' to see choices |
267 | Invalid range "%c-%c" in transliteration operator |
268 | Invalid separator character %c%c%c in PerlIO layer specification %s |
269 | Invalid TOKEN object ignored |
270 | Invalid type '%c' in pack |
271 | Invalid type '%c' in %s |
272 | Invalid type '%c' in unpack |
273 | Invalid type ',' in %s |
274 | Invalid version format (alpha without decimal) |
275 | Invalid version format (misplaced _ in number) |
276 | Invalid version object |
277 | 'j' not supported on this platform |
278 | 'J' not supported on this platform |
279 | Layer does not match this perl |
280 | leaving effective gid failed |
281 | leaving effective uid failed |
282 | List form of piped open not implemented |
283 | Lost precision when decrementing %f by 1 |
284 | Lost precision when incrementing %f by 1 |
285 | %lx |
286 | Malformed UTF-16 surrogate |
287 | Malformed UTF-8 character (fatal) |
288 | '\%' may not be used in pack |
289 | Missing (suid) fd script name |
290 | More than one argument to open |
291 | More than one argument to open(,':%s') |
292 | mprotect for %p %d failed with %d |
293 | mprotect RW for %p %d failed with %d |
294 | No code specified for -%c |
295 | No directory specified for -I |
296 | No such class field "%s" |
297 | Not an XSUB reference |
298 | Not %s reference |
299 | Offset outside string |
300 | Opening dirhandle %s also as a file |
301 | Opening filehandle %s also as a directory |
302 | Operator or semicolon missing before %c%s |
303 | Overloaded dereference did not return a reference |
304 | Perl bug: predicted utf8 length not available |
305 | PERL_SIGNALS illegal: "%s" |
306 | Perl %s required (did you mean %s?)--this is only %s, stopped |
307 | Perl %s required--this is only %s, stopped |
308 | Perls since %s too modern--this is %s, stopped |
309 | Possible unintended interpolation of $\\ in regex |
310 | ptr wrong %p != %p fl=%08 |
311 | Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?) |
312 | Recursive call to Perl_load_module in PerlIO_find_layer |
313 | refcnt_dec: fd %d < 0 |
314 | refcnt_dec: fd %d: %d <= 0 |
315 | refcnt_dec: fd %d >= refcnt_size %d |
316 | refcnt_inc: fd %d < 0 |
317 | refcnt_inc: fd %d: %d <= 0 |
318 | Reversed %c= operator |
319 | Runaway prototype |
320 | %s(%.0f) failed |
321 | %s(%.0f) too large |
322 | Scalar value %s better written as $%s |
323 | %sCompilation failed in regexp |
324 | %sCompilation failed in require |
325 | set %s %p %p %p |
326 | %s free() ignored (RMAGIC, PERL_CORE) |
327 | %s has too many errors. |
328 | SIG%s handler "%s" not defined. |
329 | %s: illegal mapping '%s' |
330 | %s in %s |
331 | Size magic not implemented |
332 | %s limit (%d) exceeded |
333 | %s method "%s" overloading "%s" in package "%s" |
334 | %s number > %s non-portable |
335 | %s object version %s does not match %s%s%s%s %s |
336 | %srealloc() %signored |
337 | %s returned from lvalue subroutine in scalar context |
338 | %s%s has too many errors. |
339 | %s%s on %s %s |
340 | %s%s on %s %s %s |
341 | Starting Full Screen process with flag=%d, mytype=%d |
342 | Starting PM process with flag=%d, mytype=%d |
343 | strxfrm() gets absurd |
344 | SWASHNEW didn't return an HV ref |
345 | -T and -B not implemented on filehandles |
346 | The flock() function is not implemented on NetWare |
347 | The rewinddir() function is not implemented on NetWare |
348 | The seekdir() function is not implemented on NetWare |
349 | The stat preceding lstat() wasn't an lstat |
350 | The telldir() function is not implemented on NetWare |
351 | Too deeply nested ()-groups in %s |
352 | Too late to run CHECK block |
353 | Too late to run INIT block |
354 | Too many args on %s line of "%s" |
355 | U0 mode on a byte string |
356 | Unbalanced string table refcount: (%d) for "%s" |
357 | Undefined top format called |
358 | Unexpected constant lvalue entersub entry via type/targ %d:%d |
6f6ac1de |
359 | Unicode non-character 0x%04 |
87a63fff |
360 | Unknown PerlIO layer "scalar" |
361 | Unknown Unicode option letter '%c' |
362 | unrecognised control character '%c' |
363 | Unstable directory path, current directory changed unexpectedly |
364 | Unsupported script encoding UTF16-BE |
365 | Unsupported script encoding UTF16-LE |
366 | Unsupported script encoding UTF32-BE |
367 | Unsupported script encoding UTF32-LE |
368 | Unterminated compressed integer in unpack |
369 | Usage: CODE(0x%x)(%s) |
370 | Usage: %s(%s) |
371 | Usage: %s::%s(%s) |
372 | Usage: VMS::Filespec::unixrealpath(spec) |
373 | Usage: VMS::Filespec::vmsrealpath(spec) |
374 | Use of inherited AUTOLOAD for non-method %s::%s() is deprecated |
375 | UTF-16 surrogate 0x%04 |
376 | utf8 "\\x%02X" does not map to Unicode |
377 | Value of logical "%s" too long. Truncating to %i bytes |
378 | value of node is %d in Offset macro |
379 | Value of %s%s can be "0"; test with defined() |
380 | Variable "%c%s" is not imported |
381 | vector argument not supported with alpha versions |
382 | Wide character |
383 | Wide character in $/ |
384 | Wide character in print |
385 | Wide character in %s |
386 | Within []-length '%c' not allowed in %s |
387 | Wrong syntax (suid) fd script name "%s" |
388 | 'X' outside of string in unpack |