Commit | Line | Data |
---|---|---|
fe13d51d | 1 | #!/usr/bin/perl |
f7b649f0 | 2 | |
99a4af00 | 3 | BEGIN { |
0bfe7176 | 4 | @INC = '..' if -f '../TestInit.pm'; |
99a4af00 | 5 | } |
0bfe7176 | 6 | use TestInit qw(T); # T is chdir to the top level |
f7b649f0 | 7 | |
0bfe7176 NC |
8 | use warnings; |
9 | use strict; | |
3a73a075 | 10 | use Config; |
f7b649f0 | 11 | |
0bfe7176 | 12 | require 't/test.pl'; |
3a73a075 BF |
13 | |
14 | if ( $Config{usecrosscompile} ) { | |
15 | skip_all( "Not all files are available during cross-compilation" ); | |
16 | } | |
17 | ||
0bfe7176 | 18 | plan('no_plan'); |
fe13d51d | 19 | |
1eb3f3ad JM |
20 | # --make-exceptions-list outputs the list of strings that don't have |
21 | # perldiag.pod entries to STDERR without TAP formatting, so they can | |
22 | # easily be put in the __DATA__ section of this file. This was done | |
23 | # initially so as to not create new test failures upon the initial | |
24 | # creation of this test file. You probably shouldn't do it again. | |
25 | # Just add the documentation instead. | |
0db6997d FC |
26 | my $make_exceptions_list = ($ARGV[0]||'') eq '--make-exceptions-list' |
27 | and shift; | |
87a63fff | 28 | |
0bfe7176 | 29 | require 'regen/embed_lib.pl'; |
45f1c7ba | 30 | |
9c9407cf | 31 | # Look for functions that look like they could be diagnostic ones. |
1b1ee2ef | 32 | my @functions; |
9c9407cf NC |
33 | foreach (@{(setup_embed())[0]}) { |
34 | next if @$_ < 2; | |
dc996669 | 35 | next unless $_->[2] =~ /warn|(?<!ov)err|(\b|_)die|croak/i; |
1b1ee2ef KW |
36 | # The flag p means that this function may have a 'Perl_' prefix |
37 | # The flag s means that this function may have a 'S_' prefix | |
9c9407cf NC |
38 | push @functions, $_->[2]; |
39 | push @functions, 'Perl_' . $_->[2] if $_->[0] =~ /p/; | |
40 | push @functions, 'S_' . $_->[2] if $_->[0] =~ /s/; | |
41 | }; | |
1bac45e4 | 42 | push @functions, 'Perl_mess'; |
1b1ee2ef | 43 | |
946095af | 44 | my $regcomp_fail_re = '\b(?:(?:Simple_)?v)?FAIL[2-4]?(?:utf8f)?\b'; |
20c98eb0 FC |
45 | my $regcomp_re = |
46 | "(?<routine>ckWARN(?:\\d+)?reg\\w*|vWARN\\d+|$regcomp_fail_re)"; | |
47 | my $function_re = join '|', @functions; | |
b26f9440 | 48 | my $source_msg_re = |
20c98eb0 | 49 | "(?<routine>\\bDIE\\b|$function_re)"; |
de53a0ea | 50 | my $text_re = '"(?<text>(?:\\\\"|[^"]|"\s*[A-Z_]+\s*")*)"'; |
78cd53af | 51 | my $source_msg_call_re = qr/$source_msg_re(?:_nocontext)? \s* |
d19547b5 | 52 | \((?:aTHX_)? \s* |
78cd53af DM |
53 | (?:packWARN\d*\((?<category>.*?)\),)? \s* |
54 | $text_re /x; | |
55 | my $bad_version_re = qr{BADVERSION\([^"]*$text_re}; | |
b26f9440 | 56 | $regcomp_fail_re = qr/$regcomp_fail_re\([^"]*$text_re/; |
b33c0c71 | 57 | my $regcomp_call_re = qr/$regcomp_re.*?$text_re/; |
fe13d51d JM |
58 | |
59 | my %entries; | |
1b1ee2ef KW |
60 | |
61 | # Get the ignores that are compiled into this file | |
62f5f54d | 62 | my $reading_categorical_exceptions; |
87a63fff JM |
63 | while (<DATA>) { |
64 | chomp; | |
beb1a06e FC |
65 | $entries{$_}{todo} = 1; |
66 | $reading_categorical_exceptions and $entries{$_}{cattodo}=1; | |
62f5f54d | 67 | /__CATEGORIES__/ and ++$reading_categorical_exceptions; |
87a63fff JM |
68 | } |
69 | ||
808910a9 | 70 | my $pod = "pod/perldiag.pod"; |
fe13d51d | 71 | my $cur_entry; |
808910a9 KW |
72 | open my $diagfh, "<", $pod |
73 | or die "Can't open $pod: $!"; | |
1b1ee2ef | 74 | |
64fbf0dd | 75 | my $category_re = qr/ [a-z0-9_:]+?/; # Note: requires an initial space |
4cf67031 KW |
76 | my $severity_re = qr/ . (?: \| . )* /x; # A severity is a single char, but can |
77 | # be of the form 'S|P|W' | |
62f5f54d | 78 | my @same_descr; |
fe13d51d JM |
79 | while (<$diagfh>) { |
80 | if (m/^=item (.*)/) { | |
6fbc9859 MH |
81 | $cur_entry = $1; |
82 | ||
83 | # Allow multi-line headers | |
84 | while (<$diagfh>) { | |
85 | if (/^\s*$/) { | |
86 | last; | |
87 | } | |
88 | ||
f77147f3 | 89 | $cur_entry =~ s/ ?\z/ $_/; |
6fbc9859 MH |
90 | } |
91 | ||
92 | $cur_entry =~ s/\n/ /gs; # Fix multi-line headers if they have \n's | |
93 | $cur_entry =~ s/\s+\z//; | |
26edd312 KW |
94 | $cur_entry =~ s/E<lt>/</g; |
95 | $cur_entry =~ s/E<gt>/>/g; | |
96 | $cur_entry =~ s,E<sol>,/,g; | |
e0e4a6e3 | 97 | $cur_entry =~ s/[BCIFS](?:<<< (.*?) >>>|<< (.*?) >>|<(.*?)>)/$+/g; |
4cf67031 | 98 | |
beb1a06e FC |
99 | if (exists $entries{$cur_entry} && $entries{$cur_entry}{todo} |
100 | && !$entries{$cur_entry}{cattodo}) { | |
b61b433c KW |
101 | TODO: { |
102 | local $::TODO = "Remove the TODO entry \"$cur_entry\" from DATA as it is already in $pod near line $."; | |
103 | ok($cur_entry); | |
104 | } | |
9c3e8e01 | 105 | } |
4cf67031 KW |
106 | # Make sure to init this here, so an actual entry in perldiag |
107 | # overwrites one in DATA. | |
87a63fff | 108 | $entries{$cur_entry}{todo} = 0; |
4cf67031 | 109 | $entries{$cur_entry}{line_number} = $.; |
4cf67031 KW |
110 | } |
111 | ||
112 | next if ! defined $cur_entry; | |
113 | ||
114 | if (! $entries{$cur_entry}{severity}) { | |
115 | if (/^ \( ( $severity_re ) | |
116 | ||
117 | # Can have multiple categories separated by commas | |
62f5f54d | 118 | ( $category_re (?: , $category_re)* )? \) /x) |
4cf67031 KW |
119 | { |
120 | $entries{$cur_entry}{severity} = $1; | |
62f5f54d FC |
121 | $entries{$cur_entry}{category} = |
122 | $2 && join ", ", sort split " ", $2 =~ y/,//dr; | |
123 | ||
124 | # Record it also for other messages sharing the same description | |
125 | @$_{qw<severity category>} = | |
126 | @{$entries{$cur_entry}}{qw<severity category>} | |
127 | for @same_descr; | |
4cf67031 KW |
128 | } |
129 | elsif (! $entries{$cur_entry}{first_line} && $_ =~ /\S/) { | |
130 | ||
131 | # Keep track of first line of text if doesn't contain a severity, so | |
132 | # that can later examine it to determine if that is ok or not | |
133 | $entries{$cur_entry}{first_line} = $_; | |
134 | } | |
62f5f54d FC |
135 | if (/\S/) { |
136 | @same_descr = (); | |
137 | } | |
138 | else { | |
139 | push @same_descr, $entries{$cur_entry}; | |
140 | } | |
fe13d51d JM |
141 | } |
142 | } | |
143 | ||
4cf67031 KW |
144 | foreach my $cur_entry ( keys %entries) { |
145 | next if $entries{$cur_entry}{todo}; # If in this file, won't have a severity | |
146 | if (! exists $entries{$cur_entry}{severity} | |
147 | ||
148 | # If there is no first line, it was two =items in a row, so the | |
149 | # second one is the one with with text, not this one. | |
150 | && exists $entries{$cur_entry}{first_line} | |
151 | ||
152 | # If the first line refers to another message, no need for severity | |
153 | && $entries{$cur_entry}{first_line} !~ /^See/) | |
154 | { | |
155 | fail($cur_entry); | |
156 | diag( | |
157 | " $pod entry at line $entries{$cur_entry}{line_number}\n" | |
158 | . " \"$cur_entry\"\n" | |
159 | . " is missing a severity and/or category" | |
160 | ); | |
161 | } | |
162 | } | |
163 | ||
78cd53af DM |
164 | # List from perlguts.pod "Formatted Printing of IVs, UVs, and NVs" |
165 | # Convert from internal formats to ones that the readers will be familiar | |
166 | # with, while removing any format modifiers, such as precision, the | |
167 | # presence of which would just confuse the pod's explanation | |
168 | my %specialformats = (IVdf => 'd', | |
169 | UVuf => 'd', | |
170 | UVof => 'o', | |
171 | UVxf => 'x', | |
172 | UVXf => 'X', | |
173 | NVef => 'f', | |
174 | NVff => 'f', | |
175 | NVgf => 'f', | |
b8fa5213 | 176 | HEKf256=>'s', |
fa871b03 | 177 | HEKf => 's', |
b17a0679 | 178 | UTF8f=> 's', |
f0eec8b8 FC |
179 | SVf256=>'s', |
180 | SVf32=> 's', | |
ea7cbc5a FC |
181 | SVf => 's', |
182 | PNf => 's'); | |
78cd53af DM |
183 | my $format_modifiers = qr/ [#0\ +-]* # optional flags |
184 | (?: [1-9][0-9]* | \* )? # optional field width | |
185 | (?: \. \d* )? # optional precision | |
186 | (?: h|l )? # optional length modifier | |
187 | /x; | |
188 | ||
f0eec8b8 FC |
189 | my $specialformats = |
190 | join '|', sort { length $b cmp length $a } keys %specialformats; | |
78cd53af DM |
191 | my $specialformats_re = qr/%$format_modifiers"\s*($specialformats)(\s*")?/; |
192 | ||
0db6997d FC |
193 | if (@ARGV) { |
194 | check_file($_) for @ARGV; | |
195 | exit; | |
196 | } | |
e166f153 NC |
197 | open my $fh, '<', 'MANIFEST' or die "Can't open MANIFEST: $!"; |
198 | while (my $file = <$fh>) { | |
e166f153 NC |
199 | chomp $file; |
200 | $file =~ s/\s+.*//; | |
cd40cd58 NC |
201 | next unless $file =~ /\.(?:c|cpp|h|xs|y)\z/ or $file =~ /^perly\./; |
202 | # OS/2 extensions have never been migrated to ext/, hence the special case: | |
c67aee7a | 203 | next if $file =~ m!\A(?:ext|dist|cpan|lib|t|os2/OS2)/! |
cd40cd58 | 204 | && $file !~ m!\Aext/DynaLoader/!; |
e166f153 | 205 | check_file($file); |
fe13d51d | 206 | } |
e166f153 | 207 | close $fh or die $!; |
fe13d51d | 208 | |
abd65dc0 DG |
209 | # Standardize messages with variants into the form that appears |
210 | # in perldiag.pod -- useful for things without a diag_listed_as annotation | |
211 | sub standardize { | |
212 | my ($name) = @_; | |
213 | ||
214 | if ( $name =~ m/^(Invalid strict version format) \([^\)]*\)/ ) { | |
215 | $name = "$1 (\%s)"; | |
216 | } | |
217 | elsif ( $name =~ m/^(Invalid version format) \([^\)]*\)/ ) { | |
218 | $name = "$1 (\%s)"; | |
219 | } | |
220 | elsif ($name =~ m/^panic: /) { | |
221 | $name = "panic: \%s"; | |
222 | } | |
223 | ||
224 | return $name; | |
225 | } | |
226 | ||
fe13d51d JM |
227 | sub check_file { |
228 | my ($codefn) = @_; | |
229 | ||
abd65dc0 | 230 | print "# Checking $codefn\n"; |
fe13d51d | 231 | |
38ec24b4 | 232 | open my $codefh, "<", $codefn |
fe13d51d JM |
233 | or die "Can't open $codefn: $!"; |
234 | ||
235 | my $listed_as; | |
236 | my $listed_as_line; | |
237 | my $sub = 'top of file'; | |
238 | while (<$codefh>) { | |
239 | chomp; | |
240 | # Getting too much here isn't a problem; we only use this to skip | |
241 | # errors inside of XS modules, which should get documented in the | |
242 | # docs for the module. | |
78cd53af DM |
243 | if (m<^[^#\s]> and $_ !~ m/^[{}]*$/) { |
244 | $sub = $_; | |
fe13d51d JM |
245 | } |
246 | next if $sub =~ m/^XS/; | |
4e85e1b4 | 247 | if (m</\*\s*diag_listed_as: (.*?)\s*\*/>) { |
fe13d51d JM |
248 | $listed_as = $1; |
249 | $listed_as_line = $.+1; | |
250 | } | |
6ccbd5ff FC |
251 | elsif (m</\*\s*diag_listed_as: (.*?)\s*\z>) { |
252 | $listed_as = $1; | |
253 | my $finished; | |
254 | while (<$codefh>) { | |
255 | if (m<\*/>) { | |
256 | $listed_as .= $` =~ s/^\s*/ /r =~ s/\s+\z//r; | |
257 | $listed_as_line = $.+1; | |
258 | $finished = 1; | |
259 | last; | |
260 | } | |
261 | else { | |
262 | $listed_as .= s/^\s*/ /r =~ s/\s+\z//r; | |
263 | } | |
264 | } | |
265 | if (!$finished) { $listed_as = undef } | |
266 | } | |
fe13d51d | 267 | next if /^#/; |
1b1ee2ef | 268 | |
c4ea5f2e | 269 | my $multiline = 0; |
1b1ee2ef | 270 | # Loop to accumulate the message text all on one line. |
56e46aaa | 271 | if (m/(?!^)\b(?:$source_msg_re(?:_nocontext)?|$regcomp_re)\s*\(/) { |
605eee60 | 272 | while (not m/\);\s*$/) { |
78cd53af DM |
273 | my $nextline = <$codefh>; |
274 | # Means we fell off the end of the file. Not terribly surprising; | |
275 | # this code tries to merge a lot of things that aren't regular C | |
276 | # code (preprocessor stuff, long comments). That's OK; we don't | |
277 | # need those anyway. | |
278 | last if not defined $nextline; | |
279 | chomp $nextline; | |
280 | $nextline =~ s/^\s+//; | |
281 | $_ =~ s/\\$//; | |
282 | # Note that we only want to do this where *both* are true. | |
45c76a8e FC |
283 | if ($_ =~ m/"\s*$/ and $nextline =~ m/^"/) { |
284 | $_ =~ s/"\s*$//; | |
78cd53af DM |
285 | $nextline =~ s/^"//; |
286 | } | |
287 | $_ .= $nextline; | |
288 | ++$multiline; | |
fe13d51d | 289 | } |
fe13d51d JM |
290 | } |
291 | # This should happen *after* unwrapping, or we don't reformat the things | |
292 | # in later lines. | |
78cd53af DM |
293 | |
294 | s/$specialformats_re/"%$specialformats{$1}" . (defined $2 ? '' : '"')/ge; | |
78d0fecf KW |
295 | |
296 | # Remove any remaining format modifiers, but not in %% | |
297 | s/ (?<!%) % $format_modifiers ( [dioxXucsfeEgGp] ) /%$1/xg; | |
298 | ||
fe13d51d | 299 | # The %"foo" thing needs to happen *before* this regex. |
1b1ee2ef KW |
300 | # diag($_); |
301 | # DIE is just return Perl_die | |
b33c0c71 | 302 | my ($name, $category, $routine); |
b78a1974 | 303 | if (/\b$source_msg_call_re/) { |
b33c0c71 | 304 | ($name, $category, $routine) = ($+{'text'}, $+{'category'}, $+{'routine'}); |
62f5f54d FC |
305 | # Sometimes the regexp will pick up too much for the category |
306 | # e.g., WARN_UNINITIALIZED), PL_warn_uninit_sv ... up to the next ) | |
307 | $category && $category =~ s/\).*//s; | |
85f3efe0 FC |
308 | if (/win32_croak_not_implemented\(/) { |
309 | $name .= " not implemented!" | |
310 | } | |
78cd53af DM |
311 | } |
312 | elsif (/$bad_version_re/) { | |
313 | ($name, $category) = ($+{'text'}, undef); | |
314 | } | |
b26f9440 FC |
315 | elsif (/$regcomp_fail_re/) { |
316 | # FAIL("foo") -> "foo in regex m/%s/" | |
317 | # vFAIL("foo") -> "foo in regex; marked by <-- HERE in m/%s/" | |
318 | ($name, $category) = ($+{'text'}, undef); | |
319 | $name .= | |
320 | " in regex" . ("; marked by <-- HERE in" x /vFAIL/) . " m/%s/"; | |
321 | } | |
b33c0c71 MH |
322 | elsif (/$regcomp_call_re/) { |
323 | # vWARN/ckWARNreg("foo") -> "foo in regex; marked by <-- HERE in m/%s/ | |
324 | ($name, $category, $routine) = ($+{'text'}, undef, $+{'routine'}); | |
325 | $name .= " in regex; marked by <-- HERE in m/%s/"; | |
326 | $category = 'WARN_REGEXP'; | |
327 | if ($routine =~ /dep/) { | |
328 | $category .= ',WARN_DEPRECATED'; | |
329 | } | |
330 | } | |
78cd53af DM |
331 | else { |
332 | next; | |
333 | } | |
334 | ||
3cfe9c80 FC |
335 | # Try to guess what the severity should be. In the case of |
336 | # Perl_ck_warner and other _ck_ functions, we can tell whether it is | |
337 | # a severe/default warning or no by the _d suffix. In the case of | |
338 | # other warn functions we cannot tell, because Perl_warner may be pre- | |
339 | # ceded by if(ckWARN) or if(ckWARN_d). | |
b33c0c71 MH |
340 | my $severity = !$routine ? '[PFX]' |
341 | : $routine =~ /warn.*_d\z/ ? '[DS]' | |
3cfe9c80 | 342 | : $routine =~ /ck_warn/ ? 'W' |
ff9c1ae8 FC |
343 | : $routine =~ /warner/ ? '[WDS]' |
344 | : $routine =~ /warn/ ? 'S' | |
3cfe9c80 | 345 | : $routine =~ /ckWARN.*dep/ ? 'D' |
0008e927 | 346 | : $routine =~ /ckWARN\d*reg_d/? 'S' |
3cfe9c80 | 347 | : $routine =~ /ckWARN\d*reg/ ? 'W' |
b33c0c71 MH |
348 | : $routine =~ /vWARN\d/ ? '[WDS]' |
349 | : '[PFX]'; | |
62f5f54d | 350 | my $categories; |
49a5993e | 351 | if (defined $category) { |
64fbf0dd | 352 | $category =~ s/__/::/g; |
62f5f54d FC |
353 | $categories = |
354 | join ", ", | |
355 | sort map {s/^WARN_//; lc $_} split /\s*[|,]\s*/, $category; | |
1b1ee2ef | 356 | } |
c4ea5f2e | 357 | if ($listed_as and $listed_as_line == $. - $multiline) { |
c0a76f06 | 358 | $name = $listed_as; |
1b1ee2ef | 359 | } else { |
c0a76f06 DM |
360 | # The form listed in perldiag ignores most sorts of fancy printf |
361 | # formatting, or makes it more perlish. | |
4111bb7b | 362 | $name =~ s/%%/%/g; |
c0a76f06 DM |
363 | $name =~ s/%l[ud]/%d/g; |
364 | $name =~ s/%\.(\d+|\*)s/\%s/g; | |
ca53083a | 365 | $name =~ s/(?:%s){2,}/%s/g; |
de78ba8e | 366 | $name =~ s/(\\")|("\s*[A-Z_]+\s*")/$1 ? '"' : '%s'/egg; |
c0a76f06 | 367 | $name =~ s/\\t/\t/g; |
366fc280 | 368 | $name =~ s/\\n/\n/g; |
c0a76f06 DM |
369 | $name =~ s/\s+$//; |
370 | $name =~ s/(\\)\\/$1/g; | |
371 | } | |
fe13d51d | 372 | |
c0a76f06 DM |
373 | # Extra explanatory info on an already-listed error, doesn't |
374 | # need it's own listing. | |
375 | next if $name =~ m/^\t/; | |
fe13d51d | 376 | |
c0a76f06 DM |
377 | # Happens fairly often with PL_no_modify. |
378 | next if $name eq '%s'; | |
fe13d51d | 379 | |
c0a76f06 DM |
380 | # Special syntax for magic comment, allows ignoring the fact |
381 | # that it isn't listed. Only use in very special circumstances, | |
382 | # like this script failing to notice that the Perl_croak call is | |
383 | # inside an #if 0 block. | |
384 | next if $name eq 'SKIPME'; | |
fe13d51d | 385 | |
ff20b672 YO |
386 | next if $name=~/\[TESTING\]/; # ignore these as they are works in progress |
387 | ||
62f5f54d | 388 | check_message(standardize($name),$codefn,$severity,$categories); |
366fc280 FC |
389 | } |
390 | } | |
391 | ||
392 | sub check_message { | |
62f5f54d | 393 | my($name,$codefn,$severity,$categories,$partial) = @_; |
366fc280 FC |
394 | my $key = $name =~ y/\n/ /r; |
395 | my $ret; | |
2c86d456 | 396 | |
b33c0c71 MH |
397 | # Try to reduce printf() formats to simplest forms |
398 | # Really this should be matching %s, etc like diagnostics.pm does | |
399 | ||
400 | # Kill flags | |
401 | $key =~ s/%[#0\-+]/%/g; | |
402 | ||
403 | # Kill width | |
404 | $key =~ s/\%(\d+|\*)/%/g; | |
405 | ||
406 | # Kill precision | |
407 | $key =~ s/\%\.(\d+|\*)/%/g; | |
408 | ||
beb1a06e FC |
409 | if (exists $entries{$key} and |
410 | # todo + cattodo means it is not found and it is not in the | |
411 | # regular todo list, either | |
412 | !$entries{$key}{todo} || !$entries{$key}{cattodo}) { | |
366fc280 FC |
413 | $ret = 1; |
414 | if ( $entries{$key}{seen}++ ) { | |
c0a76f06 | 415 | # no need to repeat entries we've tested |
207e3571 | 416 | } elsif ($entries{$key}{todo}) { |
87a63fff | 417 | TODO: { |
c0a76f06 DM |
418 | no warnings 'once'; |
419 | local $::TODO = 'in DATA'; | |
420 | # There is no listing, but it is in the list of exceptions. TODO FAIL. | |
207e3571 | 421 | fail($key); |
c0a76f06 DM |
422 | diag( |
423 | " Message '$name'\n from $codefn line $. is not listed in $pod\n". | |
424 | " (but it wasn't documented in 5.10 either, so marking it TODO)." | |
425 | ); | |
87a63fff | 426 | } |
c0a76f06 DM |
427 | } else { |
428 | # We found an actual valid entry in perldiag.pod for this error. | |
b8d24c3d | 429 | pass($key); |
62f5f54d | 430 | |
4a32881b NC |
431 | return $ret |
432 | if $entries{$key}{cattodo}; | |
433 | ||
62f5f54d FC |
434 | # Now check the category and severity |
435 | ||
436 | # Cache our severity qr thingies | |
4a32881b | 437 | use feature 'state'; |
62f5f54d FC |
438 | state %qrs; |
439 | my $qr = $qrs{$severity} ||= qr/$severity/; | |
440 | ||
4a32881b | 441 | like($entries{$key}{severity}, $qr, |
3cfe9c80 FC |
442 | $severity =~ /\[/ |
443 | ? "severity is one of $severity for $key" | |
4a32881b | 444 | : "severity is $severity for $key"); |
6fbc9859 | 445 | |
4a32881b | 446 | is($entries{$key}{category}, $categories, |
62f5f54d | 447 | ($categories ? "categories are [$categories]" : "no category") |
4a32881b | 448 | . " for $key"); |
fe13d51d | 449 | } |
366fc280 FC |
450 | } elsif ($partial) { |
451 | # noop | |
c0a76f06 | 452 | } else { |
366fc280 FC |
453 | my $ok; |
454 | if ($name =~ /\n/) { | |
455 | $ok = 1; | |
62f5f54d FC |
456 | check_message($_,$codefn,$severity,$categories,1) or $ok = 0, last |
457 | for split /\n/, $name; | |
366fc280 FC |
458 | } |
459 | if ($ok) { | |
460 | # noop | |
461 | } elsif ($make_exceptions_list) { | |
c0a76f06 DM |
462 | # We're making an updated version of the exception list, to |
463 | # stick in the __DATA__ section. I honestly can't think of | |
464 | # a situation where this is the right thing to do, but I'm | |
465 | # leaving it here, just in case one of my descendents thinks | |
466 | # it's a good idea. | |
366fc280 | 467 | print STDERR "$key\n"; |
c0a76f06 DM |
468 | } else { |
469 | # No listing found, and no excuse either. | |
470 | # Find the correct place in perldiag.pod, and add a stanza beginning =item $name. | |
471 | fail($name); | |
472 | diag(" Message '$name'\n from $codefn line $. is not listed in $pod"); | |
473 | } | |
474 | # seen it, so only fail once for this message | |
475 | $entries{$name}{seen}++; | |
476 | } | |
fe13d51d | 477 | |
c0a76f06 | 478 | die if $name =~ /%$/; |
366fc280 | 479 | return $ret; |
fe13d51d | 480 | } |
c0a76f06 | 481 | |
93f09d7b | 482 | # Lists all missing things as of the inauguration of this script, so we |
87a63fff | 483 | # don't have to go from "meh" to perfect all at once. |
b0227916 JM |
484 | # |
485 | # PLEASE DO NOT ADD TO THIS LIST. Instead, write an entry in | |
675fa9ff FC |
486 | # pod/perldiag.pod for your new (warning|error). Nevertheless, |
487 | # listing exceptions here when this script is not smart enough | |
488 | # to recognize the messages is not so bad, as long as there are | |
489 | # entries in perldiag. | |
fed3ba5d | 490 | |
62f5f54d FC |
491 | # Entries after __CATEGORIES__ are those that are in perldiag but fail the |
492 | # severity/category test. | |
493 | ||
fed3ba5d NC |
494 | # Also FIXME this test, as the first entry in TODO *is* covered by the |
495 | # description: Malformed UTF-8 character (%s) | |
87a63fff | 496 | __DATA__ |
78d0fecf | 497 | Malformed UTF-8 character (unexpected non-continuation byte 0x%x, immediately after start byte 0x%x) |
fed3ba5d | 498 | |
5f2c6f7e | 499 | Cannot apply "%s" in non-PerlIO perl |
f36743d5 | 500 | Cannot set timer |
043fb3eb | 501 | Can't find DLL name for the module `%s' by the handle %d, rc=%u=%x |
5f2c6f7e | 502 | Can't find string terminator %c%s%c anywhere before EOF |
87a63fff JM |
503 | Can't fix broken locale name "%s" |
504 | Can't get short module name from a handle | |
043fb3eb | 505 | Can't load DLL `%s', possible problematic module `%s' |
c8028aa6 | 506 | Can't locate %s: %s |
5f2c6f7e | 507 | Can't pipe "%s": %s |
043fb3eb | 508 | Can't set type on DOS |
5f2c6f7e | 509 | Can't spawn: %s |
87a63fff JM |
510 | Can't spawn "%s": %s |
511 | Can't %s script `%s' with ARGV[0] being `%s' | |
512 | Can't %s "%s": %s | |
87a63fff | 513 | Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found) |
973a7615 | 514 | Can't use string ("%s"%s) as a subroutine ref while "strict refs" in use |
87a63fff | 515 | Character(s) in '%c' format wrapped in %s |
5f2c6f7e FC |
516 | chown not implemented! |
517 | clear %s | |
87a63fff JM |
518 | Code missing after '/' in pack |
519 | Code missing after '/' in unpack | |
f36743d5 FC |
520 | Could not find version 1.1 of winsock dll |
521 | Could not find version 2.0 of winsock dll | |
87a63fff | 522 | '%c' outside of string in pack |
ca53083a | 523 | Debug leaking scalars child failed%s with errno %d: %s |
043fb3eb FC |
524 | detach of a thread which could not start |
525 | detach on an already detached thread | |
526 | detach on a thread with a waiter | |
5f2c6f7e | 527 | '/' does not take a repeat count in %s |
87a63fff | 528 | -Dp not implemented on this platform |
043fb3eb | 529 | Empty array reference given to mod2fname |
f36743d5 FC |
530 | endhostent not implemented! |
531 | endnetent not implemented! | |
532 | endprotoent not implemented! | |
533 | endservent not implemented! | |
31b4070e | 534 | Error loading module '%s': %s |
87a63fff | 535 | Error reading "%s": %s |
5f2c6f7e FC |
536 | execl not implemented! |
537 | EVAL without pos change exceeded limit in regex | |
87a63fff JM |
538 | Filehandle opened only for %sput |
539 | Filehandle %s opened only for %sput | |
540 | Filehandle STD%s reopened as %s only for input | |
043fb3eb | 541 | file_type not implemented on DOS |
5f2c6f7e | 542 | filter_del can only delete in reverse order (currently) |
91c1e9d9 | 543 | fork() not available |
482291d6 | 544 | fork() not implemented! |
87a63fff | 545 | 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! |
5f2c6f7e | 546 | free %s |
f36743d5 | 547 | Free to wrong pool %p not %p |
c80bcca7 FC |
548 | Function "endnetent" not implemented in this version of perl. |
549 | Function "endprotoent" not implemented in this version of perl. | |
550 | Function "endservent" not implemented in this version of perl. | |
551 | Function "getnetbyaddr" not implemented in this version of perl. | |
552 | Function "getnetbyname" not implemented in this version of perl. | |
553 | Function "getnetent" not implemented in this version of perl. | |
554 | Function "getprotobyname" not implemented in this version of perl. | |
555 | Function "getprotobynumber" not implemented in this version of perl. | |
556 | Function "getprotoent" not implemented in this version of perl. | |
557 | Function "getservbyport" not implemented in this version of perl. | |
558 | Function "getservent" not implemented in this version of perl. | |
559 | Function "getsockopt" not implemented in this version of perl. | |
560 | Function "recvmsg" not implemented in this version of perl. | |
561 | Function "sendmsg" not implemented in this version of perl. | |
562 | Function "sethostent" not implemented in this version of perl. | |
563 | Function "setnetent" not implemented in this version of perl. | |
564 | Function "setprotoent" not implemented in this version of perl. | |
565 | Function "setservent" not implemented in this version of perl. | |
566 | Function "setsockopt" not implemented in this version of perl. | |
567 | Function "tcdrain" not implemented in this version of perl. | |
568 | Function "tcflow" not implemented in this version of perl. | |
569 | Function "tcflush" not implemented in this version of perl. | |
570 | Function "tcsendbreak" not implemented in this version of perl. | |
87a63fff | 571 | get %s %p %p %p |
482291d6 | 572 | gethostent not implemented! |
f36743d5 FC |
573 | getnetbyaddr not implemented! |
574 | getnetbyname not implemented! | |
575 | getnetent not implemented! | |
576 | getprotoent not implemented! | |
5f2c6f7e | 577 | getpwnam returned invalid UIC %o for user "%s" |
f36743d5 | 578 | getservent not implemented! |
87a63fff JM |
579 | glob failed (can't start child: %s) |
580 | glob failed (child exited with status %d%s) | |
043fb3eb | 581 | Got an error from DosAllocMem: %i |
87a63fff JM |
582 | Goto undefined subroutine |
583 | Goto undefined subroutine &%s | |
5f2c6f7e FC |
584 | Got signal %d |
585 | ()-group starts with a count in %s | |
586 | Illegal binary digit '%c' ignored | |
87a63fff | 587 | Illegal character %sin prototype for %s : %s |
5f2c6f7e FC |
588 | Illegal hexadecimal digit '%c' ignored |
589 | Illegal octal digit '%c' ignored | |
043fb3eb | 590 | INSTALL_PREFIX too long: `%s' |
5f2c6f7e | 591 | Invalid argument to sv_cat_decode |
87a63fff JM |
592 | Invalid range "%c-%c" in transliteration operator |
593 | Invalid separator character %c%c%c in PerlIO layer specification %s | |
594 | Invalid TOKEN object ignored | |
595 | Invalid type '%c' in pack | |
596 | Invalid type '%c' in %s | |
597 | Invalid type '%c' in unpack | |
598 | Invalid type ',' in %s | |
f36743d5 | 599 | ioctl implemented only on sockets |
5f2c6f7e | 600 | ioctlsocket not implemented! |
043fb3eb | 601 | join with a thread with a waiter |
5f2c6f7e | 602 | killpg not implemented! |
5f2c6f7e | 603 | List form of pipe open not implemented |
043fb3eb | 604 | Looks like we have no PM; will not load DLL %s without $ENV{PERL_ASIF_PM} |
5f2c6f7e | 605 | Malformed integer in [] in %s |
043fb3eb | 606 | Malformed %s |
87a63fff | 607 | Malformed UTF-8 character (fatal) |
87a63fff JM |
608 | Missing (suid) fd script name |
609 | More than one argument to open | |
610 | More than one argument to open(,':%s') | |
043fb3eb | 611 | No message queue |
5f2c6f7e FC |
612 | No %s allowed while running setgid |
613 | No %s allowed with (suid) fdscript | |
87a63fff | 614 | Not an XSUB reference |
043fb3eb FC |
615 | Not a reference given to mod2fname |
616 | Not array reference given to mod2fname | |
87a63fff | 617 | Operator or semicolon missing before %c%s |
928729ea | 618 | Out of memory during list extend |
043fb3eb | 619 | panic queryaddr |
1bac45e4 | 620 | Parse error |
c999563f | 621 | PerlApp::TextQuery: no arguments, please |
b26f9440 | 622 | POSIX syntax [%c %c] is reserved for future extensions in regex; marked by <-- HERE in m/%s/ |
78d0fecf | 623 | ptr wrong %p != %p fl=%x nl=%p e=%p for %d |
043fb3eb | 624 | QUITing... |
87a63fff | 625 | Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?) |
32352119 | 626 | recursion detected in %s |
b26f9440 | 627 | Regexp *+ operand could be empty in regex; marked by <-- HERE in m/%s/ |
87a63fff | 628 | Reversed %c= operator |
043fb3eb | 629 | %s: Can't parse EXE/DLL name: '%s' |
78d0fecf | 630 | %s(%f) failed |
87a63fff | 631 | %sCompilation failed in require |
043fb3eb | 632 | %s: Error stripping dirs from EXE/DLL/INSTALLDIR name |
f36743d5 FC |
633 | sethostent not implemented! |
634 | setnetent not implemented! | |
635 | setprotoent not implemented! | |
87a63fff | 636 | set %s %p %p %p |
f36743d5 | 637 | setservent not implemented! |
87a63fff JM |
638 | %s free() ignored (RMAGIC, PERL_CORE) |
639 | %s has too many errors. | |
640 | SIG%s handler "%s" not defined. | |
87a63fff JM |
641 | %s in %s |
642 | Size magic not implemented | |
043fb3eb | 643 | %s: name `%s' too long |
f36743d5 | 644 | %s not implemented! |
87a63fff | 645 | %s number > %s non-portable |
87a63fff | 646 | %srealloc() %signored |
5f2c6f7e | 647 | %s in regex m/%s/ |
ca53083a | 648 | %s on %s %s |
5f2c6f7e | 649 | socketpair not implemented! |
043fb3eb | 650 | %s: %s |
87a63fff JM |
651 | Starting Full Screen process with flag=%d, mytype=%d |
652 | Starting PM process with flag=%d, mytype=%d | |
5f2c6f7e | 653 | sv_2iv assumed (U_V(fabs((double)SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%f U_V is 0x%x, IV_MAX is 0x%x |
5f2c6f7e FC |
654 | switching effective gid is not implemented |
655 | switching effective uid is not implemented | |
656 | System V IPC is not implemented on this machine | |
5f2c6f7e | 657 | Terminating on signal SIG%s(%d) |
5f2c6f7e | 658 | The crypt() function is not implemented on NetWare |
87a63fff JM |
659 | The flock() function is not implemented on NetWare |
660 | The rewinddir() function is not implemented on NetWare | |
661 | The seekdir() function is not implemented on NetWare | |
87a63fff | 662 | The telldir() function is not implemented on NetWare |
043fb3eb FC |
663 | This perl was compiled without taint support. Cowardly refusing to run with -t or -T flags |
664 | This version of OS/2 does not support %s.%s | |
87a63fff | 665 | Too deeply nested ()-groups in %s |
87a63fff JM |
666 | Too many args on %s line of "%s" |
667 | U0 mode on a byte string | |
5f2c6f7e | 668 | unable to find VMSPIPE.COM for i/o piping |
f36743d5 | 669 | Unable to locate winsock library! |
043fb3eb | 670 | Unexpected program mode %d when morphing back from PM |
5f2c6f7e | 671 | Unrecognized character %s; marked by <-- HERE after %s<-- HERE near column %d |
87a63fff | 672 | Unstable directory path, current directory changed unexpectedly |
87a63fff | 673 | Unterminated compressed integer in unpack |
a17f90da | 674 | Usage: %s(%s) |
87a63fff | 675 | Usage: %s::%s(%s) |
a17f90da | 676 | Usage: CODE(0x%x)(%s) |
5f2c6f7e FC |
677 | Usage: File::Copy::rmscopy(from,to[,date_flag]) |
678 | Usage: VMS::Filespec::candelete(spec) | |
679 | Usage: VMS::Filespec::fileify(spec) | |
680 | Usage: VMS::Filespec::pathify(spec) | |
681 | Usage: VMS::Filespec::rmsexpand(spec[,defspec]) | |
682 | Usage: VMS::Filespec::unixify(spec) | |
683 | Usage: VMS::Filespec::unixpath(spec) | |
87a63fff | 684 | Usage: VMS::Filespec::unixrealpath(spec) |
5f2c6f7e FC |
685 | Usage: VMS::Filespec::vmsify(spec) |
686 | Usage: VMS::Filespec::vmspath(spec) | |
87a63fff JM |
687 | Usage: VMS::Filespec::vmsrealpath(spec) |
688 | Use of inherited AUTOLOAD for non-method %s::%s() is deprecated | |
78d0fecf | 689 | utf8 "\x%X" does not map to Unicode |
87a63fff | 690 | Value of logical "%s" too long. Truncating to %i bytes |
5f2c6f7e | 691 | waitpid: process %x is not a child of process %x |
87a63fff JM |
692 | Wide character |
693 | Wide character in $/ | |
f36743d5 FC |
694 | win32_get_osfhandle() TBD on this platform |
695 | win32_open_osfhandle() TBD on this platform | |
5f2c6f7e | 696 | Within []-length '*' not allowed in %s |
87a63fff | 697 | Within []-length '%c' not allowed in %s |
043fb3eb | 698 | Wrong size of loadOrdinals array: expected %d, actual %d |
87a63fff | 699 | Wrong syntax (suid) fd script name "%s" |
5f2c6f7e | 700 | 'X' outside of string in %s |
87a63fff | 701 | 'X' outside of string in unpack |
62f5f54d FC |
702 | |
703 | __CATEGORIES__ | |
09d15bae KW |
704 | |
705 | # This is a warning, but is currently followed immediately by a croak (toke.c) | |
62f5f54d | 706 | Illegal character \%o (carriage return) |
09d15bae KW |
707 | |
708 | # Because uses WARN_MISSING as a synonym for WARN_UNINITIALIZED (sv.c) | |
62f5f54d | 709 | Missing argument in %s |
09d15bae KW |
710 | |
711 | # This message can be both fatal and non- | |
17d13b54 | 712 | False [] range "%s" in regex; marked by <-- HERE in m/%s/ |