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