This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Documentation for the 'qr' overload.
[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
f7223e8e 11my $make_exceptions_list = ($ARGV[0]||'') eq '--make-exceptions-list';
87a63fff 12
38ec24b4 13open my $diagfh, "<", "../pod/perldiag.pod"
87a63fff 14 or die "Can't open ../pod/perldiag.pod: $!";
fe13d51d
JM
15
16my %entries;
87a63fff
JM
17while (<DATA>) {
18 chomp;
19 $entries{$_}{todo}=1;
20}
21
fe13d51d
JM
22my $cur_entry;
23while (<$diagfh>) {
24 if (m/^=item (.*)/) {
25 $cur_entry = $1;
26 } elsif (m/^\((.)(?: ([a-z]+?))?\)/ and !$entries{$cur_entry}{severity}) {
87a63fff
JM
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
JM
30 $entries{$cur_entry}{severity} = $1;
31 $entries{$cur_entry}{category} = $2;
32 }
33}
34
87a63fff 35my @todo = ('..');
fe13d51d
JM
36while (@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
JM
41 if (-d $todo) {
42 push @todo, glob "$todo/*";
87a63fff 43 } elsif ($todo =~ m/\.[ch]$/) {
fe13d51d
JM
44 check_file($todo);
45 }
46}
47
48sub check_file {
49 my ($codefn) = @_;
50
f7223e8e 51 print "# $codefn\n";
fe13d51d 52
38ec24b4 53 open my $codefh, "<", $codefn
fe13d51d
JM
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
JM
134 $name =~ s/\\n/ /g;
135 $name =~ s/\s+$//;
fe13d51d
JM
136 }
137
87a63fff
JM
138 # Extra explanatory info on an already-listed error, doesn't
139 # need it's own listing.
fe13d51d
JM
140 next if $name =~ m/^\t/;
141
142 # Happens fairly often with PL_no_modify.
143 next if $name eq '%s';
144
87a63fff
JM
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
JM
149 next if $name eq 'SKIPME';
150
87a63fff
JM
151 if (exists $entries{$name}) {
152 if ($entries{$name}{todo}) {
153 TODO: {
f7b649f0
NC
154 no warnings 'once';
155 local $::TODO = 'in DATA';
87a63fff
JM
156 fail("Presence of '$name' from $codefn line $.");
157 }
fe13d51d 158 } else {
87a63fff 159 ok("Presence of '$name' from $codefn line $.");
fe13d51d 160 }
87a63fff
JM
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
JM
168 if ($make_exceptions_list) {
169 print STDERR "$name\n";
170 } else {
171 fail("Presence of '$name' from $codefn line $.");
172 }
fe13d51d
JM
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
JM
180# don't have to go from "meh" to perfect all at once.
181__DATA__
182Ambiguous call resolved as CORE::%s(), %s
183Ambiguous use of %c resolved as operator %c
184Ambiguous use of %c{%s} resolved to %c%s
185Ambiguous use of %c{%s%s} resolved to %c%s%s
186Ambiguous use of -%s resolved as -&%s()
187Argument "%s" isn't numeric
188Argument "%s" isn't numeric in %s
87a63fff
JM
189Attempt to clear deleted array
190Attempt to free non-arena SV: 0x%x
191Attempt to free non-existent shared string '%s'%s
192Attempt to free temp prematurely: SV 0x%x
193Attempt to free unreferenced scalar: SV 0x%x
194Attempt to reload %s aborted. Compilation failed in require
195av_reify called on tied array
196Bad name after %s%s
d5713896 197Bad symbol for %s
87a63fff
JM
198bad top format reference
199Bizarre copy of %s
200Bizarre SvTYPE [%d]
201Cannot copy to %s
202Can't call method "%s" %s
203Can't coerce readonly %s to string
204Can't coerce readonly %s to string in %s
205Can't fix broken locale name "%s"
206Can't get short module name from a handle
207Can't goto subroutine from an eval-block
208Can't goto subroutine from an eval-string
209Can't locate object method "%s" via package "%s" (perhaps you forgot to load "%s"?)
210Can't modify non-existent substring
211Can't open
212Can't open perl script "%s": %s
213Can't open %s
214Can't reset \%ENV on this system
215Can't return array to lvalue scalar context
216Can't return a %s from lvalue subroutine
217Can't return hash to lvalue scalar context
218Can't spawn "%s": %s
219Can't %s script `%s' with ARGV[0] being `%s'
220Can't %s "%s": %s
221Can't %s %s%s%s
222Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)
223Can't take %s of %f
224Can't use '%c' after -mname
225Can't use \\%c to mean $%c in expression
226Can't use when() outside a topicalizer
227\\%c better written as $%c
228Character(s) in '%c' format wrapped in %s
229$%c is no longer supported
230Cloning substitution context is unimplemented
231Code missing after '/' in pack
232Code missing after '/' in unpack
233Compilation failed in require
234Corrupted regexp opcode %d > %d
235'%c' outside of string in pack
236Debug leaking scalars child failed%s%s with errno %d: %s
237Deep recursion on anonymous subroutine
238defined(\%hash) is deprecated
239Don't know how to handle magic of type \\%o
240-Dp not implemented on this platform
241entering effective gid failed
242entering effective uid failed
243Error reading "%s": %s
244Exiting %s via %s
245Filehandle opened only for %sput
246Filehandle %s opened only for %sput
247Filehandle STD%s reopened as %s only for input
248YOU 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!
249Format STDOUT redefined
250Free to wrong pool %p not %p
251get %s %p %p %p
252glob failed (can't start child: %s)
253glob failed (child exited with status %d%s)
254Goto undefined subroutine
255Goto undefined subroutine &%s
256Hash \%%s missing the \% in argument %d of %s()
257Illegal character \\%03o (carriage return)
258Illegal character %sin prototype for %s : %s
259Integer overflow in decimal number
260Integer overflow in version %d
261internal \%<num>p might conflict with future printf extensions
262invalid control request: '\\%03o'
263Invalid module name %s with -%c option: contains single ':'
264invalid option -D%c, use -D'' to see choices
265Invalid range "%c-%c" in transliteration operator
266Invalid separator character %c%c%c in PerlIO layer specification %s
267Invalid TOKEN object ignored
268Invalid type '%c' in pack
269Invalid type '%c' in %s
270Invalid type '%c' in unpack
271Invalid type ',' in %s
272Invalid version format (alpha without decimal)
273Invalid version format (misplaced _ in number)
274Invalid version object
275'j' not supported on this platform
276'J' not supported on this platform
277Layer does not match this perl
278leaving effective gid failed
279leaving effective uid failed
280List form of piped open not implemented
281Lost precision when decrementing %f by 1
282Lost precision when incrementing %f by 1
283%lx
284Malformed UTF-16 surrogate
285Malformed UTF-8 character (fatal)
286'\%' may not be used in pack
287Missing (suid) fd script name
288More than one argument to open
289More than one argument to open(,':%s')
290mprotect for %p %d failed with %d
291mprotect RW for %p %d failed with %d
292No code specified for -%c
293No directory specified for -I
294No such class field "%s"
295Not an XSUB reference
296Not %s reference
297Offset outside string
298Opening dirhandle %s also as a file
299Opening filehandle %s also as a directory
300Operator or semicolon missing before %c%s
87a63fff
JM
301PERL_SIGNALS illegal: "%s"
302Perl %s required (did you mean %s?)--this is only %s, stopped
303Perl %s required--this is only %s, stopped
304Perls since %s too modern--this is %s, stopped
305Possible unintended interpolation of $\\ in regex
306ptr wrong %p != %p fl=%08
307Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)
308Recursive call to Perl_load_module in PerlIO_find_layer
309refcnt_dec: fd %d < 0
310refcnt_dec: fd %d: %d <= 0
311refcnt_dec: fd %d >= refcnt_size %d
312refcnt_inc: fd %d < 0
313refcnt_inc: fd %d: %d <= 0
314Reversed %c= operator
315Runaway prototype
316%s(%.0f) failed
317%s(%.0f) too large
318Scalar value %s better written as $%s
319%sCompilation failed in regexp
320%sCompilation failed in require
321set %s %p %p %p
322%s free() ignored (RMAGIC, PERL_CORE)
323%s has too many errors.
324SIG%s handler "%s" not defined.
325%s: illegal mapping '%s'
326%s in %s
327Size magic not implemented
328%s limit (%d) exceeded
329%s method "%s" overloading "%s" in package "%s"
330%s number > %s non-portable
331%s object version %s does not match %s%s%s%s %s
332%srealloc() %signored
333%s returned from lvalue subroutine in scalar context
334%s%s has too many errors.
335%s%s on %s %s
336%s%s on %s %s %s
337Starting Full Screen process with flag=%d, mytype=%d
338Starting PM process with flag=%d, mytype=%d
339strxfrm() gets absurd
340SWASHNEW didn't return an HV ref
341-T and -B not implemented on filehandles
342The flock() function is not implemented on NetWare
343The rewinddir() function is not implemented on NetWare
344The seekdir() function is not implemented on NetWare
345The stat preceding lstat() wasn't an lstat
346The telldir() function is not implemented on NetWare
347Too deeply nested ()-groups in %s
348Too late to run CHECK block
349Too late to run INIT block
350Too many args on %s line of "%s"
351U0 mode on a byte string
352Unbalanced string table refcount: (%d) for "%s"
353Undefined top format called
354Unexpected constant lvalue entersub entry via type/targ %d:%d
6f6ac1de 355Unicode non-character 0x%04
87a63fff
JM
356Unknown PerlIO layer "scalar"
357Unknown Unicode option letter '%c'
358unrecognised control character '%c'
359Unstable directory path, current directory changed unexpectedly
360Unsupported script encoding UTF16-BE
361Unsupported script encoding UTF16-LE
362Unsupported script encoding UTF32-BE
363Unsupported script encoding UTF32-LE
364Unterminated compressed integer in unpack
365Usage: CODE(0x%x)(%s)
366Usage: %s(%s)
367Usage: %s::%s(%s)
368Usage: VMS::Filespec::unixrealpath(spec)
369Usage: VMS::Filespec::vmsrealpath(spec)
370Use of inherited AUTOLOAD for non-method %s::%s() is deprecated
371UTF-16 surrogate 0x%04
372utf8 "\\x%02X" does not map to Unicode
373Value of logical "%s" too long. Truncating to %i bytes
374value of node is %d in Offset macro
375Value of %s%s can be "0"; test with defined()
376Variable "%c%s" is not imported
377vector argument not supported with alpha versions
378Wide character
379Wide character in $/
380Wide character in print
381Wide character in %s
382Within []-length '%c' not allowed in %s
383Wrong syntax (suid) fd script name "%s"
384'X' outside of string in unpack