Skip to content

Commit

Permalink
Fix perl #132902 - Carp: avoid infinite loops when checking for overl…
Browse files Browse the repository at this point in the history
…oads

We use $obj->can("((") to see if a package has enabled overloads,
however in some cases can() is overridden with a custom implementation,
which may be unaware of these methods and then call Carp itself. This
then results in an infinite loop. An example is Class::Std v0.013.
While technically this is a bug in whatever overrides UNIVERSAL::can(),
Carp is so prolific in its use that we might as well treat it as a Carp
bug also and avoid the problem outright.

See also: chorny/Class-Std#2
  • Loading branch information
demerphq committed Feb 24, 2018
1 parent 6ccface commit 17157c4
Show file tree
Hide file tree
Showing 3 changed files with 43 additions and 14 deletions.
24 changes: 24 additions & 0 deletions dist/Carp/Changes
Original file line number Diff line number Diff line change
@@ -1,3 +1,27 @@
version 1.48

* guard against hand-rolled UNIVERSAL::can() implementations
which throw exceptions when we call $obj->can("((").

version 1.47, 1.47_02

* Deal with overloading when overload.pm is not use

* Note 1.47_02 only existed for one commit in blead-perl,
and in fact no 1.47 should ever see the wild.

version 1.47, 1.47_01

* Do not die on trappable stack-not-refcounted bugs while
serializing the stack.

* Note 1.47_01 only existed for one commit in blead-perl,
and in fact no 1.47 should ever see the wild.

version 1.46

* avoid vivifying UNIVERSAL::isa:: in Carp

version 1.45

* Optimize format_arg when arguments contain many references
Expand Down
31 changes: 18 additions & 13 deletions dist/Carp/lib/Carp.pm
Original file line number Diff line number Diff line change
Expand Up @@ -116,7 +116,7 @@ BEGIN {
;
}

our $VERSION = '1.47';
our $VERSION = '1.48';
$VERSION =~ tr/_//d;

our $MaxEvalLen = 0;
Expand Down Expand Up @@ -336,18 +336,23 @@ sub format_arg {
}
else
{
if ($pack->can("((")) {
# Argument is blessed into a class with overloading, and
# so might have an overloaded stringification. We don't
# want to risk getting the overloaded stringification,
# so we need to use overload::StrVal() below. But it's
# possible that the overload module hasn't been loaded:
# overload methods can be installed without it. So load
# the module here. The bareword form of require is here
# eschewed to avoid iths compile-time effect of vivifying
# vivifying the target module's stash.
require "overload.pm"
or return "use overload failed";
# overload uses the presence of a special "method" name "((" to signal
# it is in effect. This test seeks to see if it has been set up.
# In theory we should be able to use 'can' without the $in_recurse guard,
# but this breaks modules that call overloads or croak during can(), for
# instance Class::Std v0.013, so if we end up here twice, we will just
# load overload outright.
if ($in_recurse || do{ local $in_recurse = 1; $pack->can("((") }) {
# Argument is blessed into a class with overloading, and
# so might have an overloaded stringification. We don't
# want to risk getting the overloaded stringification,
# so we need to use overload::StrVal() below. But it's
# possible that the overload module hasn't been loaded:
# overload methods can be installed without it. So load
# the module here. The bareword form of require is here
# eschewed to avoid this compile-time effect of vivifying
# the target module's stash.
require "overload.pm";
}
my $sub = _fetch_sub(overload => 'StrVal');
return $sub ? &$sub($arg) : "$arg";
Expand Down
2 changes: 1 addition & 1 deletion dist/Carp/lib/Carp/Heavy.pm
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@ package Carp::Heavy;

use Carp ();

our $VERSION = '1.47';
our $VERSION = '1.48';
$VERSION =~ tr/_//d;

# Carp::Heavy was merged into Carp in version 1.12. Any mismatched versions
Expand Down

0 comments on commit 17157c4

Please sign in to comment.