diff options
Diffstat (limited to 'dist/Safe/Safe.pm')
| -rw-r--r-- | dist/Safe/Safe.pm | 25 |
1 files changed, 23 insertions, 2 deletions
diff --git a/dist/Safe/Safe.pm b/dist/Safe/Safe.pm index 6926a4e369..4313263952 100644 --- a/dist/Safe/Safe.pm +++ b/dist/Safe/Safe.pm @@ -2,6 +2,9 @@ package Safe; use 5.003_11; use strict; +use Scalar::Util qw(reftype); +use Config qw(%Config); +use constant is_usethreads => $Config{usethreads}; $Safe::VERSION = "2.19"; @@ -288,8 +291,26 @@ sub reval { my ($obj, $expr, $strict) = @_; my $root = $obj->{Root}; - my $evalsub = lexless_anon_sub($root,$strict, $expr); - return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); + my $evalsub = lexless_anon_sub($root, $strict, $expr); + my @ret = (wantarray) + ? Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub) + : scalar Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); + + # RT#60374: Safe.pm sort {} bug with -Dusethreads + # If the Safe eval returns a code ref in a perl compiled with usethreads + # then wrap code ref with _safe_call_sv so that, when called, the + # execution will happen with the compartment fully 'in effect'. + # Needed to fix sort blocks that reference $a & $b and + # possibly other subtle issues. + if (is_usethreads()) { + for my $ret (@ret) { # edit (via alias) any CODE refs + next unless (reftype($ret)||'') eq 'CODE'; + my $sub = $ret; # avoid closure problems + $ret = sub { Opcode::_safe_call_sv($root, $obj->{Mask}, $sub) }; + } + } + + return (wantarray) ? @ret : $ret[0]; } sub rdo { |