[prev in list] [next in list] [prev in thread] [next in thread]
List: perl5-changes
Subject: [perl.git] branch blead, updated. v5.13.1-120-g1b1ee2ef
From: "Rafael Garcia-Suarez" <rgarciasuarez () gmail ! com>
Date: 2010-05-31 22:14:47
Message-ID: E1OJDFv-0002pF-Af () camel ! ams6 ! corp ! booking ! com
[Download RAW message or body]
In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/1b1ee2ef87e2dcc8a1699cc870aefd1b91c5f645?hp=51eec7ec9cf1a154df61e6fc6c46acab7c69b296>
- Log -----------------------------------------------------------------
commit 1b1ee2ef87e2dcc8a1699cc870aefd1b91c5f645
Author: Karl Williamson <khw@khw-desktop.(none)>
Date: Sun May 30 21:54:32 2010 -0600
PATCH: teach diag.t new warning function names
A number of function names that do warnings have been added, but diag.t
hasn't kept up.
This patch changes it to look for likely function names in embed.fnc, so
it will automatically keep up in the future. There's no need to worry
about it looking for inappropriate functions, as the syntax of messages
that it looks for is so restrictive, that there won't be false
positives. Instead there are still many messages it fails to catch.
As a result of it's falling behind several issues have crept in. I
resolved the couple I thought were clear (including one in a comment;
diag.t doesn't strip comments, but mostly it doesn't matter), and added
the others to the <DATA> section to ignore.
are
-----------------------------------------------------------------------
Summary of changes:
pod/perldiag.pod | 2 +-
t/porting/diag.t | 84 ++++++++++++++++++++++++++++++++++++++++-------------
universal.c | 2 +-
3 files changed, 65 insertions(+), 23 deletions(-)
mode change 100644 => 100755 t/porting/diag.t
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 8bb0f85..4d7d6ad 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1711,7 +1711,7 @@ in your false range is interpreted as a literal "-". Consider \
quoting the "-", "\-". The <-- HERE shows in the regular expression about where the
problem was discovered. See L<perlre>.
-=item Fatal VMS error at %s, line %d
+=item Fatal VMS error (status=%d) at %s, line %d
(P) An error peculiar to VMS. Something untoward happened in a VMS
system service or RTL routine; Perl's exit status should provide more
diff --git a/t/porting/diag.t b/t/porting/diag.t
old mode 100644
new mode 100755
index 11bbca0..daec293
--- a/t/porting/diag.t
+++ b/t/porting/diag.t
@@ -13,16 +13,50 @@ my $make_exceptions_list = ($ARGV[0]||'') eq \
'--make-exceptions-list'; chdir '..' or die "Can't chdir ..: $!";
BEGIN { defined $ENV{PERL_UNICODE} and push @INC, "lib"; }
-open my $diagfh, "<", "pod/perldiag.pod"
- or die "Can't open pod/perldiag.pod: $!";
+my @functions;
+
+open my $func_fh, "<", "embed.fnc" or die "Can't open embed.fnc: $!";
+
+# Look for functions in embed.fnc that look like they could be diagnostic ones.
+while (<$func_fh>) {
+ chomp;
+ s/^\s+//;
+ while (s/\s*\\$//) { # Grab up all continuation lines, these end in \
+ my $next = <$func_fh>;
+ $next =~ s/^\s+//;
+ chomp $next;
+ $_ .= $next;
+ }
+ next if /^:/; # Lines beginning with colon are comments.
+ next unless /\|/; # Lines without a vertical bar are something we can't deal
+ # with
+ my @fields = split /\s*\|\s*/;
+ next unless $fields[2] =~ /warn|err|(\b|_)die|croak/i;
+ push @functions, $fields[2];
+
+ # The flag p means that this function may have a 'Perl_' prefix
+ # The flag s means that this function may have a 'S_' prefix
+ push @functions, "Perl_$fields[2]", if $fields[0] =~ /p/;
+ push @functions, "S_$fields[2]", if $fields[0] =~ /s/;
+}
+
+close $func_fh;
+
+my $function_re = join '|', @functions;
+my $source_msg_re = qr/(?<routine>\bDIE\b|$function_re)/;
my %entries;
+
+# Get the ignores that are compiled into this file
while (<DATA>) {
chomp;
$entries{$_}{todo}=1;
}
my $cur_entry;
+open my $diagfh, "<", "pod/perldiag.pod"
+ or die "Can't open pod/perldiag.pod: $!";
+
while (<$diagfh>) {
if (m/^=item (.*)/) {
$cur_entry = $1;
@@ -35,6 +69,7 @@ while (<$diagfh>) {
}
}
+# Recursively descend looking for source files.
my @todo = <*>;
while (@todo) {
my $todo = shift @todo;
@@ -74,7 +109,9 @@ sub check_file {
}
next if /^#/;
next if /^ * /;
- while (m/\bDIE\b|Perl_(croak|die|warn(er)?)/ and not m/\);$/) {
+
+ # Loop to accumulate the message text all on one line.
+ while (m/$source_msg_re/ 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
@@ -108,27 +145,28 @@ sub check_file {
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*
+ if (m/$source_msg_re(?:_nocontext)? \s*
\(aTHX_ \s*
- (?:packWARN\d*\((.*?)\),)? \s*
- "((?:\\"|[^"])*?)"/x) {
- # diag($_);
- # DIE is just return Perl_die
- my $severity = {croak => [qw/P F/],
+ (?:packWARN\d*\((?<category>.*?)\),)? \s*
+ "(?<text>(?:\\"|[^"])*?)"/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 == $.) {
+ }->{$+{'routine'}||'die'};
+ my @categories;
+ if ($+{'category'}) {
+ @categories = map {s/^WARN_//; lc $_} split /\s*[|,]\s*/, $+{'category'};
+ }
+ 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.
+ } else {
+ $name = $+{'text'};
+ # 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;
@@ -155,7 +193,7 @@ sub check_file {
if (exists $entries{$name}) {
if ($entries{$name}{todo}) {
TODO: {
- no warnings 'once';
+ no warnings 'once';
local $::TODO = 'in DATA';
fail("Presence of '$name' from $codefn line $.");
}
@@ -261,7 +299,10 @@ Goto undefined subroutine &%s
Hash \%%s missing the \% in argument %d of %s()
Illegal character \%03o (carriage return)
Illegal character %sin prototype for %s : %s
+Integer overflow in binary number
Integer overflow in decimal number
+Integer overflow in hexadecimal number
+Integer overflow in octal number
Integer overflow in version %d
internal \%<num>p might conflict with future printf extensions
invalid control request: '\%03o'
@@ -325,6 +366,7 @@ refcnt_inc: fd %d < 0
refcnt_inc: fd %d: %d <= 0
Reversed %c= operator
Runaway prototype
+%s(%.0
%s(%.0f) failed
%s(%.0f) too large
Scalar value %s better written as $%s
diff --git a/universal.c b/universal.c
index dec8505..3df8321 100644
--- a/universal.c
+++ b/universal.c
@@ -218,7 +218,7 @@ A specialised variant of C<croak()> for emitting the usage \
message for xsubs works out the package name and subroutine name from C<cv>, and \
then calls C<croak()>. Hence if C<cv> is C<&ouch::awk>, it would call C<croak> as:
- Perl_croak(aTHX_ "Usage %s::%s(%s)", "ouch" "awk", "eee_yow");
+ Perl_croak(aTHX_ "Usage: %s::%s(%s)", "ouch" "awk", "eee_yow");
=cut
*/
--
Perl5 Master Repository
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic