This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[PATCH} typo fix in Carp/Heavy.pm
[perl5.git]
/
lib
/
Carp
/
Heavy.pm
diff --git
a/lib/Carp/Heavy.pm
b/lib/Carp/Heavy.pm
index
9d3e000
..
cf10892
100644
(file)
--- a/
lib/Carp/Heavy.pm
+++ b/
lib/Carp/Heavy.pm
@@
-12,7
+12,7
@@
Carp heavy machinery - no user serviceable parts inside
# On one line so MakeMaker will see it.
use Carp; our $VERSION = $Carp::VERSION;
# On one line so MakeMaker will see it.
use Carp; our $VERSION = $Carp::VERSION;
-our ($CarpLevel, $MaxArgNums, $MaxEvalLen, $Max
LenArg
, $Verbose);
+our ($CarpLevel, $MaxArgNums, $MaxEvalLen, $Max
ArgLen
, $Verbose);
sub caller_info {
my $i = shift(@_) + 1;
sub caller_info {
my $i = shift(@_) + 1;
@@
-28,8
+28,7
@@
sub caller_info {
my $sub_name = Carp::get_subname(\%call_info);
if ($call_info{has_args}) {
my $sub_name = Carp::get_subname(\%call_info);
if ($call_info{has_args}) {
- # Reuse the @args array to avoid warnings. :-)
- local @args = map {Carp::format_arg($_)} @args;
+ my @args = map {Carp::format_arg($_)} @DB::args;
if ($MaxArgNums and @args > $MaxArgNums) { # More than we want to show?
$#args = $MaxArgNums;
push @args, '...';
if ($MaxArgNums and @args > $MaxArgNums) { # More than we want to show?
$#args = $MaxArgNums;
push @args, '...';
@@
-51,7
+50,7
@@
sub format_arg {
$arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
}
$arg =~ s/'/\\'/g;
$arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
}
$arg =~ s/'/\\'/g;
- $arg = str_len_trim($arg, $Max
LenArg
);
+ $arg = str_len_trim($arg, $Max
ArgLen
);
# Quote it?
$arg = "'$arg'" unless $arg =~ /^-?[\d.]+\z/;
# Quote it?
$arg = "'$arg'" unless $arg =~ /^-?[\d.]+\z/;
@@
-78,14
+77,14
@@
sub get_status {
# the sub/require/eval
sub get_subname {
my $info = shift;
# the sub/require/eval
sub get_subname {
my $info = shift;
- if (defined($info->{eval})) {
- my $eval = $info->{eval};
+ if (defined($info->{eval
text
})) {
+ my $eval = $info->{eval
text
};
if ($info->{is_require}) {
return "require $eval";
}
else {
$eval =~ s/([\\\'])/\\$1/g;
if ($info->{is_require}) {
return "require $eval";
}
else {
$eval =~ s/([\\\'])/\\$1/g;
- return
str_len_trim($eval, $MaxEvalLen)
;
+ return
"eval '" . str_len_trim($eval, $MaxEvalLen) . "'"
;
}
}
}
}
@@
-120,7
+119,7
@@
sub long_error_loc {
sub longmess_heavy {
sub longmess_heavy {
- return @_ if ref($_[0]); #
WHAT IS THIS FOR???
+ return @_ if ref($_[0]); #
don't break references as exceptions
my $i = long_error_loc();
return ret_backtrace($i, @_);
}
my $i = long_error_loc();
return ret_backtrace($i, @_);
}
@@
-139,19
+138,19
@@
sub ret_backtrace {
$tid_msg = " thread $tid" if $tid;
}
$tid_msg = " thread $tid" if $tid;
}
- if ($err =~ /\n$/) {
+ { if ($err =~ /\n$/) { # extra block to localise $1 etc
$mess = $err;
}
else {
my %i = caller_info($i);
$mess = "$err at $i{file} line $i{line}$tid_msg\n";
$mess = $err;
}
else {
my %i = caller_info($i);
$mess = "$err at $i{file} line $i{line}$tid_msg\n";
- }
+ }
}
while (my %i = caller_info(++$i)) {
$mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
}
while (my %i = caller_info(++$i)) {
$mess .= "\t$i{sub_name} called at $i{file} line $i{line}$tid_msg\n";
}
- return $mess
|| $err
;
+ return $mess;
}
sub ret_summary {
}
sub ret_summary {
@@
-190,7
+189,7
@@
sub short_error_loc {
sub shortmess_heavy {
return longmess_heavy(@_) if $Verbose;
sub shortmess_heavy {
return longmess_heavy(@_) if $Verbose;
- return @_ if ref($_[0]); #
WHAT IS THIS FOR???
+ return @_ if ref($_[0]); #
don't break references as exceptions
my $i = short_error_loc();
if ($i) {
ret_summary($i, @_);
my $i = short_error_loc();
if ($i) {
ret_summary($i, @_);
@@
-237,7
+236,10
@@
sub trusts {
# Takes a package and gives a list of those trusted directly
sub trusts_directly {
my $class = shift;
# Takes a package and gives a list of those trusted directly
sub trusts_directly {
my $class = shift;
- return @{"$class\::ISA"};
+ no strict 'refs';
+ return @{"$class\::CARP_NOT"}
+ ? @{"$class\::CARP_NOT"}
+ : @{"$class\::ISA"};
}
1;
}
1;