Front page | perl.perl5.porters |
Postings from April 2000
[PATCH] Re: [ID 20000322.006] incorrect pod2man output from long =item paragraphs
Thread Next
From:
Robin Barker
Date:
April 28, 2000 11:52
Subject:
[PATCH] Re: [ID 20000322.006] incorrect pod2man output from long =item paragraphs
Message ID:
200004281851.TAA08234@tempest.npl.co.uk
>
> On Thu, 27 Apr 2000 11:24:46 BST, Robin Barker wrote:
> >I was not sure how to deal with perldiag.pod, does the =item line
> >need to match the warning message?
>
> I'm sure diagnostics can be fixed up to grok whatever format we end
> up with.
>
>
> Sarathy
> gsar@activestate.com
>
% perl -we 'use diagnostics; my @x= 0..2; $x[-10]=1'
Modification of non-creatable array value attempted, subscript -10 at -e line 1 (#1)
Uncaught exception from user code:
Modification of non-creatable array value attempted, subscript -10 at -e line 1.
I have looked at diagnostics.pm and noticed the following:
(1) %d should be translated to /-?\d+/; e.g. -10 above.
(2) Fatal errors are trapped by diagnostics _and_
then reported as "Uncaught exception from user code"
(3) There are reference to $RS in the code, but no C<use English>
The patch below does the following:
* shortens the =item lines in perldiag.pod to solve the original problem,
and put the full message in a C<=for diagnostics> paragraph;
* fixes (1) above;
* reads messages from C<=for diagnostics> paragraphs in preference to
the =item lines;
* replaces references to $RS by C<local $/> and
generally adds C<use strict;>, C<my> and C<our>;
* does NOT fix (2), can't see what's going on here.
Robin
--- pod/perldiag.pod 2000/04/28 10:33:01 1.1
+++ pod/perldiag.pod 2000/04/28 17:54:34 1.2
@@ -1879,13 +1879,19 @@
Another way is to assign to a substr() that's off the end of the string.
-=item Modification of non-creatable array value attempted, subscript %d
+=for diagnostics
+Modification of non-creatable array value attempted, subscript %d
+
+=item Modification of non-creatable array value attempted
(F) You tried to make an array value spring into existence, and the
subscript was probably negative, even counting from end of the array
backwards.
-=item Modification of non-creatable hash value attempted, subscript "%s"
+=for diagnostics
+Modification of non-creatable hash value attempted, subscript "%s"
+
+=item Modification of non-creatable hash value attempted
(P) You tried to make a hash value spring into existence, and it couldn't
be created for some peculiar reason.
@@ -2600,7 +2606,10 @@
(F) More than 100 levels of inheritance were used. Probably indicates
an unintended loop in your inheritance hierarchy.
-=item Recursive inheritance detected while looking for method '%s' in package '%s'
+=for diagnostics
+Recursive inheritance detected while looking for method '%s' in package '%s'
+
+=item Recursive inheritance detected while looking for method '%s'
(F) More than 100 levels of inheritance were encountered while invoking a
method. Probably indicates an unintended loop in your inheritance hierarchy.
@@ -2867,7 +2876,10 @@
the way to match "abc" provided that it is followed by three
repetitions of "xyz" is C</abc(?=(?:xyz){3})/>, not C</abc(?=xyz){3}/>.
-=item Stub found while resolving method `%s' overloading `%s' in package `%s'
+=for diagnostics
+Stub found while resolving method `%s' overloading `%s' in package `%s'
+
+=item Stub found while resolving method `%s' overloading `%s'
(P) Overloading resolution over @ISA tree may be broken by importation stubs.
Stubs should never be implicitely created, but explicit calls to C<can>
--- lib/diagnostics.pm 2000/04/28 12:46:12 1.1
+++ lib/diagnostics.pm 2000/04/28 18:33:25 1.5
@@ -167,19 +167,23 @@
=cut
+use strict;
use 5.005_64;
use Carp;
-$VERSION = v1.0;
+our $VERSION = v1.0;
+our $DEBUG;
+our $VERBOSE;
+our $PRETTY;
use Config;
-($privlib, $archlib) = @Config{qw(privlibexp archlibexp)};
+my($privlib, $archlib) = @Config{qw(privlibexp archlibexp)};
if ($^O eq 'VMS') {
require VMS::Filespec;
$privlib = VMS::Filespec::unixify($privlib);
$archlib = VMS::Filespec::unixify($archlib);
}
-@trypod = (
+my @trypod = (
"$archlib/pod/perldiag.pod",
"$privlib/pod/perldiag-$Config{version}.pod",
"$privlib/pod/perldiag.pod",
@@ -189,19 +193,19 @@
);
# handy for development testing of new warnings etc
unshift @trypod, "./pod/perldiag.pod" if -e "pod/perldiag.pod";
-($PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0];
+(my $PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0];
$DEBUG ||= 0;
my $WHOAMI = ref bless []; # nobody's business, prolly not even mine
-$| = 1;
-
+local $| = 1;
local $_;
+my $standalone;
+my(%HTML_2_Troff, %HTML_2_Latin_1, %HTML_2_ASCII_7);
+
CONFIG: {
- $opt_p = $opt_d = $opt_v = $opt_f = '';
- %HTML_2_Troff = %HTML_2_Latin_1 = %HTML_2_ASCII_7 = ();
- %exact_duplicate = ();
+ my $opt_p = my $opt_d = my $opt_v = my $opt_f = '';
unless (caller) {
$standalone++;
@@ -221,11 +225,12 @@
if (caller) {
INCPATH: {
- for $file ( (map { "$_/$WHOAMI.pm" } @INC), $0) {
+ for my $file ( (map { "$_/$WHOAMI.pm" } @INC), $0) {
warn "Checking $file\n" if $DEBUG;
if (open(POD_DIAG, $file)) {
while (<POD_DIAG>) {
- next unless /^__END__\s*# wish diag dbase were more accessible/;
+ next unless
+ /^__END__\s*# wish diag dbase were more accessible/;
print STDERR "podfile is $file\n" if $DEBUG;
last INCPATH;
}
@@ -274,6 +279,7 @@
# etc
);
+our %HTML_Escapes;
*HTML_Escapes = do {
if ($standalone) {
$PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7;
@@ -284,20 +290,20 @@
*THITHER = $standalone ? *STDOUT : *STDERR;
-$transmo = <<EOFUNC;
+my $transmo = <<EOFUNC;
sub transmo {
#local \$^W = 0; # recursive warnings we do NOT need!
study;
EOFUNC
-### sub finish_compilation { # 5.001e panic: top_level for embedded version
+my %msg;
+{
print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
- ### local
- $RS = '';
+ local $/ = '';
local $_;
+ my $header;
+ my $for_item;
while (<POD_DIAG>) {
- #s/(.*)\n//;
- #$header = $1;
unescape();
if ($PRETTY) {
@@ -321,29 +327,35 @@
}
s/^/ /gm;
$msg{$header} .= $_;
+ undef $for_item;
}
next;
}
- unless ( s/=item (.*)\s*\Z//) {
+ unless ( s/=item (.*?)\s*\z//) {
if ( s/=head1\sDESCRIPTION//) {
$msg{$header = 'DESCRIPTION'} = '';
+ undef $for_item;
}
+ elsif( s/^=for\s+diagnostics\s*\n(.*?)\s*\z// ) {
+ $for_item = $1;
+ }
next;
}
# strip formatting directives in =item line
- ($header = $1) =~ s/[A-Z]<(.*?)>/$1/g;
+ $header = $for_item || $1;
+ undef $for_item;
+ $header =~ s/[A-Z]<(.*?)>/$1/g;
if ($header =~ /%[csd]/) {
- $rhs = $lhs = $header;
- #if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E\$/g) {
- if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E/g) {
+ my $rhs = my $lhs = $header;
+ if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E-?\\d+\Q$2\E/g) {
$lhs =~ s/\\%s/.*?/g;
} else {
- # if i had lookbehind negations, i wouldn't have to do this \377 noise
+ # if i had lookbehind negations,
+ # i wouldn't have to do this \377 noise
$lhs =~ s/(.*?)%s/\Q$1\E.*?\377/g;
- #$lhs =~ s/\377([^\377]*)$/\Q$1\E\$/;
$lhs =~ s/\377([^\377]*)$/\Q$1\E/;
$lhs =~ s/\377//g;
$lhs =~ s/\.\*\?$/.*/; # Allow %s at the end to eat it all
@@ -369,25 +381,23 @@
print STDERR $transmo if $DEBUG;
eval $transmo;
die $@ if $@;
- $RS = "\n";
-### }
+}
if ($standalone) {
if (!@ARGV and -t STDIN) { print STDERR "$0: Reading from STDIN\n" }
- while (defined ($error = <>)) {
+ while (defined (my $error = <>)) {
splainthis($error) || print THITHER $error;
}
exit;
-} else {
- #$old_w = 0;
- $oldwarn = ''; $olddie = '';
-}
+}
+
+my $olddie;
+my $oldwarn;
sub import {
shift;
- #$old_w = $^W;
- $^W = 1; # yup, clobbered the global variable; tough, if you
- # want diags, you want diags.
+ $^W = 1; # yup, clobbered the global variable;
+ # tough, if you want diags, you want diags.
return if $SIG{__WARN__} eq \&warn_trap;
for (@_) {
@@ -421,7 +431,6 @@
sub disable {
shift;
- #$^W = $old_w;
return unless $SIG{__WARN__} eq \&warn_trap;
$SIG{__WARN__} = $oldwarn;
$SIG{__DIE__} = $olddie;
@@ -465,6 +474,10 @@
# into an indirect recursion loop
};
+my %exact_duplicate;
+my %old_diag;
+my $count;
+my $wantspace;
sub splainthis {
local $_ = shift;
local $\;
@@ -473,7 +486,7 @@
my $orig = $_;
# return unless defined;
s/, <.*?> (?:line|chunk).*$//;
- $real = s/(.*?) at .*? (?:line|chunk) \d+.*/$1/;
+ my $real = s/(.*?) at .*? (?:line|chunk) \d+.*/$1/;
s/^\((.*)\)$/$1/;
if ($exact_duplicate{$orig}++) {
return &transmo;
@@ -541,9 +554,6 @@
return $line;
}
-
-# have to do this: RS isn't set until run time, but we're executing at compiletime
-$RS = "\n";
1 unless $standalone; # or it'll complain about itself
__END__ # wish diag dbase were more accessible
--
Robin Barker | Eail: Robin.Barker@npl.co.uk
CMSC, Building 10, | Phone: +44 (0) 20 8943 7090
National Physical Laboratory, | Fax: +44 (0) 20 8977 7091
Teddington, Middlesex, UK. TW11 OLW | WWW: http://www.npl.co.uk
Thread Next
-
[PATCH] Re: [ID 20000322.006] incorrect pod2man output from long =item paragraphs
by Robin Barker