else {
PerlIO *that_fp = NULL;
if (num_svs > 1) {
+ /* diag_listed_as: More than one argument to '%s' open */
Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io));
}
while (isSPACE(*type))
fp = PerlIO_stdout();
IoTYPE(io) = IoTYPE_STD;
if (num_svs > 1) {
+ /* diag_listed_as: More than one argument to '%s' open */
Perl_croak(aTHX_ "More than one argument to '>%c' open",IoTYPE_STD);
}
}
fp = PerlIO_stdin();
IoTYPE(io) = IoTYPE_STD;
if (num_svs > 1) {
+ /* diag_listed_as: More than one argument to '%s' open */
Perl_croak(aTHX_ "More than one argument to '<%c' open",IoTYPE_STD);
}
}
#endif
#if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
default:
+ /* diag_listed_as: msg%s not implemented */
Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]);
#endif
}
than guessing about u_?short(_t)? */
}
#else
+ /* diag_listed_as: sem%s not implemented */
Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]);
#endif
break;
#endif
#if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
default:
+ /* diag_listed_as: shm%s not implemented */
Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]);
#endif
}
#endif
ret = Semctl(id, n, cmd, unsemds);
#else
+ /* diag_listed_as: sem%s not implemented */
Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]);
#endif
}
#else
PERL_UNUSED_ARG(sp);
PERL_UNUSED_ARG(mark);
+ /* diag_listed_as: msg%s not implemented */
Perl_croak(aTHX_ "msgsnd not implemented");
#endif
}
#else
PERL_UNUSED_ARG(sp);
PERL_UNUSED_ARG(mark);
+ /* diag_listed_as: msg%s not implemented */
Perl_croak(aTHX_ "msgrcv not implemented");
#endif
}
return result;
}
#else
+ /* diag_listed_as: sem%s not implemented */
Perl_croak(aTHX_ "semop not implemented");
#endif
}
}
return shmdt(shm);
#else
+ /* diag_listed_as: shm%s not implemented */
Perl_croak(aTHX_ "shm I/O not implemented");
#endif
}
PL_op->op_type == OP_REWINDDIR ||
PL_op->op_type == OP_CLOSEDIR ?
"dirhandle" : "filehandle";
+ /* diag_listed_as: Bad symbol for filehandle */
Perl_croak(aTHX_ "Bad symbol for %s", fh);
}
(sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp)) ||
(sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp)) )
{
+ /* diag_listed_as: Variable "%s" is not imported%s */
Perl_warn(aTHX_ "Variable \"%c%s\" is not imported",
sv_type == SVt_PVAV ? '@' :
sv_type == SVt_PVHV ? '%' : '$',
#ifndef SIG_PENDING_DIE_COUNT
# define SIG_PENDING_DIE_COUNT 120
#endif
- /* And one to say _a_ signal is pending */
+ /* Add one to say _a_ signal is pending */
if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT)
Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded",
(unsigned long)SIG_PENDING_DIE_COUNT);
SV *meth;
if (version->op_type != OP_CONST || !SvNIOKp(vesv))
- Perl_croak(aTHX_ "Version number must be constant number");
+ Perl_croak(aTHX_ "Version number must be a constant number");
/* Make copy of idop so we don't free it twice */
pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
if (items != 0) {
NOOP;
#if 0
+ /* diag_listed_as: SKIPME */
Perl_croak(aTHX_ "usage: %s::%s()",
HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
#endif
# define MALLOC_CHECK_TAINT(argc,argv,env)
#endif /* MYMALLOC */
+/* diag_listed_as: "-T" is on the #! line, it must also be used on the command line */
#define TOO_LATE_FOR_(ch,what) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), what)
#define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "")
#define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}")
had no no effect since Perl 5.8.8, and will be removed in the next major
release of Perl 5.
-=item Bad arg length for %s, is %d, should be %s
+=item Bad arg length for %s, is %d, should be %d
(F) You passed a buffer of the wrong size to one of msgctl(), semctl()
or shmctl(). In C parlance, the correct sizes are, respectively,
(P) An error peculiar to VMS. Perl thought stdin was a pipe, and tried
to reopen it to accept binary data. Alas, it failed.
-=item Can't resolve method `%s' overloading `%s' in package `%s'
+=item Can't resolve method "%s" overloading "%s" in package "%s"
(F|P) Error resolving overloading specified by a method name (as opposed
to a subroutine reference): no such method callable via the package. If
(F) The C<exec> function is not implemented in MacPerl. See L<perlport>.
-=item Execution of %s aborted due to compilation errors
+=item Execution of %s aborted due to compilation errors.
(F) The final summary message when a Perl compilation fails.
supposed to follow something: a template character or a ()-group.
See L<perlfunc/pack>.
-=item %s had compilation errors
+=item %s had compilation errors.
(F) The final summary message when a C<perl -c> fails.
(W digit) You may have tried to use an 8 or 9 in an octal number.
Interpretation of the octal number stopped before the 8 or 9.
-=item Illegal switch in PERL5OPT: %s
+=item Illegal switch in PERL5OPT: -%c
(X) The PERL5OPT environment variable may only be used to set the
following switches: B<-[CDIMUdmtw]>.
(W unopened) You tried ioctl() on a filehandle that was never opened.
Check you control flow and number of arguments.
-=item IO layers (like "%s") unavailable
+=item IO layers (like '%s') unavailable
(F) Your Perl has not been configured to have PerlIO, and therefore
you cannot use IO layers. To have PerlIO Perl must be configured
(F) You tried to unpack something that didn't comply with UTF-8 encoding
rules and perl was unable to guess how to make more progress.
-=item Maximal count of pending signals (%s) exceeded
+=item Maximal count of pending signals (%d) exceeded
-(F) Perl aborted due to a too important number of signals pending. This
+(F) Perl aborted due to a too high number of signals pending. This
usually indicates that your operating system tried to deliver signals
too fast (with a very high priority), starving the perl process from
resources it would need to reach a point where it can process signals
you omitted the name of the module. Consult L<perlrun> for full details
about C<-M> and C<-m>.
-=item More than one argument to open
+=item More than one argument to '%s' open
(F) The C<open> function has been asked to open multiple files. This
can happen if you are trying to open a pipe to a command that takes a
(W unopened) You tried to use the stat() function on a filehandle that
was either never opened or has since been closed.
-=item Stub found while resolving method "%s" overloading "%s"
+=item Stub found while resolving method "%s" overloading "%s" in package "%s"
(P) Overloading resolution over @ISA tree may be broken by importation
stubs. Stubs should never be implicitly created, but explicit calls to
=item "-T" is on the #! line, it must also be used on the command line
(X) The #! line (or local equivalent) in a Perl script contains the
-B<-T> option, but Perl was not invoked with B<-T> in its command line.
+B<-T> option (or the B<-t> option), but Perl was not invoked with B<-T> in its command line.
This is an error because, by the time Perl discovers a B<-T> in a
script, it's too late to properly taint everything from the environment.
So Perl gives up.
If the Perl script is being executed as a command using the #!
mechanism (or its local equivalent), this error can usually be fixed by
-editing the #! line so that the B<-T> option is a part of Perl's first
-argument: e.g. change C<perl -n -T> to C<perl -T -n>.
+editing the #! line so that the B<-%c> option is a part of Perl's first
+argument: e.g. change C<perl -n -%c> to C<perl -%c -n>.
If the Perl script is being executed as C<perl scriptname>, then the
-B<-T> option must appear on the command line: C<perl -T scriptname>.
+B<-%c> option must appear on the command line: C<perl -%c scriptname>.
=item To%s: illegal mapping '%s'
SV_CHECK_THINKFIRST_COW_DROP(sv);
if (SvREFCNT(nsv) != 1) {
- Perl_croak(aTHX_ "panic: reference miscount on nsv in sv_replace() (%"
- UVuf " != 1)", (UV) SvREFCNT(nsv));
+ Perl_croak(aTHX_ "panic: reference miscount on nsv in sv_replace()"
+ " (%" UVuf " != 1)", (UV) SvREFCNT(nsv));
}
if (SvMAGICAL(sv)) {
if (SvMAGICAL(nsv))
--- /dev/null
+#!/usr/bin/perl
+use warnings;
+use strict;
+use Test::More 'no_plan';
+$|=1;
+
+open my $diagfh, "<:raw", "pod/perldiag.pod"
+ or die "Can't open pod/perldiag.pod: $!";
+
+my %entries;
+my $cur_entry;
+while (<$diagfh>) {
+ if (m/^=item (.*)/) {
+ $cur_entry = $1;
+ } elsif (m/^\((.)(?: ([a-z]+?))?\)/ and !$entries{$cur_entry}{severity}) {
+ $entries{$cur_entry}{severity} = $1;
+ $entries{$cur_entry}{category} = $2;
+ }
+}
+
+my @todo = ('.');
+while (@todo) {
+ my $todo = shift @todo;
+ next if $todo ~~ ['./t', './lib', './ext'];
+ # opmini.c is just a copy of op.c, so there's no need to check again.
+ next if $todo eq './opmini.c';
+ if (-d $todo) {
+ push @todo, glob "$todo/*";
+ } elsif ($todo =~ m/\.(c|h)$/) {
+ check_file($todo);
+ }
+}
+
+sub check_file {
+ my ($codefn) = @_;
+
+ diag($codefn);
+
+ open my $codefh, "<:raw", $codefn
+ or die "Can't open $codefn: $!";
+
+ my $listed_as;
+ my $listed_as_line;
+ my $sub = 'top of file';
+ while (<$codefh>) {
+ chomp;
+ # Getting too much here isn't a problem; we only use this to skip
+ # errors inside of XS modules, which should get documented in the
+ # docs for the module.
+ if (m<^([^#\s].*)> and $1 !~ m/^[{}]*$/) {
+ $sub = $1;
+ }
+ next if $sub =~ m/^XS/;
+ if (m</\* diag_listed_as: (.*) \*/>) {
+ $listed_as = $1;
+ $listed_as_line = $.+1;
+ }
+ next if /^#/;
+ next if /^ * /;
+ while (m/\bDIE\b|Perl_(croak|die|warn(er)?)/ and not m/\);$/) {
+ my $nextline = <$codefh>;
+ # Means we fell off the end of the file. Not terribly surprising;
+ # this code tries to merge a lot of things that aren't regular C
+ # code (preprocessor stuff, long comments). That's OK; we don't
+ # need those anyway.
+ last if not defined $nextline;
+ chomp $nextline;
+ $nextline =~ s/^\s+//;
+ # Note that we only want to do this where *both* are true.
+ $_ =~ s/\\$//;
+ if ($_ =~ m/"$/ and $nextline =~ m/^"/) {
+ $_ =~ s/"$//;
+ $nextline =~ s/^"//;
+ }
+ $_ = "$_$nextline";
+ }
+ # This should happen *after* unwrapping, or we don't reformat the things
+ # in later lines.
+ # List from perlguts.pod "Formatted Printing of IVs, UVs, and NVs"
+ my %specialformats = (IVdf => 'd',
+ UVuf => 'd',
+ UVof => 'o',
+ UVxf => 'x',
+ UVXf => 'X',
+ NVef => 'f',
+ NVff => 'f',
+ NVgf => 'f',
+ SVf => 's');
+ for my $from (keys %specialformats) {
+ s/%"\s*$from\s*"/\%$specialformats{$from}/g;
+ s/%"\s*$from/\%$specialformats{$from}"/g;
+ }
+ # The %"foo" thing needs to happen *before* this regex.
+ if (m/(?:DIE|Perl_(croak|die|warn|warner))(?:_nocontext)? \s*
+ \(aTHX_ \s*
+ (?:packWARN\d*\((.*?)\),)? \s*
+ "((?:\\"|[^"])*?)"/x) {
+ # diag($_);
+ # DIE is just return Perl_die
+ my $severity = {croak => [qw/P F/],
+ die => [qw/P F/],
+ warn => [qw/W D S/],
+ }->{$1||'die'};
+ my @categories;
+ if ($2) {
+ @categories = map {s/^WARN_//; lc $_} split /\s*[|,]\s*/, $2;
+ }
+ my $name;
+ if ($listed_as and $listed_as_line == $.) {
+ $name = $listed_as;
+ } else {
+ $name = $3;
+ # The form listed in perldiag ignores most sorts of fancy printf formatting,
+ # or makes it more perlish.
+ $name =~ s/%%/\\%/g;
+ $name =~ s/%l[ud]/%d/g;
+ $name =~ s/%\.(\d+|\*)s/\%s/g;
+ $name =~ s/\\"/"/g;
+ $name =~ s/\\t/\t/g;
+ $name =~ s/\\n/\n/g;
+ $name =~ s/\n$//;
+ }
+
+ # Extra explanitory info on an already-listed error, doesn't need it's own listing.
+ next if $name =~ m/^\t/;
+
+ # Happens fairly often with PL_no_modify.
+ next if $name eq '%s';
+
+ # Special syntax for magic comment, allows ignoring the fact that it isn't listed.
+ # Only use in very special circumstances, like this script failing to notice that
+ # the Perl_croak call is inside an #if 0 block.
+ next if $name eq 'SKIPME';
+
+ if (!exists $entries{$name}) {
+ if ($name =~ m/^panic: /) {
+ # Just too many panic:s, they are hard to diagnose, and there is a generic "panic: %s" entry.
+ # Leave these for another pass.
+ ok("Presence of '$name' from $codefn line $., covered by panic: %s entry");
+ } else {
+ fail("Presence of '$name' from $codefn line $.");
+ }
+ } else {
+ ok("Presence of '$name' from $codefn line $.");
+ # Commented: "substr outside of string" has is either a warning
+ # or an error, depending how much was outside.
+ # Also, plenty of failures without forcing further hardship...
+# if ($entries{$name} and !($entries{$name}{severity} ~~ $severity)) {
+# fail("Severity for '$name' from $codefn line $.: got $entries{$name}{severity}, expected $severity");
+# } else {
+# ok("Severity for '$name' from $codefn line $.: got $entries{$name}{severity}, expected $severity");
+# }
+ }
+
+ die if $name =~ /%$/;
+ }
+ }
+}
projects / p5sagit/p5-mst-13.2.git / commitdiff