small nits in diagnostics.pm (from Robin Barker)

p4raw-id: //depot/perl@6031

diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
index a2c927b..8c7aedc 100755 (executable)
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -167,19 +167,23 @@ Tom Christiansen <F<tchrist@mox.perl.com>>, 25 June 1995.
 
 =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,21 +193,21 @@ if ($^O eq 'VMS') {
          );
 # 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 = ();
+    our $opt_p = our $opt_d = our $opt_v = our $opt_f = '';
 
-    unless (caller) { 
+    unless (caller) {
        $standalone++;
        require Getopt::Std;
        Getopt::Std::getopts('pdvf:')
@@ -212,7 +216,7 @@ CONFIG: {
        $DEBUG = 2 if $opt_d;
        $VERBOSE = $opt_v;
        $PRETTY = $opt_p;
-    } 
+    }
 
     if (open(POD_DIAG, $PODFILE)) {
        warn "Happy happy podfile from real $PODFILE\n" if $DEBUG;
@@ -221,11 +225,12 @@ CONFIG: {
 
     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 @@ if (eof(POD_DIAG)) {
     # etc
 );
 
+our %HTML_Escapes;
 *HTML_Escapes = do {
     if ($standalone) {
        $PRETTY ? \%HTML_2_Latin_1 : \%HTML_2_ASCII_7; 
@@ -284,20 +290,20 @@ if (eof(POD_DIAG)) {
 
 *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 @@ EOFUNC
                } 
                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 @@ EOFUNC
     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 enable { &import }
 
 sub disable {
     shift;
-    #$^W = $old_w;
     return unless $SIG{__WARN__} eq \&warn_trap;
     $SIG{__WARN__} = $oldwarn;
     $SIG{__DIE__} = $olddie;
@@ -465,6 +474,10 @@ sub death_trap {
        # into an indirect recursion loop
 };
 
+my %exact_duplicate;
+my %old_diag;
+my $count;
+my $wantspace;
 sub splainthis {
     local $_ = shift;
     local $\;
@@ -473,7 +486,7 @@ sub splainthis {
     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;
@@ -542,8 +555,5 @@ sub shorten {
 } 
 
 
-# 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

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 1657c45..a49b9af 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1856,13 +1856,13 @@ catches that.  But an easy way to do the same thing is:
 
 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
+=item Modification of non-creatable array value attempted, %s
 
 (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"
+=item Modification of non-creatable hash value attempted, %s
 
 (P) You tried to make a hash value spring into existence, and it
 couldn't be created for some peculiar reason.
@@ -2680,7 +2680,7 @@ which is why it's currently left out of your copy.
 (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'
+=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
@@ -2976,7 +2976,7 @@ quantifier inside the assertion instead.  For example, 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'
+=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 implicitly created, but explicit calls to