This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Account for GNU "i" extension when checking 'nm' output.
[perl5.git] / t / porting / diag.t
CommitLineData
fe13d51d
JM
1#!/usr/bin/perl
2use warnings;
3use strict;
f7b649f0
NC
4
5require './test.pl';
6
7plan('no_plan');
8
fe13d51d
JM
9$|=1;
10
1eb3f3ad
JM
11# --make-exceptions-list outputs the list of strings that don't have
12# perldiag.pod entries to STDERR without TAP formatting, so they can
13# easily be put in the __DATA__ section of this file. This was done
14# initially so as to not create new test failures upon the initial
15# creation of this test file. You probably shouldn't do it again.
16# Just add the documentation instead.
f7223e8e 17my $make_exceptions_list = ($ARGV[0]||'') eq '--make-exceptions-list';
87a63fff 18
45f1c7ba 19chdir '..' or die "Can't chdir ..: $!";
47f6eaac 20BEGIN { defined $ENV{PERL_UNICODE} and push @INC, "lib"; }
45f1c7ba 21
1b1ee2ef
KW
22my @functions;
23
24open my $func_fh, "<", "embed.fnc" or die "Can't open embed.fnc: $!";
25
26# Look for functions in embed.fnc that look like they could be diagnostic ones.
27while (<$func_fh>) {
28 chomp;
29 s/^\s+//;
30 while (s/\s*\\$//) { # Grab up all continuation lines, these end in \
31 my $next = <$func_fh>;
32 $next =~ s/^\s+//;
33 chomp $next;
34 $_ .= $next;
35 }
36 next if /^:/; # Lines beginning with colon are comments.
37 next unless /\|/; # Lines without a vertical bar are something we can't deal
38 # with
39 my @fields = split /\s*\|\s*/;
40 next unless $fields[2] =~ /warn|err|(\b|_)die|croak/i;
41 push @functions, $fields[2];
42
43 # The flag p means that this function may have a 'Perl_' prefix
44 # The flag s means that this function may have a 'S_' prefix
45 push @functions, "Perl_$fields[2]", if $fields[0] =~ /p/;
46 push @functions, "S_$fields[2]", if $fields[0] =~ /s/;
47}
48
49close $func_fh;
50
51my $function_re = join '|', @functions;
52my $source_msg_re = qr/(?<routine>\bDIE\b|$function_re)/;
fe13d51d
JM
53
54my %entries;
1b1ee2ef
KW
55
56# Get the ignores that are compiled into this file
87a63fff
JM
57while (<DATA>) {
58 chomp;
59 $entries{$_}{todo}=1;
60}
61
fe13d51d 62my $cur_entry;
1b1ee2ef
KW
63open my $diagfh, "<", "pod/perldiag.pod"
64 or die "Can't open pod/perldiag.pod: $!";
65
fe13d51d
JM
66while (<$diagfh>) {
67 if (m/^=item (.*)/) {
68 $cur_entry = $1;
69 } elsif (m/^\((.)(?: ([a-z]+?))?\)/ and !$entries{$cur_entry}{severity}) {
87a63fff
JM
70 # Make sure to init this here, so an actual entry in perldiag overwrites
71 # one in DATA.
72 $entries{$cur_entry}{todo} = 0;
fe13d51d
JM
73 $entries{$cur_entry}{severity} = $1;
74 $entries{$cur_entry}{category} = $2;
75 }
76}
77
1b1ee2ef 78# Recursively descend looking for source files.
45f1c7ba 79my @todo = <*>;
fe13d51d
JM
80while (@todo) {
81 my $todo = shift @todo;
45f1c7ba 82 next if $todo ~~ ['t', 'lib', 'ext', 'dist', 'cpan'];
fe13d51d 83 # opmini.c is just a copy of op.c, so there's no need to check again.
45f1c7ba 84 next if $todo eq 'opmini.c';
fe13d51d
JM
85 if (-d $todo) {
86 push @todo, glob "$todo/*";
87a63fff 87 } elsif ($todo =~ m/\.[ch]$/) {
fe13d51d
JM
88 check_file($todo);
89 }
90}
91
92sub check_file {
93 my ($codefn) = @_;
94
f7223e8e 95 print "# $codefn\n";
fe13d51d 96
38ec24b4 97 open my $codefh, "<", $codefn
fe13d51d
JM
98 or die "Can't open $codefn: $!";
99
100 my $listed_as;
101 my $listed_as_line;
102 my $sub = 'top of file';
103 while (<$codefh>) {
104 chomp;
105 # Getting too much here isn't a problem; we only use this to skip
106 # errors inside of XS modules, which should get documented in the
107 # docs for the module.
108 if (m<^([^#\s].*)> and $1 !~ m/^[{}]*$/) {
109 $sub = $1;
110 }
111 next if $sub =~ m/^XS/;
112 if (m</\* diag_listed_as: (.*) \*/>) {
113 $listed_as = $1;
114 $listed_as_line = $.+1;
115 }
116 next if /^#/;
117 next if /^ * /;
1b1ee2ef 118
c4ea5f2e 119 my $multiline = 0;
1b1ee2ef
KW
120 # Loop to accumulate the message text all on one line.
121 while (m/$source_msg_re/ and not m/\);$/) {
fe13d51d
JM
122 my $nextline = <$codefh>;
123 # Means we fell off the end of the file. Not terribly surprising;
124 # this code tries to merge a lot of things that aren't regular C
125 # code (preprocessor stuff, long comments). That's OK; we don't
126 # need those anyway.
127 last if not defined $nextline;
128 chomp $nextline;
129 $nextline =~ s/^\s+//;
130 # Note that we only want to do this where *both* are true.
131 $_ =~ s/\\$//;
132 if ($_ =~ m/"$/ and $nextline =~ m/^"/) {
133 $_ =~ s/"$//;
134 $nextline =~ s/^"//;
135 }
136 $_ = "$_$nextline";
c4ea5f2e 137 ++$multiline;
fe13d51d
JM
138 }
139 # This should happen *after* unwrapping, or we don't reformat the things
140 # in later lines.
141 # List from perlguts.pod "Formatted Printing of IVs, UVs, and NVs"
142 my %specialformats = (IVdf => 'd',
143 UVuf => 'd',
144 UVof => 'o',
145 UVxf => 'x',
146 UVXf => 'X',
147 NVef => 'f',
148 NVff => 'f',
149 NVgf => 'f',
150 SVf => 's');
151 for my $from (keys %specialformats) {
152 s/%"\s*$from\s*"/\%$specialformats{$from}/g;
153 s/%"\s*$from/\%$specialformats{$from}"/g;
154 }
155 # The %"foo" thing needs to happen *before* this regex.
1b1ee2ef 156 if (m/$source_msg_re(?:_nocontext)? \s*
fe13d51d 157 \(aTHX_ \s*
1b1ee2ef
KW
158 (?:packWARN\d*\((?<category>.*?)\),)? \s*
159 "(?<text>(?:\\"|[^"])*?)"/x)
160 {
161 # diag($_);
162 # DIE is just return Perl_die
163 my $severity = {croak => [qw/P F/],
fe13d51d
JM
164 die => [qw/P F/],
165 warn => [qw/W D S/],
1b1ee2ef
KW
166 }->{$+{'routine'}||'die'};
167 my @categories;
168 if ($+{'category'}) {
169 @categories = map {s/^WARN_//; lc $_} split /\s*[|,]\s*/, $+{'category'};
170 }
171 my $name;
c4ea5f2e 172 if ($listed_as and $listed_as_line == $. - $multiline) {
fe13d51d 173 $name = $listed_as;
1b1ee2ef
KW
174 } else {
175 $name = $+{'text'};
176 # The form listed in perldiag ignores most sorts of fancy printf
177 # formatting, or makes it more perlish.
fe13d51d
JM
178 $name =~ s/%%/\\%/g;
179 $name =~ s/%l[ud]/%d/g;
180 $name =~ s/%\.(\d+|\*)s/\%s/g;
181 $name =~ s/\\"/"/g;
182 $name =~ s/\\t/\t/g;
87a63fff
JM
183 $name =~ s/\\n/ /g;
184 $name =~ s/\s+$//;
4a68bf9d 185 $name =~ s/(\\)\\/$1/g;
fe13d51d
JM
186 }
187
87a63fff
JM
188 # Extra explanatory info on an already-listed error, doesn't
189 # need it's own listing.
fe13d51d
JM
190 next if $name =~ m/^\t/;
191
192 # Happens fairly often with PL_no_modify.
193 next if $name eq '%s';
194
87a63fff
JM
195 # Special syntax for magic comment, allows ignoring the fact
196 # that it isn't listed. Only use in very special circumstances,
197 # like this script failing to notice that the Perl_croak call is
198 # inside an #if 0 block.
fe13d51d
JM
199 next if $name eq 'SKIPME';
200
87a63fff
JM
201 if (exists $entries{$name}) {
202 if ($entries{$name}{todo}) {
203 TODO: {
1b1ee2ef 204 no warnings 'once';
f7b649f0 205 local $::TODO = 'in DATA';
1eb3f3ad
JM
206 # There is no listing, but it is in the list of exceptions. TODO FAIL.
207 fail("No listing in pod/perldiag.pod for '$name' from $codefn line $ (but it wasn't documented in 5.10 either, so we're letting it slide).");
87a63fff 208 }
fe13d51d 209 } else {
1eb3f3ad
JM
210 # We found an actual valid entry in perldiag.pod for this error.
211 ok("Found listing in pod/perldiag.pod for '$name' from $codefn line $.");
fe13d51d 212 }
87a63fff
JM
213 # Later, should start checking that the severity is correct, too.
214 } elsif ($name =~ m/^panic: /) {
215 # Just too many panic:s, they are hard to diagnose, and there
216 # is a generic "panic: %s" entry. Leave these for another
217 # pass.
1eb3f3ad 218 ok("Skipping lack of explicit perldiag entry for '$name' from $codefn line $., covered by panic: %s entry");
fe13d51d 219 } else {
87a63fff 220 if ($make_exceptions_list) {
1eb3f3ad
JM
221 # We're making an updated version of the exception list, to
222 # stick in the __DATA__ section. I honestly can't think of
223 # a situation where this is the right thing to do, but I'm
224 # leaving it here, just in case one of my descendents thinks
225 # it's a good idea.
87a63fff
JM
226 print STDERR "$name\n";
227 } else {
1eb3f3ad
JM
228 # No listing found, and no excuse either.
229 # Find the correct place in perldiag.pod, and add a stanza beginning =item $name.
230 fail("No listing in pod/perldiag.pod for '$name' from $codefn line $.");
87a63fff 231 }
fe13d51d
JM
232 }
233
234 die if $name =~ /%$/;
235 }
236 }
237}
f7223e8e 238# Lists all missing things as of the inaguration of this script, so we
87a63fff 239# don't have to go from "meh" to perfect all at once.
b0227916
JM
240#
241# PLEASE DO NOT ADD TO THIS LIST. Instead, write an entry in
242# pod/perldiag.pod for your new (warning|error).
87a63fff 243__DATA__
87a63fff
JM
244Argument "%s" isn't numeric
245Argument "%s" isn't numeric in %s
87a63fff
JM
246Attempt to clear deleted array
247Attempt to free non-arena SV: 0x%x
248Attempt to free non-existent shared string '%s'%s
249Attempt to free temp prematurely: SV 0x%x
250Attempt to free unreferenced scalar: SV 0x%x
251Attempt to reload %s aborted. Compilation failed in require
252av_reify called on tied array
253Bad name after %s%s
d5713896 254Bad symbol for %s
87a63fff
JM
255bad top format reference
256Bizarre copy of %s
257Bizarre SvTYPE [%d]
258Cannot copy to %s
259Can't call method "%s" %s
260Can't coerce readonly %s to string
261Can't coerce readonly %s to string in %s
262Can't fix broken locale name "%s"
263Can't get short module name from a handle
264Can't goto subroutine from an eval-block
265Can't goto subroutine from an eval-string
266Can't locate object method "%s" via package "%s" (perhaps you forgot to load "%s"?)
267Can't modify non-existent substring
268Can't open
269Can't open perl script "%s": %s
270Can't open %s
271Can't reset \%ENV on this system
272Can't return array to lvalue scalar context
273Can't return a %s from lvalue subroutine
274Can't return hash to lvalue scalar context
275Can't spawn "%s": %s
276Can't %s script `%s' with ARGV[0] being `%s'
277Can't %s "%s": %s
278Can't %s %s%s%s
279Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)
280Can't take %s of %f
281Can't use '%c' after -mname
973a7615 282Can't use string ("%s"%s) as a subroutine ref while "strict refs" in use
4a68bf9d 283Can't use \%c to mean $%c in expression
87a63fff 284Can't use when() outside a topicalizer
4a68bf9d 285\%c better written as $%c
87a63fff
JM
286Character(s) in '%c' format wrapped in %s
287$%c is no longer supported
288Cloning substitution context is unimplemented
289Code missing after '/' in pack
290Code missing after '/' in unpack
291Compilation failed in require
292Corrupted regexp opcode %d > %d
293'%c' outside of string in pack
294Debug leaking scalars child failed%s%s with errno %d: %s
295Deep recursion on anonymous subroutine
296defined(\%hash) is deprecated
4a68bf9d 297Don't know how to handle magic of type \%o
87a63fff
JM
298-Dp not implemented on this platform
299entering effective gid failed
300entering effective uid failed
301Error reading "%s": %s
302Exiting %s via %s
303Filehandle opened only for %sput
304Filehandle %s opened only for %sput
305Filehandle STD%s reopened as %s only for input
306YOU 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!
307Format STDOUT redefined
308Free to wrong pool %p not %p
309get %s %p %p %p
310glob failed (can't start child: %s)
311glob failed (child exited with status %d%s)
312Goto undefined subroutine
313Goto undefined subroutine &%s
314Hash \%%s missing the \% in argument %d of %s()
4a68bf9d 315Illegal character \%03o (carriage return)
87a63fff 316Illegal character %sin prototype for %s : %s
1b1ee2ef 317Integer overflow in binary number
87a63fff 318Integer overflow in decimal number
1b1ee2ef
KW
319Integer overflow in hexadecimal number
320Integer overflow in octal number
87a63fff
JM
321Integer overflow in version %d
322internal \%<num>p might conflict with future printf extensions
4a68bf9d 323invalid control request: '\%03o'
87a63fff
JM
324Invalid module name %s with -%c option: contains single ':'
325invalid option -D%c, use -D'' to see choices
326Invalid range "%c-%c" in transliteration operator
327Invalid separator character %c%c%c in PerlIO layer specification %s
328Invalid TOKEN object ignored
329Invalid type '%c' in pack
330Invalid type '%c' in %s
331Invalid type '%c' in unpack
332Invalid type ',' in %s
91152fc1
DG
333Invalid strict version format (0 before decimal required)
334Invalid strict version format (no leading zeros)
335Invalid strict version format (no underscores)
336Invalid strict version format (v1.2.3 required)
337Invalid strict version format (version required)
338Invalid strict version format (1.[0-9] required)
87a63fff
JM
339Invalid version format (alpha without decimal)
340Invalid version format (misplaced _ in number)
341Invalid version object
4a68bf9d 342It is proposed that "\c{" no longer be valid. It has historically evaluated to ";". If you disagree with this proposal, send email to perl5-porters@perl.org Otherwise, or in the meantime, you can work around this failure by changing "\c{" to ";"
87a63fff
JM
343'j' not supported on this platform
344'J' not supported on this platform
345Layer does not match this perl
346leaving effective gid failed
347leaving effective uid failed
348List form of piped open not implemented
349Lost precision when decrementing %f by 1
350Lost precision when incrementing %f by 1
351%lx
352Malformed UTF-16 surrogate
353Malformed UTF-8 character (fatal)
354'\%' may not be used in pack
355Missing (suid) fd script name
356More than one argument to open
357More than one argument to open(,':%s')
358mprotect for %p %d failed with %d
359mprotect RW for %p %d failed with %d
360No code specified for -%c
361No directory specified for -I
362No such class field "%s"
363Not an XSUB reference
364Not %s reference
365Offset outside string
366Opening dirhandle %s also as a file
367Opening filehandle %s also as a directory
368Operator or semicolon missing before %c%s
87a63fff
JM
369PERL_SIGNALS illegal: "%s"
370Perl %s required (did you mean %s?)--this is only %s, stopped
371Perl %s required--this is only %s, stopped
372Perls since %s too modern--this is %s, stopped
4a68bf9d 373Possible unintended interpolation of $\ in regex
87a63fff
JM
374ptr wrong %p != %p fl=%08
375Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)
376Recursive call to Perl_load_module in PerlIO_find_layer
377refcnt_dec: fd %d < 0
378refcnt_dec: fd %d: %d <= 0
379refcnt_dec: fd %d >= refcnt_size %d
380refcnt_inc: fd %d < 0
381refcnt_inc: fd %d: %d <= 0
382Reversed %c= operator
383Runaway prototype
1b1ee2ef 384%s(%.0
87a63fff
JM
385%s(%.0f) failed
386%s(%.0f) too large
387Scalar value %s better written as $%s
388%sCompilation failed in regexp
389%sCompilation failed in require
390set %s %p %p %p
391%s free() ignored (RMAGIC, PERL_CORE)
392%s has too many errors.
393SIG%s handler "%s" not defined.
394%s: illegal mapping '%s'
395%s in %s
396Size magic not implemented
397%s limit (%d) exceeded
398%s method "%s" overloading "%s" in package "%s"
399%s number > %s non-portable
400%s object version %s does not match %s%s%s%s %s
401%srealloc() %signored
402%s returned from lvalue subroutine in scalar context
403%s%s has too many errors.
404%s%s on %s %s
405%s%s on %s %s %s
406Starting Full Screen process with flag=%d, mytype=%d
407Starting PM process with flag=%d, mytype=%d
408strxfrm() gets absurd
409SWASHNEW didn't return an HV ref
410-T and -B not implemented on filehandles
411The flock() function is not implemented on NetWare
412The rewinddir() function is not implemented on NetWare
413The seekdir() function is not implemented on NetWare
414The stat preceding lstat() wasn't an lstat
415The telldir() function is not implemented on NetWare
416Too deeply nested ()-groups in %s
417Too late to run CHECK block
418Too late to run INIT block
419Too many args on %s line of "%s"
420U0 mode on a byte string
421Unbalanced string table refcount: (%d) for "%s"
422Undefined top format called
423Unexpected constant lvalue entersub entry via type/targ %d:%d
6f6ac1de 424Unicode non-character 0x%04
87a63fff
JM
425Unknown PerlIO layer "scalar"
426Unknown Unicode option letter '%c'
87a63fff 427Unstable directory path, current directory changed unexpectedly
ee6ba15d
EB
428Unsupported script encoding UTF-16BE
429Unsupported script encoding UTF-16LE
430Unsupported script encoding UTF-32BE
431Unsupported script encoding UTF-32LE
87a63fff
JM
432Unterminated compressed integer in unpack
433Usage: CODE(0x%x)(%s)
434Usage: %s(%s)
435Usage: %s::%s(%s)
436Usage: VMS::Filespec::unixrealpath(spec)
437Usage: VMS::Filespec::vmsrealpath(spec)
438Use of inherited AUTOLOAD for non-method %s::%s() is deprecated
439UTF-16 surrogate 0x%04
4a68bf9d 440utf8 "\x%02X" does not map to Unicode
87a63fff
JM
441Value of logical "%s" too long. Truncating to %i bytes
442value of node is %d in Offset macro
443Value of %s%s can be "0"; test with defined()
444Variable "%c%s" is not imported
445vector argument not supported with alpha versions
446Wide character
447Wide character in $/
448Wide character in print
449Wide character in %s
450Within []-length '%c' not allowed in %s
451Wrong syntax (suid) fd script name "%s"
452'X' outside of string in unpack