package Carp;
-our $VERSION = '1.04';
+our $VERSION = '1.07';
+# this file is an utra-lightweight stub. The first time a function is
+# called, Carp::Heavy is loaded, and the real short/longmessmess_jmp
+# subs are installed
+
+our $MaxEvalLen = 0;
+our $Verbose = 0;
+our $CarpLevel = 0;
+our $MaxArgLen = 64; # How much of each argument to print. 0 = all.
+our $MaxArgNums = 8; # How many arguments to print. 0 = all.
+
+require Exporter;
+our @ISA = ('Exporter');
+our @EXPORT = qw(confess croak carp);
+our @EXPORT_OK = qw(cluck verbose longmess shortmess);
+our @EXPORT_FAIL = qw(verbose); # hook to enable verbose mode
+
+# if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
+# then the following method will be called by the Exporter which knows
+# to do this thanks to @EXPORT_FAIL, above. $_[1] will contain the word
+# 'verbose'.
+
+sub export_fail { shift; $Verbose = shift if $_[0] eq 'verbose'; @_ }
+
+# fixed hooks for stashes to point to
+sub longmess { goto &longmess_jmp }
+sub shortmess { goto &shortmess_jmp }
+# these two are replaced when Carp::Heavy is loaded
+sub longmess_jmp {
+ local($@, $!);
+ eval { require Carp::Heavy };
+ return $@ if $@;
+ goto &longmess_real;
+}
+sub shortmess_jmp {
+ local($@, $!);
+ eval { require Carp::Heavy };
+ return $@ if $@;
+ goto &shortmess_real;
+}
+
+sub croak { die shortmess @_ }
+sub confess { die longmess @_ }
+sub carp { warn shortmess @_ }
+sub cluck { warn longmess @_ }
+
+1;
+__END__
=head1 NAME
confess - die of errors with stack backtrace
-shortmess - return the message that carp and croak produce
-
-longmess - return the message that cluck and confess produce
-
=head1 SYNOPSIS
use Carp;
use Carp qw(cluck);
cluck "This is how we got here!";
- print FH Carp::shortmess("This will have caller's details added");
- print FH Carp::longmess("This will have stack backtrace added");
-
=head1 DESCRIPTION
The Carp routines are useful in your own modules because
they act like die() or warn(), but with a message which is more
likely to be useful to a user of your module. In the case of
cluck, confess, and longmess that context is a summary of every
-call in the call-stack. For a shorter message you can use carp,
-croak or shortmess which report the error as being from where
-your module was called. There is no guarantee that that is where
-the error was, but it is a good educated guess.
+call in the call-stack. For a shorter message you can use C<carp>
+or C<croak> which report the error as being from where 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
-call is marked safe, it then gives up and gives a full stack
-backtrace instead. In other words it presumes that the first likely
-looking potential suspect is guilty. Its rules for telling whether
+Here is a more complete description of how c<carp> and c<croak> work.
+What they do is search the call-stack for a function call stack where
+they have not been told that there shouldn't be an error. If every
+call is marked safe, they give up and give a full stack backtrace
+instead. In other words they presume that the first likely looking
+potential suspect is guilty. Their rules for telling whether
a call shouldn't generate errors work as follows:
=over 4
=item 2.
Packages claim that there won't be errors on calls to or from
-packages explicitly marked as safe by inclusion in @CARP_NOT, or
-(if that array is empty) @ISA. The ability to override what
+packages explicitly marked as safe by inclusion in C<@CARP_NOT>, or
+(if that array is empty) C<@ISA>. The ability to override what
@ISA says is new in 5.8.
=item 3.
The trust in item 2 is transitive. If A trusts B, and B
-trusts C, then A trusts C. So if you do not override @ISA
-with @CARP_NOT, then this trust relationship is identical to,
+trusts C, then A trusts C. So if you do not override C<@ISA>
+with C<@CARP_NOT>, then this trust relationship is identical to,
"inherits from".
=item 4.
=item 5.
-Any call to Carp is safe. (This rule is what keeps it from
-reporting the error where you call carp/croak/shortmess.)
+Any call to Perl's warning system (eg Carp itself) is safe.
+(This rule is what keeps it from reporting the error at the
+point where you call C<carp> or C<croak>.)
+
+=item 6.
+
+C<$Carp::CarpLevel> can be set to skip a fixed number of additional
+call levels. Using this is not recommended because it is very
+difficult to get it to behave correctly.
=back
Alternately, you can set the global variable C<$Carp::Verbose> to true.
See the C<GLOBAL VARIABLES> section below.
-=cut
-
-# This package is heavily used. Be small. Be fast. Be good.
-
-# Comments added by Andy Wardley <abw@kfs.org> 09-Apr-98, based on an
-# _almost_ complete understanding of the package. Corrections and
-# comments are welcome.
-
-# The members of %Internal are packages that are internal to perl.
-# Carp will not report errors from within these packages if it
-# can. The members of %CarpInternal are internal to Perl's warning
-# system. Carp will not report errors from within these packages
-# either, and will not report calls *to* these packages for carp and
-# croak. They replace $CarpLevel, which is deprecated. The
-# $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@dwim.org> 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(@_) }
-
-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
=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'>.
+This variable makes C<carp> and C<cluck> generate stack backtraces
+just like C<cluck> and C<confess>. This is how C<use Carp 'verbose'>
+is implemented internally.
Defaults to C<0>.
-=cut
-
-# disable these by default, so they can live w/o require Carp
-$CarpInternal{Carp}++;
-$CarpInternal{warnings}++;
-$Internal{Exporter}++;
-$Internal{'Exporter::Heavy'}++;
-$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
+=head2 %Carp::Internal
-require Exporter;
-@ISA = ('Exporter');
-@EXPORT = qw(confess croak carp);
-@EXPORT_OK = qw(cluck verbose longmess shortmess);
-@EXPORT_FAIL = qw(verbose); # hook to enable verbose mode
+This says what packages are internal to Perl. C<Carp> will never
+report an error as being from a line in a package that is internal to
+Perl. For example:
-=head1 BUGS
+ $Carp::Internal{ __PACKAGE__ }++;
+ # time passes...
+ sub foo { ... or confess("whatever") };
-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.
+would give a full stack backtrace starting from the first caller
+outside of __PACKAGE__. (Unless that package was also internal to
+Perl.)
-=cut
+=head2 %Carp::CarpInternal
-# if the caller specifies verbose usage ("perl -MCarp=verbose script.pl")
-# then the following method will be called by the Exporter which knows
-# to do this thanks to @EXPORT_FAIL, above. $_[1] will contain the word
-# 'verbose'.
+This says which packages are internal to Perl's warning system. For
+generating a full stack backtrace this is the same as being internal
+to Perl, the stack backtrace will not start inside packages that are
+listed in C<%Carp::CarpInternal>. But it is slightly different for
+the summary message generated by C<carp> or C<croak>. There errors
+will not be reported on any lines that are calling packages in
+C<%Carp::CarpInternal>.
-sub export_fail {
- shift;
- $Verbose = shift if $_[0] eq 'verbose';
- return @_;
-}
-
-
-# longmess() crawls all the way up the stack reporting on all the function
-# calls made. The error string, $error, is originally constructed from the
-# arguments passed into longmess() via confess(), cluck() or shortmess().
-# This gets appended with the stack trace messages which are generated for
-# each function call on the stack.
-
-sub longmess {
- {
- local($@, $!);
- # XXX fix require to not clear $@ or $!?
- # don't use require unless we need to (for Safe compartments)
- require Carp::Heavy unless $INC{"Carp/Heavy.pm"};
- }
- # Icky backwards compatibility wrapper. :-(
- my $call_pack = caller();
- if ($Internal{$call_pack} or $CarpInternal{$call_pack}) {
- return longmess_heavy(@_);
- }
- else {
- local $CarpLevel = $CarpLevel + 1;
- return longmess_heavy(@_);
- }
-}
+For example C<Carp> itself is listed in C<%Carp::CarpInternal>.
+Therefore the full stack backtrace from C<confess> will not start
+inside of C<Carp>, and the short message from calling C<croak> is
+not placed on the line where C<croak> was called.
+=head2 $Carp::CarpLevel
-# shortmess() is called by carp() and croak() to skip all the way up to
-# the top-level caller's package and report the error from there. confess()
-# and cluck() generate a full stack trace so they call longmess() to
-# generate that. In verbose mode shortmess() calls longmess() so
-# you always get a stack trace
-
-sub shortmess { # Short-circuit &longmess if called via multiple packages
- {
- local($@, $!);
- # XXX fix require to not clear $@ or $!?
- # don't use require unless we need to (for Safe compartments)
- require Carp::Heavy unless $INC{"Carp/Heavy.pm"};
- }
- # Icky backwards compatibility wrapper. :-(
- my $call_pack = caller();
- local @CARP_NOT = caller();
- shortmess_heavy(@_);
-}
+This variable determines how many additional call frames are to be
+skipped that would not otherwise be when reporting where an error
+occurred on a call to one of C<Carp>'s functions. It is fairly easy
+to count these call frames on calls that generate a full stack
+backtrace. However it is much harder to do this accounting for calls
+that generate a short message. Usually people skip too many call
+frames. If they are lucky they skip enough that C<Carp> goes all of
+the way through the call stack, realizes that something is wrong, and
+then generates a full stack backtrace. If they are unlucky then the
+error is reported from somewhere misleading very high in the call
+stack.
+
+Therefore it is best to avoid C<$Carp::CarpLevel>. Instead use
+C<@CARP_NOT>, C<%Carp::Internal> and %Carp::CarpInternal>.
+Defaults to C<0>.
-# the following four functions call longmess() or shortmess() depending on
-# whether they should generate a full stack trace (confess() and cluck())
-# or simply report the caller's package (croak() and carp()), respectively.
-# confess() and croak() die, carp() and cluck() warn.
+=head1 BUGS
-sub croak { die shortmess @_ }
-sub confess { die longmess @_ }
-sub carp { warn shortmess @_ }
-sub cluck { warn longmess @_ }
+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.
-1;
use Carp qw(carp cluck croak confess);
-plan tests => 21;
+plan tests => 36;
ok 1;
};
ok !$warning, q/'...::CARP_NOT used only once' warning from Carp::Heavy/;
+# Test the location of error messages.
+like(A::short(), qr/^Error at C/, "Short messages skip carped package");
+
+{
+ local @C::ISA = "D";
+ like(A::short(), qr/^Error at B/, "Short messages skip inheritance");
+}
+
+{
+ local @D::ISA = "C";
+ like(A::short(), qr/^Error at B/, "Short messages skip inheritance");
+}
+
+{
+ local @D::ISA = "B";
+ local @B::ISA = "C";
+ like(A::short(), qr/^Error at A/, "Inheritance is transitive");
+}
+
+{
+ local @B::ISA = "D";
+ local @C::ISA = "B";
+ like(A::short(), qr/^Error at A/, "Inheritance is transitive");
+}
+
+{
+ local @C::CARP_NOT = "D";
+ like(A::short(), qr/^Error at B/, "Short messages see \@CARP_NOT");
+}
+
+{
+ local @D::CARP_NOT = "C";
+ like(A::short(), qr/^Error at B/, "Short messages see \@CARP_NOT");
+}
+
+{
+ local @D::CARP_NOT = "B";
+ local @B::CARP_NOT = "C";
+ like(A::short(), qr/^Error at A/, "\@CARP_NOT is transitive");
+}
+
+{
+ local @B::CARP_NOT = "D";
+ local @C::CARP_NOT = "B";
+ like(A::short(), qr/^Error at A/, "\@CARP_NOT is transitive");
+}
+
+{
+ local @D::ISA = "C";
+ local @D::CARP_NOT = "B";
+ like(A::short(), qr/^Error at C/, "\@CARP_NOT overrides inheritance");
+}
+
+{
+ local @D::ISA = "B";
+ local @D::CARP_NOT = "C";
+ like(A::short(), qr/^Error at B/, "\@CARP_NOT overrides inheritance");
+}
+
+# %Carp::Internal
+{
+ local $Carp::Internal{C} = 1;
+ like(A::short(), qr/^Error at B/, "Short doesn't report Internal");
+}
+
+{
+ local $Carp::Internal{D} = 1;
+ like(A::long(), qr/^Error at C/, "Long doesn't report Internal");
+}
+
+# %Carp::CarpInternal
+{
+ local $Carp::CarpInternal{D} = 1;
+ like(A::short(), qr/^Error at B/
+ , "Short doesn't report calls to CarpInternal");
+}
+
+{
+ local $Carp::CarpInternal{D} = 1;
+ like(A::long(), qr/^Error at C/, "Long doesn't report CarpInternal");
+}
# tests for global variables
sub x { carp @_ }
}
}
-
{
local $TODO = "VMS exit status semantics don't work this way" if $Is_VMS;
is($?>>8, 42, 'confess() doesn\'t clobber $!');
}
+
+# line 1 "A"
+package A;
+sub short {
+ B::short();
+}
+
+sub long {
+ B::long();
+}
+
+# line 1 "B"
+package B;
+sub short {
+ C::short();
+}
+
+sub long {
+ C::long();
+}
+
+# line 1 "C"
+package C;
+sub short {
+ D::short();
+}
+
+sub long {
+ D::long();
+}
+
+# line 1 "D"
+package D;
+sub short {
+ eval{ Carp::croak("Error") };
+ return $@;
+}
+
+sub long {
+ eval{ Carp::confess("Error") };
+ return $@;
+}
=cut
-# use strict; # not yet
-
# On one line so MakeMaker will see it.
use Carp; our $VERSION = $Carp::VERSION;
+# use strict; # not yet
+
+# 'use Carp' just installs some very lightweight stubs; the first time
+# these are called, they require Carp::Heavy which installs the real
+# routines.
+
+# The members of %Internal are packages that are internal to perl.
+# Carp will not report errors from within these packages if it
+# can. The members of %CarpInternal are internal to Perl's warning
+# system. Carp will not report errors from within these packages
+# either, and will not report calls *to* these packages for carp and
+# croak. They replace $CarpLevel, which is deprecated. The
+# $Max(EvalLen|(Arg(Len|Nums)) variables are used to specify how the eval
+# text and function arguments should be formatted when printed.
+
+# disable these by default, so they can live w/o require Carp
+$CarpInternal{Carp}++;
+$CarpInternal{warnings}++;
+$Internal{Exporter}++;
+$Internal{'Exporter::Heavy'}++;
+
our ($CarpLevel, $MaxArgNums, $MaxEvalLen, $MaxArgLen, $Verbose);
+# XXX longmess_real and shortmess_real should really be merged into
+# XXX {long|sort}mess_heavy at some point
+
+sub longmess_real {
+ # Icky backwards compatibility wrapper. :-(
+ #
+ # The story is that the original implementation hard-coded the
+ # number of call levels to go back, so calls to longmess were off
+ # by one. Other code began calling longmess and expecting this
+ # behaviour, so the replacement has to emulate that behaviour.
+ my $call_pack = caller();
+ if ($Internal{$call_pack} or $CarpInternal{$call_pack}) {
+ return longmess_heavy(@_);
+ }
+ else {
+ local $CarpLevel = $CarpLevel + 1;
+ return longmess_heavy(@_);
+ }
+};
+
+sub shortmess_real {
+ # Icky backwards compatibility wrapper. :-(
+ local @CARP_NOT = caller();
+ shortmess_heavy(@_);
+};
+
+# replace the two hooks added by Carp
+
+# aliasing the whole glob rather than just the CV slot avoids 'redefined'
+# warnings, even in the presence of perl -W (as used by lib/warnings.t !)
+# However it has the potential to create infinite loops, if somehow Carp
+# is forcibly reloaded, but $INC{"Carp/Heavy.pm"} remains true.
+# Hence the extra hack of deleting the previous typeglob first.
+
+delete $Carp::{shortmess_jmp};
+delete $Carp::{longmess_jmp};
+*longmess_jmp = *longmess_real;
+*shortmess_jmp = *shortmess_real;
+
+
sub caller_info {
my $i = shift(@_) + 1;
package DB;
sub short_error_loc {
- my $cache;
+ # You have to create your (hash)ref out here, rather than defaulting it
+ # inside trusts *on a lexical*, as you want it to persist across calls.
+ # (You can default it on $_[2], but that gets messy)
+ my $cache = {};
my $i = 1;
my $lvl = $CarpLevel;
{
my $called = caller($i++);
my $caller = caller($i);
+
return 0 unless defined($caller); # What happened?
redo if $Internal{$caller};
+ redo if $CarpInternal{$caller};
redo if $CarpInternal{$called};
redo if trusts($called, $caller, $cache);
redo if trusts($caller, $called, $cache);
return $i - 1;
}
+
sub shortmess_heavy {
return longmess_heavy(@_) if $Verbose;
return @_ if ref($_[0]); # don't break references as exceptions
sub trusts {
my $child = shift;
my $parent = shift;
- my $cache = shift || {};
+ my $cache = shift;
my ($known, $partial) = get_status($cache, $child);
# Figure out consequences until we have an answer
while (@$partial and not exists $known->{$parent}) {
https://perl5.git.perl.org / perl5.git / commitdiff