Eliminate unnecessary (and sometimes confounding) test for

[p5sagit/p5-mst-13.2.git] / lib / diagnostics.pm

diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
index 648ea12..a2c927b 100755 (executable)
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -4,7 +4,7 @@ package diagnostics;
 
 diagnostics - Perl compiler pragma to force verbose warning diagnostics
 
-splain - stand-alone program to do the same thing
+splain - standalone program to do the same thing
 
 =head1 SYNOPSIS
 
@@ -41,9 +41,9 @@ that this I<does> enable perl's B<-w> flag.)  Your whole
 compilation will then be subject(ed :-) to the enhanced diagnostics.
 These still go out B<STDERR>.
 
-Due to the interaction between runtime and compile time issues,
+Due to the interaction between runtime and compiletime issues,
 and because it's probably not a very good idea anyway,
-you may not use C<no diagnostics> to turn them off at compile time.
+you may not use C<no diagnostics> to turn them off at compiletime.
 However, you may control there behaviour at runtime using the 
 disable() and enable() methods to turn them off and on respectively.
 
@@ -51,6 +51,11 @@ The B<-verbose> flag first prints out the L<perldiag> introduction before
 any other diagnostics.  The $diagnostics::PRETTY variable can generate nicer
 escape sequences for pagers.
 
+Warnings dispatched from perl itself (or more accurately, those that match
+descriptions found in L<perldiag>) are only displayed once (no duplicate
+descriptions).  User code generated warnings ala warn() are unaffected,
+allowing duplicate user messages to be displayed.
+
 =head2 The I<splain> Program
 
 While apparently a whole nuther program, I<splain> is actually nothing
@@ -66,7 +71,7 @@ Output from I<splain> is directed to B<STDOUT>, unlike the pragma.
 =head1 EXAMPLES
 
 The following file is certain to trigger a few errors at both
-runtime and compile time:
+runtime and compiletime:
 
     use diagnostics;
     print NOWHERE "nothing\n";
@@ -162,9 +167,11 @@ Tom Christiansen <F<tchrist@mox.perl.com>>, 25 June 1995.
 
 =cut
 
-require 5.001;
+use 5.005_64;
 use Carp;
 
+$VERSION = v1.0;
+
 use Config;
 ($privlib, $archlib) = @Config{qw(privlibexp archlibexp)};
 if ($^O eq 'VMS') {
@@ -172,9 +179,14 @@ if ($^O eq 'VMS') {
     $privlib = VMS::Filespec::unixify($privlib);
     $archlib = VMS::Filespec::unixify($archlib);
 }
-@trypod = ("$archlib/pod/perldiag.pod",
-          "$privlib/pod/perldiag-$].pod",
-          "$privlib/pod/perldiag.pod");
+@trypod = (
+          "$archlib/pod/perldiag.pod",
+          "$privlib/pod/perldiag-$Config{version}.pod",
+          "$privlib/pod/perldiag.pod",
+          "$archlib/pods/perldiag.pod",
+          "$privlib/pods/perldiag-$Config{version}.pod",
+          "$privlib/pods/perldiag.pod",
+         );
 # 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];
@@ -323,7 +335,7 @@ EOFUNC
        # strip formatting directives in =item line
        ($header = $1) =~ s/[A-Z]<(.*?)>/$1/g;
 
-       if ($header =~ /%[sd]/) {
+       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)  {
@@ -336,6 +348,7 @@ EOFUNC
                $lhs =~ s/\377//g;
                $lhs =~ s/\.\*\?$/.*/; # Allow %s at the end to eat it all
            } 
+           $lhs =~ s/\\%c/./g;
            $transmo .= "    s{^$lhs}\n     {\Q$rhs\E}s\n\t&& return 1;\n";
        } else {
            $transmo .= "    m{^\Q$header\E} && return 1;\n";
@@ -366,7 +379,8 @@ if ($standalone) {
     } 
     exit;
 } else { 
-    $old_w = 0; $oldwarn = ''; $olddie = '';
+    #$old_w = 0;
+    $oldwarn = ''; $olddie = '';
 }
 
 sub import {
@@ -458,13 +472,15 @@ sub splainthis {
     s/\.?\n+$//;
     my $orig = $_;
     # return unless defined;
-    if ($exact_duplicate{$_}++) {
-       return 1;
-    } 
     s/, <.*?> (?:line|chunk).*$//;
     $real = s/(.*?) at .*? (?:line|chunk) \d+.*/$1/;
     s/^\((.*)\)$/$1/;
-    return 0 unless &transmo;
+    if ($exact_duplicate{$orig}++) {
+       return &transmo;
+    }
+    else {
+       return 0 unless &transmo;
+    }
     $orig = shorten($orig);
     if ($old_diag{$_}) {
        autodescribe();
@@ -526,7 +542,7 @@ sub shorten {
 } 
 
 
-# have to do this: RS isn't set until run time, but we're executing at compile time
+# 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