In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/abd65dc05fc93591880d7d916c1be975942eed0a?hp=9e08e8f0ce1e3b57a74c472a4ddff63ec61d8d11>
- Log -----------------------------------------------------------------
commit abd65dc05fc93591880d7d916c1be975942eed0a
Author: David Golden <dagol...@cpan.org>
Date: Thu Aug 12 13:38:53 2010 -0400
Refactor porting/diag.t and improve output format
Adds a subroutine to standardize messages variants into a form
that appears in perldiag.pod. Standardizes "panic: ..." instead
of skipping it.
Tests files in sorted order; improves diagnostic output
format for readability; only shows pass/fail once for each
diagnostic message
M t/porting/diag.t
commit 2c86d456ad2d34f5b5c13b6e9dcf31485a2abce0
Author: David Golden <dagol...@cpan.org>
Date: Thu Aug 12 13:09:04 2010 -0400
Add perldiag entries for new version format errors
Also updates porting/diag.t to standardize the
detected messages into the format used in perldiag.pod
M pod/perldiag.pod
M t/porting/diag.t
commit 49a5993ee7c803f0cfe60030e578b7dc5fc9a586
Author: David Golden <dagol...@cpan.org>
Date: Thu Aug 12 12:35:36 2010 -0400
Improve diag.t to detect BADVERSION diagnostics
M t/porting/diag.t
-----------------------------------------------------------------------
Summary of changes:
pod/perldiag.pod | 31 +++++++++++++------
t/porting/diag.t | 85 +++++++++++++++++++++++++++++++++++------------------
2 files changed, 77 insertions(+), 39 deletions(-)
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 241ad01..4496770 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2241,6 +2241,15 @@ colon or whitespace was seen between the elements of a
layer list.
If the previous attribute had a parenthesised parameter list, perhaps that
list was terminated too soon.
+=item Invalid strict version format (%s)
+
+(F) A version number did not meet the "strict" criteria for versions.
+A "strict" version number is a positive decimal number (integer or
+decimal-fraction) without exponentiation or else a dotted-decimal
+v-string with a leading 'v' character and at least three components.
+The parenthesized text indicates which criteria was not met.
+See the L<version> module for more details on allowed version formats.
+
=item Invalid type '%s' in %s
(F) The given character is not a valid pack or unpack type.
@@ -2248,16 +2257,18 @@ See L<perlfunc/pack>.
(W) The given character is not a valid pack or unpack type but used to be
silently ignored.
-=item Invalid version format (multiple underscores)
-
-(F) Versions may contain at most a single underscore, which signals
-that the version is a beta release. See L<version> for the allowed
-version formats.
-
-=item Invalid version format (underscores before decimal)
-
-(F) Versions may not contain decimals after the optional underscore.
-See L<version> for the allowed version formats.
+=item Invalid version format (%s)
+
+(F) A version number did not meet the "lax" criteria for versions.
+A "lax" version number is a positive decimal number (integer or
+decimal-fraction) without exponentiation or else a dotted-decimal
+v-string. If the v-string has less than three components, it must have a
+leading 'v' character. Otherwise, the leading 'v' is optional. Both
+decimal and dotted-decimal versions may have a trailing "alpha"
+component separated by an underscore character after a fractional or
+dotted-decimal component. The parenthesized text indicates which
+criteria was not met. See the L<version> module for more details on
+allowed version formats.
=item ioctl is not implemented
diff --git a/t/porting/diag.t b/t/porting/diag.t
index eeb167d..21e1ae6 100644
--- a/t/porting/diag.t
+++ b/t/porting/diag.t
@@ -76,23 +76,57 @@ while (<$diagfh>) {
}
# Recursively descend looking for source files.
-my @todo = <*>;
+my @todo = sort <*>;
while (@todo) {
my $todo = shift @todo;
next if $todo ~~ ['t', 'lib', 'ext', 'dist', 'cpan'];
# 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/*";
+ unshift @todo, sort glob "$todo/*";
} elsif ($todo =~ m/\.[ch]$/) {
check_file($todo);
}
}
+sub find_message {
+ my ($line) = @_;
+ my $text_re = qr/"(?<text>(?:\\"|[^"])*?)"/;
+ if ($line =~ m/$source_msg_re(?:_nocontext)? \s*
+ \(aTHX_ \s*
+ (?:packWARN\d*\((?<category>.*?)\),)? \s*
+ $text_re /x
+ ) {
+ return [$+{'text'}, $+{'category'}];
+ }
+ elsif ( $line =~ m{BADVERSION\([^"]*$text_re}) {
+ return [$+{'text'}, undef];
+ }
+ return;
+}
+
+# Standardize messages with variants into the form that appears
+# in perldiag.pod -- useful for things without a diag_listed_as annotation
+sub standardize {
+ my ($name) = @_;
+
+ if ( $name =~ m/^(Invalid strict version format) \([^\)]*\)/ ) {
+ $name = "$1 (\%s)";
+ }
+ elsif ( $name =~ m/^(Invalid version format) \([^\)]*\)/ ) {
+ $name = "$1 (\%s)";
+ }
+ elsif ($name =~ m/^panic: /) {
+ $name = "panic: \%s";
+ }
+
+ return $name;
+}
+
sub check_file {
my ($codefn) = @_;
- print "# $codefn\n";
+ print "# Checking $codefn\n";
open my $codefh, "<", $codefn
or die "Can't open $codefn: $!";
@@ -153,26 +187,21 @@ sub check_file {
s/%"\s*$from/\%$specialformats{$from}"/g;
}
# The %"foo" thing needs to happen *before* this regex.
- if (m/$source_msg_re(?:_nocontext)? \s*
- \(aTHX_ \s*
- (?:packWARN\d*\((?<category>.*?)\),)? \s*
- "(?<text>(?:\\"|[^"])*?)"/x)
- {
+ if ( my $found = find_message($_) ) {
# diag($_);
# DIE is just return Perl_die
+ my ($name, $category) = @$found;
my $severity = {croak => [qw/P F/],
die => [qw/P F/],
warn => [qw/W D S/],
}->{$+{'routine'}||'die'};
my @categories;
- if ($+{'category'}) {
- @categories = map {s/^WARN_//; lc $_} split /\s*[|,]\s*/,
$+{'category'};
+ if (defined $category) {
+ @categories = map {s/^WARN_//; lc $_} split /\s*[|,]\s*/, $category;
}
- my $name;
if ($listed_as and $listed_as_line == $. - $multiline) {
$name = $listed_as;
} else {
- $name = $+{'text'};
# The form listed in perldiag ignores most sorts of fancy printf
# formatting, or makes it more perlish.
$name =~ s/%%/\\%/g;
@@ -198,24 +227,27 @@ sub check_file {
# inside an #if 0 block.
next if $name eq 'SKIPME';
+ $name = standardize($name);
+
if (exists $entries{$name}) {
- if ($entries{$name}{todo}) {
+ if ( $entries{$name}{seen}++ ) {
+ # no need to repeat entries we've tested
+ } elsif ($entries{$name}{todo}) {
TODO: {
no warnings 'once';
local $::TODO = 'in DATA';
# There is no listing, but it is in the list of exceptions. TODO
FAIL.
- 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).");
+ fail($name);
+ diag(
+ " Message '$name'\n from $codefn line $. is not listed in
pod/perldiag.pod\n".
+ " (but it wasn't documented in 5.10 either, so marking it
TODO)."
+ );
}
} else {
# We found an actual valid entry in perldiag.pod for this error.
- ok("Found listing in pod/perldiag.pod for '$name' from $codefn line
$.");
+ pass($name);
}
# Later, should start checking that the severity is correct, too.
- } elsif ($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("Skipping lack of explicit perldiag entry for '$name' from $codefn
line $., covered by panic: %s entry");
} else {
if ($make_exceptions_list) {
# We're making an updated version of the exception list, to
@@ -227,8 +259,11 @@ sub check_file {
} else {
# No listing found, and no excuse either.
# Find the correct place in perldiag.pod, and add a stanza beginning
=item $name.
- fail("No listing in pod/perldiag.pod for '$name' from $codefn line
$.");
+ fail($name);
+ diag(" Message '$name'\n from $codefn line $. is not listed in
pod/perldiag.pod");
}
+ # seen it, so only fail once for this message
+ $entries{$name}{seen}++;
}
die if $name =~ /%$/;
@@ -330,14 +365,6 @@ Invalid type '%c' in pack
Invalid type '%c' in %s
Invalid type '%c' in unpack
Invalid type ',' in %s
-Invalid strict version format (0 before decimal required)
-Invalid strict version format (no leading zeros)
-Invalid strict version format (no underscores)
-Invalid strict version format (v1.2.3 required)
-Invalid strict version format (version required)
-Invalid strict version format (1.[0-9] required)
-Invalid version format (alpha without decimal)
-Invalid version format (misplaced _ in number)
Invalid version object
It is proposed that "\c{" no longer be valid. It has historically evaluated to
";". If you disagree with this proposal, send email to perl5-port...@perl.org
Otherwise, or in the meantime, you can w ... [48 chars truncated]
'j' not supported on this platform
--
Perl5 Master Repository
