diff options
author | Nicholas Clark <nick@ccl4.org> | 2010-07-21 20:17:47 +0100 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2010-07-21 20:24:27 +0100 |
commit | eff7e72c3d4dda827de2e7b972c08a37cbcf607e (patch) | |
tree | 21f52a66cd4dd87080280dc3fce2153aa667724c /lib/Carp.pm | |
parent | 8af6f9854c44f2d52182097da3cf09138646e6a2 (diff) | |
download | perl-eff7e72c3d4dda827de2e7b972c08a37cbcf607e.tar.gz |
Detect incomplete caller overrides in Carp, and avoid using bogus @DB::args.
To get arguments into its backtraces, Carp relies on caller setting @DB::args
when called from package DB. @DB::args isn't refcounted (and can't be). Not
all overriders of &CORE::GLOBAL::caller set @DB::args properly, with the result
that @DB::arg can become "stale", with strange errors, at a distance.
However, it is possible to detect that @DB::args has not been updated, and take
evasive action. This is preferable to presenting the user (or logfile) with
silently wrong backtraces, and much preferable to the occasional "Bizarre copy"
exception.
Diffstat (limited to 'lib/Carp.pm')
-rw-r--r-- | lib/Carp.pm | 8 |
1 files changed, 7 insertions, 1 deletions
diff --git a/lib/Carp.pm b/lib/Carp.pm index add42d27fe..cb86f9cdd8 100644 --- a/lib/Carp.pm +++ b/lib/Carp.pm @@ -69,6 +69,7 @@ sub caller_info { my %call_info; { package DB; + @args = \$i; # A sentinal, which no-one else has the address of @call_info{ qw(pack file line sub has_args wantarray evaltext is_require) } = defined &{"CORE::GLOBAL::caller"} ? &{"CORE::GLOBAL::caller"}($i) : caller($i); @@ -80,7 +81,12 @@ sub caller_info { my $sub_name = Carp::get_subname(\%call_info); if ($call_info{has_args}) { - my @args = map {Carp::format_arg($_)} @DB::args; + my @args; + if (@DB::args == 1 && ref $DB::args[0] eq ref \$i && $DB::args[0] == \$i) { + @args = "** Incomplete caller override detected; \@DB::args were not set **"; + } else { + @args = map {Carp::format_arg($_)} @DB::args; + } if ($MaxArgNums and @args > $MaxArgNums) { # More than we want to show? $#args = $MaxArgNums; push @args, '...'; |