This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
AW: IO::Dir destructor
[perl5.git] / lib / diagnostics.pm
index b51376f..7af5efa 100755 (executable)
@@ -28,7 +28,8 @@ Using diagnostics to get stack traces from a misbehaving script:
 =head2 The C<diagnostics> Pragma
 
 This module extends the terse diagnostics normally emitted by both the
-perl compiler and the perl interpreter, augmenting them with the more
+perl compiler and the perl interpreter (from running perl with a -w 
+switch or C<use warnings>), 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.
@@ -59,7 +60,7 @@ allowing duplicate user messages to be displayed.
 
 This module also adds a stack trace to the error message when perl dies.
 This is useful for pinpointing what caused the death. The B<-traceonly> (or
-just B<-t>) flag turns off the explantions of warning messages leaving just
+just B<-t>) flag turns off the explanations of warning messages leaving just
 the stack traces. So if your script is dieing, run it again with
 
   perl -Mdiagnostics=-traceonly my_bad_script
@@ -180,11 +181,11 @@ Tom Christiansen <F<tchrist@mox.perl.com>>, 25 June 1995.
 =cut
 
 use strict;
-use 5.006;
+use 5.009001;
 use Carp;
 $Carp::Internal{__PACKAGE__.""}++;
 
-our $VERSION = 1.14;
+our $VERSION = 1.17;
 our $DEBUG;
 our $VERBOSE;
 our $PRETTY;
@@ -220,7 +221,7 @@ $DEBUG ||= 0;
 my $WHOAMI = ref bless [];  # nobody's business, prolly not even mine
 
 local $| = 1;
-local $_;
+my $_;
 
 my $standalone;
 my(%HTML_2_Troff, %HTML_2_Latin_1, %HTML_2_ASCII_7);
@@ -322,7 +323,6 @@ my %msg;
 {
     print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
     local $/ = '';
-    local $_;
     my $header;
     my $for_item;
     while (<POD_DIAG>) {
@@ -394,7 +394,7 @@ my %msg;
                         $toks[$i] = '[\da-f]+';
                    }
                 } elsif( length( $toks[$i] ) ){
-                    $toks[$i] =~ s/^.*$/\Q$&\E/;
+                    $toks[$i] = quotemeta $toks[$i];
                     $conlen += length( $toks[$i] );
                 }
             }  
@@ -465,12 +465,12 @@ sub import {
                                    $PRETTY++;
                                    next;
                               };
-
-       /^-t(race)?$/           && do {
+       # matches trace and traceonly for legacy doc mixup reasons
+       /^-t(race(only)?)?$/    && do {
                                    $TRACEONLY++;
                                    next;
                               };
-       /^-w(arntrace)?$/               && do {
+       /^-w(arntrace)?$/       && do {
                                    $WARNTRACE++;
                                    next;
                               };
@@ -547,8 +547,9 @@ my $count;
 my $wantspace;
 sub splainthis {
     return 0 if $TRACEONLY;
-    local $_ = shift;
+    $_ = shift;
     local $\;
+    local $!;
     ### &finish_compilation unless %msg;
     s/\.?\n+$//;
     my $orig = $_;
@@ -561,6 +562,7 @@ sub splainthis {
     # but be aware of messsages containing " at this-or-that"
     my $real = 0;
     my @secs = split( / at / );
+    return unless @secs;
     $_ = $secs[0];
     for my $i ( 1..$#secs ){
         if( $secs[$i] =~ /.+? (?:line|chunk) \d+/ ){