In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/83452f8ea6ad77da7b6d12f161eedb3db3e647f3?hp=a57c668520b9767f7a6c93e0a396cee792a98be5>
- Log -----------------------------------------------------------------
commit 83452f8ea6ad77da7b6d12f161eedb3db3e647f3
Author: Rafael Garcia-Suarez <r...@consttype.org>
Date: Thu Jan 14 22:45:18 2010 +0100
Bump version to 2.21 and add changelog
M dist/Safe/Changes
M dist/Safe/META.yml
M dist/Safe/Safe.pm
commit ebe5824be753acd9437b38ff9f30083d65211a9b
Author: Tim Bunce <tim.bu...@pobox.com>
Date: Thu Jan 14 14:50:03 2010 +0000
Fixed the closure argument passing bug perl#72068
M dist/Safe/Safe.pm
commit bb92c7667b2747525c85274e2ca8a9996b44c402
Author: Tim Bunce <tim.bu...@pobox.com>
Date: Thu Jan 14 14:48:23 2010 +0000
Fixed tests.
M dist/Safe/t/safesort.t
commit 32f28238059591da8025e5f6cf1bc5ecc6c99fe7
Author: Tim Bunce <tim.bu...@pobox.com>
Date: Thu Jan 14 14:38:53 2010 +0000
Added tests for perl#72068
M dist/Safe/t/safesort.t
-----------------------------------------------------------------------
Summary of changes:
dist/Safe/Changes | 4 ++++
dist/Safe/META.yml | 2 +-
dist/Safe/Safe.pm | 8 ++++++--
dist/Safe/t/safesort.t | 17 +++++++++++------
4 files changed, 22 insertions(+), 9 deletions(-)
diff --git a/dist/Safe/Changes b/dist/Safe/Changes
index db471a7..5e089b4 100644
--- a/dist/Safe/Changes
+++ b/dist/Safe/Changes
@@ -1,3 +1,7 @@
+2.21 Thu Jan 14 2010
+ fix [perl #72068]: An anonymous sub created by the Safe container will have
+ bogus arguments passed to it.
+
2.20 Tue Dec 1 2009
fix [rt.cpan.org #51574] Safe.pm sort {} bug accessing $a and $b with
-Dusethreads (Tim Bunce)
diff --git a/dist/Safe/META.yml b/dist/Safe/META.yml
index edf9d53..6495d46 100644
--- a/dist/Safe/META.yml
+++ b/dist/Safe/META.yml
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Safe
-version: 2.20
+version: 2.21
abstract: ~
license: ~
author: ~
diff --git a/dist/Safe/Safe.pm b/dist/Safe/Safe.pm
index 476b9fd..fd628de 100644
--- a/dist/Safe/Safe.pm
+++ b/dist/Safe/Safe.pm
@@ -6,7 +6,7 @@ use Scalar::Util qw(reftype);
use Config qw(%Config);
use constant is_usethreads => $Config{usethreads};
-$Safe::VERSION = "2.20";
+$Safe::VERSION = "2.21";
# *** Don't declare any lexicals above this point ***
#
@@ -308,7 +308,11 @@ sub reval {
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) };
+ $ret = sub {
+ my @args = @_; # lexical to close over
+ my $sub_with_args = sub { $sub->(@args) };
+ return Opcode::_safe_call_sv($root, $obj->{Mask},
$sub_with_args)
+ };
}
}
diff --git a/dist/Safe/t/safesort.t b/dist/Safe/t/safesort.t
index 2b90afc..5ba2685 100644
--- a/dist/Safe/t/safesort.t
+++ b/dist/Safe/t/safesort.t
@@ -9,25 +9,30 @@ BEGIN {
}
use Safe 1.00;
-use Test::More tests => 4;
+use Test::More tests => 6;
my $safe = Safe->new('PLPerl');
$safe->permit_only(qw(:default sort));
-my $func = $safe->reval(<<'EOS');
+# check basic argument passing and context for anon-subs
+my $func = $safe->reval(q{ sub { @_ } });
+is_deeply [ $func->() ], [ ];
+is_deeply [ $func->("foo") ], [ "foo" ];
+
+$func = $safe->reval(<<'EOS');
# uses quotes in { "$a" <=> $b } to avoid the optimizer replacing the block
# with a hardwired comparison
- { package Pkg; sub p_sort { return sort { "$a" <=> $b } qw(2 1 3); } }
- sub l_sort { return sort { "$a" <=> $b } qw(2 1 3); }
+ { package Pkg; sub p_sort { return sort { "$a" <=> $b } @_; } }
+ sub l_sort { return sort { "$a" <=> $b } @_; }
- return sub { return join(",",l_sort()), join(",",Pkg::p_sort()) }
+ return sub { return join(",",l_sort(@_)), join(",",Pkg::p_sort(@_)) }
EOS
is $@, '', 'reval should not fail';
is ref $func, 'CODE', 'reval should return a CODE ref';
-my ($l_sorted, $p_sorted) = $func->();
+my ($l_sorted, $p_sorted) = $func->(1,2,3);
is $l_sorted, "1,2,3";
is $p_sorted, "1,2,3";
--
Perl5 Master Repository
