Change 23316 by nicholas@no-spam on 2004/09/10 10:56:43
Integrate:
[ 23170]
Bug report #30132 was resolved before it was finished!
Here's the last piece in the puzzle.
[ 23191]
Subject: [PATCH] extension to diagnostics.pm
From: Fergal Daly <fergal@no-spam>
Date: Wed, 4 Aug 2004 00:33:09 +0100
Message-ID: <20040803233309.GA239@no-spam>
[ 23221]
Subject: [PATCH] Document Carp's global variables + provide tests
From: "Jos I. Boumans" <kane@no-spam>
Date: Mon, 16 Aug 2004 15:53:40 +0200
Message-Id: <ADC6DEC6-EF8B-11D8-8425-000A95EF62E2@no-spam>
(tests a bit reworked)
Affected files ...
... //depot/maint-5.8/perl/ext/IO/lib/IO/File.pm#5 integrate
... //depot/maint-5.8/perl/lib/Carp.pm#5 integrate
... //depot/maint-5.8/perl/lib/Carp.t#3 integrate
... //depot/maint-5.8/perl/lib/diagnostics.pm#9 integrate
Differences ...
==== //depot/maint-5.8/perl/ext/IO/lib/IO/File.pm#5 (text) ====
Index: perl/ext/IO/lib/IO/File.pm
--- perl/ext/IO/lib/IO/File.pm#4~20693~ Wed Aug 13 22:35:13 2003
+++ perl/ext/IO/lib/IO/File.pm Fri Sep 10 03:56:43 2004
@@no-spam -169,7 +169,7 @@no-spam
if (defined($file) && length($file)
&& ! File::Spec->file_name_is_absolute($file))
{
- $file = File::Spec->catfile(File::Spec->curdir(),$file);
+ $file = File::Spec->rel2abs($file);
}
$file = IO::Handle::_open_mode_string($mode) . " $file\0";
}
==== //depot/maint-5.8/perl/lib/Carp.pm#5 (text) ====
Index: perl/lib/Carp.pm
--- perl/lib/Carp.pm#4~23038~ Sun Jul 4 14:22:18 2004
+++ perl/lib/Carp.pm Fri Sep 10 03:56:43 2004
@@no-spam -39,6 +39,10 @@no-spam
your module was called. There is no guarantee that that is where
the error was, but it is a good educated guess.
+You can also alter the way the output and logic of C<Carp> works, by
+changing some global variables in the C<Carp> namespace. See the
+section on C<GLOBAL VARIABLES> below.
+
Here is a more complete description of how shortmess works. What
it does is search the call-stack for a function call stack where
it hasn't been told that there shouldn't be an error. If every
@@no-spam -51,7 +55,7 @@no-spam
=item 1.
-Any call from a package to itself is safe.
+Any call from a package to itself is safe.
=item 2.
@@no-spam -95,11 +99,8 @@no-spam
or by including the string C<MCarp=verbose> in the PERL5OPT
environment variable.
-=head1 BUGS
-
-The Carp routines don't handle exception objects currently.
-If called with a first argument that is a reference, they simply
-call die() or warn(), as appropriate.
+Alternately, you can set the global variable C<$Carp::Verbose> to true.
+See the C<GLOBAL VARIABLES> section below.
=cut
@@no-spam -118,16 +119,76 @@no-spam
# $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
# text and function arguments should be formatted when printed.
+# Comments added by Jos I. Boumans <kane@no-spam> 11-Aug-2004
+# I can not get %CarpInternal or %Internal to work as advertised,
+# therefor leaving it out of the below documentation.
+# $CarpLevel may be decprecated according to the last comment, but
+# after 6 years, it's still around and in heavy use ;)
+
+=pod
+
+=head1 GLOBAL VARIABLES
+
+=head2 $Carp::CarpLevel
+
+This variable determines how many call frames are to be skipped when
+reporting where an error occurred on a call to one of C<Carp>'s
+functions. For example:
+
+ $Carp::CarpLevel = 1;
+ sub bar { .... or _error('Wrong input') }
+ sub _error { Carp::carp(@no-spam }
+
+This would make Carp report the error as coming from C<bar>'s caller,
+rather than from C<_error>'s caller, as it normally would.
+
+Defaults to C<0>.
+
+=head2 $Carp::MaxEvalLen
+
+This variable determines how many characters of a string-eval are to
+be shown in the output. Use a value of C<0> to show all text.
+
+Defaults to C<0>.
+
+=head2 $Carp::MaxArgLen
+
+This variable determines how many characters of each argument to a
+function to print. Use a value of C<0> to show the full length of the
+argument.
+
+Defaults to C<64>.
+
+=head2 $Carp::MaxArgNums
+
+This variable determines how many arguments to each function to show.
+Use a value of C<0> to show all arguments to a function call.
+
+Defaults to C<8>.
+
+=head2 $Carp::Verbose
+
+This variable makes C<Carp> use the C<longmess> function at all times.
+This effectively means that all calls to C<carp> become C<cluck> and
+all calls to C<croak> become C<confess>.
+
+Note, this is analogous to using C<use Carp 'verbose'>.
+
+Defaults to C<0>.
+
+=cut
+
+
$CarpInternal{Carp}++;
$CarpInternal{warnings}++;
-$CarpLevel = 0; # How many extra package levels to skip on carp.
- # How many calls to skip on confess.
- # Reconciling these notions is hard, use
- # %Internal and %CarpInternal instead.
-$MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
-$MaxArgLen = 64; # How much of each argument to print. 0 = all.
-$MaxArgNums = 8; # How many arguments to print. 0 = all.
-$Verbose = 0; # If true then make shortmess call longmess instead
+$CarpLevel = 0; # How many extra package levels to skip on carp.
+ # How many calls to skip on confess.
+ # Reconciling these notions is hard, use
+ # %Internal and %CarpInternal instead.
+$MaxEvalLen = 0; # How much eval '...text...' to show. 0 = all.
+$MaxArgLen = 64; # How much of each argument to print. 0 = all.
+$MaxArgNums = 8; # How many arguments to print. 0 = all.
+$Verbose = 0; # If true then make shortmess call longmess instead
require Exporter;
@no-spam = ('Exporter');
@@no-spam -135,6 +196,13 @@no-spam
@no-spam = qw(cluck verbose longmess shortmess);
@no-spam = qw(verbose); # hook to enable verbose mode
+=head1 BUGS
+
+The Carp routines don't handle exception objects currently.
+If called with a first argument that is a reference, they simply
+call die() or warn(), as appropriate.
+
+=cut
# if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
# then the following method will be called by the Exporter which knows
==== //depot/maint-5.8/perl/lib/Carp.t#3 (text) ====
Index: perl/lib/Carp.t
--- perl/lib/Carp.t#2~22981~ Wed Jun 23 06:08:18 2004
+++ perl/lib/Carp.t Fri Sep 10 03:56:43 2004
@@no-spam -5,19 +5,19 @@no-spam
use Carp qw(carp cluck croak confess);
-print "1..9\n";
+print "1..19\n";
print "ok 1\n";
$SIG{__WARN__} = sub {
print "ok $1\n"
- if $_[0] =~ m!ok (\d+)\n at .+\b(?i:carp\.t) line \d+$! };
+ if $_[0] =~ m!ok (\d+)\n at.+\b(?i:carp\.t) line \d+$! };
carp "ok 2\n";
-
+
$SIG{__WARN__} = sub {
print "ok $1\n"
- if $_[0] =~ m!(\d+) at .+\b(?i:carp\.t) line \d+$! };
+ if $_[0] =~ m!(\d+) at.+\b(?i:carp\.t) line \d+$! };
carp 3;
@@no-spam -25,7 +25,7 @@no-spam
$SIG{__WARN__} = sub {
print "ok $1\n"
- if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at .+\b(?i:carp\.t) line \d+$! };
+ if $_[0] =~ m!^(\d+) at.+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at.+\b(?i:carp\.t) line \d+$! };
cluck 4;
@@no-spam -35,14 +35,14 @@no-spam
$SIG{__DIE__} = sub {
print "ok $1\n"
- if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at .+\b(?i:carp\.t) line \d+$! };
+ if $_[0] =~ m!^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+$! };
eval { croak 5 };
sub sub_6 {
$SIG{__DIE__} = sub {
print "ok $1\n"
- if $_[0] =~ m!^(\d+) at .+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at .+\b(?i:carp\.t) line \d+\n\tmain::sub_6\(\) called at .+\b(?i:carp\.t) line \d+$! };
+ if $_[0] =~ m!^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+\n\tmain::sub_6\(\) called at.+\b(?i:carp\.t) line \d+$! };
eval { confess 6 };
}
@@no-spam -65,7 +65,98 @@no-spam
$SIG{__WARN__} =
sub { if( defined $^S ){ warn $_[0] } else { $warning = $_[0] } }
}
- package Z;
+ package Z;
BEGIN { eval { Carp::croak() } }
};
print $warning ? "not ok 9\n#$warning" : "ok 9\n";
+
+
+# tests for global variables
+sub x { carp @no-spam }
+sub w { cluck @no-spam }
+
+# $Carp::Verbose;
+{ my $aref = [
+ qr/t at \S*Carp.t line \d+/,
+ qr/t at \S*Carp.t line \d+\n\s*main::x\('t'\) called at \S*Carp.t line \d+/
+ ];
+ my $test_num = 10; my $i = 0;
+
+ for my $re (@no-spam {
+ local $Carp::Verbose = $i++;
+ local $SIG{__WARN__} = sub {
+ print "not " unless $_[0] =~ $re;
+ print "ok ".$test_num++." - Verbose\n";
+ };
+ package Z;
+ main::x('t');
+ }
+}
+
+# $Carp::MaxEvalLen
+{ my $test_num = 12;
+ for(0,4) {
+ my $txt = "Carp::cluck($test_num)";
+ local $Carp::MaxEvalLen = $_;
+ local $SIG{__WARN__} = sub {
+ "@no-spam"=~/'(.+?)(?:\n|')/s;
+ print "not " unless length $1 eq length $_?substr($txt,0,$_):substr($txt,0);
+ print "ok $test_num - MaxEvalLen\n";
+ };
+ eval "$txt"; $test_num++;
+ }
+}
+
+# $Carp::MaxArgLen
+{ my $test_num = 14;
+ for(0,4) {
+ my $arg = 'testtest';
+ local $Carp::MaxArgLen = $_;
+ local $SIG{__WARN__} = sub {
+ "@no-spam"=~/'(.+?)'/;
+ print "not " unless length $1 eq length $_?substr($arg,0,$_):substr($arg,0);
+ print "ok ".$test_num++." - MaxArgLen\n";
+ };
+
+ package Z;
+ main::w($arg);
+ }
+}
+
+# $Carp::MaxArgNums
+{ my $test_num = 16; my $i = 0;
+ my $aref = [
+ qr/1234 at \S*Carp.t line \d+\n\s*main::w\(1, 2, 3, 4\) called at \S*Carp.t line \d+/,
+ qr/1234 at \S*Carp.t line \d+\n\s*main::w\(1, 2, \.\.\.\) called at \S*Carp.t line \d+/,
+ ];
+
+ for(@no-spam {
+ local $Carp::MaxArgNums = $i++;
+ local $SIG{__WARN__} = sub {
+ print "not " unless "@no-spam"=~$_;
+ print "ok ".$test_num++." - MaxArgNums\n";
+ };
+
+ package Z;
+ main::w(1..4);
+ }
+}
+
+# $Carp::CarpLevel
+{ my $test_num = 18; my $i = 0;
+ my $aref = [
+ qr/1 at \S*Carp.t line \d+\n\s*main::w\(1\) called at \S*Carp.t line \d+/,
+ qr/1 at \S*Carp.t line \d+$/,
+ ];
+
+ for (@no-spam {
+ local $Carp::CarpLevel = $i++;
+ local $SIG{__WARN__} = sub {
+ print "not " unless "@no-spam"=~$_;
+ print "ok ".$test_num++." - CarpLevel\n";
+ };
+
+ package Z;
+ main::w(1);
+ }
+}
==== //depot/maint-5.8/perl/lib/diagnostics.pm#9 (xtext) ====
Index: perl/lib/diagnostics.pm
--- perl/lib/diagnostics.pm#8~23038~ Sun Jul 4 14:22:18 2004
+++ perl/lib/diagnostics.pm Fri Sep 10 03:56:43 2004
@@no-spam -19,6 +19,10 @@no-spam
perl program 2>diag.out
splain [-v] [-p] diag.out
+Using diagnostics to get stack traces from a misbehaving script:
+
+ perl -Mdiagnostics=-traceonly my_script.pl
+
=head1 DESCRIPTION
=head2 The C<diagnostics> Pragma
@@no-spam -53,6 +57,17 @@no-spam
descriptions). User code generated warnings a la warn() are unaffected,
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
+the stack traces. So if your script is dieing, run it again with
+
+ perl -Mdiagnostics=-traceonly my_bad_script
+
+to see the call stack at the time of death. By supplying the B<-warntrace>
+(or just B<-w>) flag, any warnings emitted will also come with a stack
+trace.
+
=head2 The I<splain> Program
While apparently a whole nuther program, I<splain> is actually nothing
@@no-spam -167,11 +182,14 @@no-spam
use strict;
use 5.006;
use Carp;
+$Carp::Internal{__PACKAGE__.""}++;
-our $VERSION = 1.13;
+our $VERSION = 1.14;
our $DEBUG;
our $VERBOSE;
our $PRETTY;
+our $TRACEONLY = 0;
+our $WARNTRACE = 0;
use Config;
my($privlib, $archlib) = @no-spam archlibexp)};
@@no-spam -448,6 +466,15 @@no-spam
next;
};
+ /^-t(race)?$/ && do {
+ $TRACEONLY++;
+ next;
+ };
+ /^-w(arntrace)?$/ && do {
+ $WARNTRACE++;
+ next;
+ };
+
warn "Unknown flag: $_";
}
@@no-spam -469,9 +496,13 @@no-spam
sub warn_trap {
my $warning = $_[0];
if (caller eq $WHOAMI or !splainthis($warning)) {
- print STDERR $warning;
+ if ($WARNTRACE) {
+ print STDERR Carp::longmess($warning);
+ } else {
+ print STDERR $warning;
+ }
}
- &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap;
+ goto &$oldwarn if defined $oldwarn and $oldwarn and $oldwarn ne \&warn_trap;
};
sub death_trap {
@@no-spam -481,8 +512,7 @@no-spam
# want to explain the exception because it's going to get caught.
my $in_eval = 0;
my $i = 0;
- while (1) {
- my $caller = (caller($i++))[3] or last;
+ while (my $caller = (caller($i++))[3]) {
if ($caller eq '(eval)') {
$in_eval = 1;
last;
@@no-spam -516,6 +546,7 @@no-spam
my $count;
my $wantspace;
sub splainthis {
+ return 0 if $TRACEONLY;
local $_ = shift;
local $\;
### &finish_compilation unless %msg;
End of Patch.