X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fdiagnostics.pm;h=f174ee5feb8148045b9c7f382ae252006a4ed850;hb=054b02d6604bb3beeebed2d8a040d025b131c9a6;hp=0bdf1be1fa2f373e4d1b9dec35a790bfac0916dd;hpb=91a06757ac3b925b7c0c6afbf3f1378bd4051754;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
old mode 100644
new mode 100755
index 0bdf1be..f174ee5
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -27,7 +27,7 @@ Aa a program:
 =head2 The C<diagnostics> Pragma
 
 This module extends the terse diagnostics normally emitted by both the
-perl compiler and the perl interpeter, augmenting them with the more
+perl compiler and the perl interpreter, augmenting them with the more
 explicative and endearing descriptions found in L<perldiag>.  Like the
 other pragmata, it affects the compilation phase of your program rather
 than merely the execution phase.
@@ -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
@@ -145,7 +150,7 @@ Not being able to say "no diagnostics" is annoying, but may not be
 insurmountable.
 
 The C<-pretty> directive is called too late to affect matters.
-You have to to this instead, and I<before> you load the module.
+You have to do this instead, and I<before> you load the module.
 
     BEGIN { $diagnostics::PRETTY = 1 } 
 
@@ -175,6 +180,8 @@ if ($^O eq 'VMS') {
 @trypod = ("$archlib/pod/perldiag.pod",
 	   "$privlib/pod/perldiag-$].pod",
 	   "$privlib/pod/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];
 
 $DEBUG ||= 0;
@@ -272,7 +279,7 @@ if (eof(POD_DIAG)) {
 
 $transmo = <<EOFUNC;
 sub transmo {
-    local \$^W = 0;  # recursive warnings we do NOT need!
+    #local \$^W = 0;  # recursive warnings we do NOT need!
     study;
 EOFUNC
 
@@ -369,7 +376,7 @@ if ($standalone) {
 
 sub import {
     shift;
-    $old_w = $^W;
+    #$old_w = $^W;
     $^W = 1; # yup, clobbered the global variable; tough, if you
 	     # want diags, you want diags.
     return if $SIG{__WARN__} eq \&warn_trap;
@@ -405,7 +412,7 @@ sub enable { &import }
 
 sub disable {
     shift;
-    $^W = $old_w;
+    #$^W = $old_w;
     return unless $SIG{__WARN__} eq \&warn_trap;
     $SIG{__WARN__} = $oldwarn;
     $SIG{__DIE__} = $olddie;
@@ -451,17 +458,20 @@ sub death_trap {
 
 sub splainthis {
     local $_ = shift;
+    local $\;
     ### &finish_compilation unless %msg;
     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();
@@ -523,7 +533,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