Merge branch 'dual/Safe' into blead

5 files changed, 49 insertions, 25 deletions

diff --git a/dist/Safe/Changes b/dist/Safe/Changes
index f246eb76f5..a00878ba10 100644
--- a/dist/Safe/Changes
+++ b/dist/Safe/Changes
@@ -1,3 +1,10 @@
+2.27 Thu Apr 29 2010
+    - Wrap coderefs returned by reval() and rdo()
+    - Add even more version::vxs routines to the default share
+
+2.26 Mon Mar  9 2010
+    - Restore compatibility with perls < 5.8.9
+
 2.25 Sun Mar  7 2010
     - More security fixes by Nick Cleaton
 
diff --git a/dist/Safe/META.yml b/dist/Safe/META.yml
index 2afb0d5801..6718a3766e 100644
--- a/dist/Safe/META.yml
+++ b/dist/Safe/META.yml
@@ -1,12 +1,20 @@
 --- #YAML:1.0
-name:                Safe
-version:             2.25
-abstract:            ~
-license:             ~
-author:              ~
-generated_by:        ExtUtils::MakeMaker version 6.42
-distribution_type:   module
-requires:     
+name:               Safe
+version:            2.27
+abstract:           ~
+author:  []
+license:            unknown
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
+requires:  {}
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.56
 meta-spec:
-    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
-    version: 1.3
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4
diff --git a/dist/Safe/Safe.pm b/dist/Safe/Safe.pm
index e33598ea2a..bca4dfe8e6 100644
--- a/dist/Safe/Safe.pm
+++ b/dist/Safe/Safe.pm
@@ -3,9 +3,8 @@ package Safe;
 use 5.003_11;
 use strict;
 use Scalar::Util qw(reftype);
-use B qw(sub_generation);
 
-$Safe::VERSION = "2.25";
+$Safe::VERSION = "2.27";
 
 # *** Don't declare any lexicals above this point ***
 #
@@ -32,6 +31,18 @@ BEGIN { eval q{
     use Carp::Heavy;
 } }
 
+use B ();
+BEGIN {
+    no strict 'refs';
+    if (defined &B::sub_generation) {
+        *sub_generation = \&B::sub_generation;
+    }
+    else {
+        # fake sub generation changing for perls < 5.8.9
+        my $sg; *sub_generation = sub { ++$sg };
+    }
+}
+
 use Opcode 1.01, qw(
     opset opset_to_ops opmask_add
     empty_opset full_opset invert_opset verify_opset
@@ -55,7 +66,7 @@ require utf8;
 # and also loads the ToFold SWASH.
 # (Swashes are cached internally by perl in PL_utf8_* variables
 # independent of being inside/outside of Safe. So once loaded they can be)
-do { my $unicode = pack('U',0xC4).'1a'; $unicode =~ /\xE4/i; };
+do { my $a = pack('U',0xC4); my $b = chr 0xE4; utf8::upgrade $b; $a =~ /$b/i };
 # now we can safely include utf8::SWASHNEW in $default_share defined below.
 
 my $default_root  = 0;
@@ -120,6 +131,7 @@ my $default_share = [qw[
     &version::vxs::declare
     &version::vxs::qv
     &version::vxs::_VERSION
+    &version::vxs::stringify
     &version::vxs::new
     &version::vxs::parse
 ]), ($] >= 5.011 && qw[
@@ -346,6 +358,7 @@ sub reval {
                ?        Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub)
                : scalar Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
     _clean_stash($root.'::') if $sg != sub_generation();
+    $obj->wrap_code_refs_within(@subret);
     return (wantarray) ? @subret : $subret[0];
 }
 
@@ -424,6 +437,7 @@ sub rdo {
                ?        Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub)
                : scalar Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
     _clean_stash($root.'::') if $sg != sub_generation();
+    $obj->wrap_code_refs_within(@subret);
     return (wantarray) ? @subret : $subret[0];
 }
 
@@ -637,9 +651,9 @@ expression evaluated, or a return statement may be used, just as with
 subroutines and B<eval()>. The context (list or scalar) is determined
 by the caller as usual.
 
-This behaviour differs from the beta distribution of the Safe extension
-where earlier versions of perl made it hard to mimic the return
-behaviour of the eval() command and the context was always scalar.
+If the return value of reval() is (or contains) any code reference,
+those code references are wrapped to be themselves executed always
+in the compartment. See L</wrap_code_refs_within>.
 
 The formerly undocumented STRICT argument sets strictness: if true
 'use strict;' is used, otherwise it uses 'no strict;'. B<Note>: if
diff --git a/dist/Safe/t/safesort.t b/dist/Safe/t/safesort.t
index 797e155f06..3396f1e10f 100644
--- a/dist/Safe/t/safesort.t
+++ b/dist/Safe/t/safesort.t
@@ -33,13 +33,7 @@ EOS
 is $@, '', 'reval should not fail';
 is ref $func, 'CODE', 'reval should return a CODE ref';
 
-# $func1 will work in non-threaded perl
-# but RT#60374 "Safe.pm sort {} bug with -Dusethreads"
-# means the sorting won't work unless we wrap the code ref
-# such that it's executed with Safe 'in effect' at runtime
-my $func2 = $safe->wrap_code_ref($func1);
-
-my ($l_sorted, $p_sorted) = $func2->(3,1,2);
+my ($l_sorted, $p_sorted) = $func1->(3,1,2);
 is $l_sorted, "1,2,3";
 is $p_sorted, "1,2,3";
 
@@ -57,5 +51,6 @@ is $@, 42, 'successful closure call should not alter $@';
     local $SIG{__WARN__} = sub { $warns++ };
     ok !eval { $die_func->("died\n"); 1 }, 'should die';
     is $@, "died\n", '$@ should be set correctly';
+    local $TODO = "Shouldn't warn";
     is $warns, 0;
 }
diff --git a/dist/Safe/t/safeutf8.t b/dist/Safe/t/safeutf8.t
index 28441da100..42b84ef788 100644
--- a/dist/Safe/t/safeutf8.t
+++ b/dist/Safe/t/safeutf8.t
@@ -16,12 +16,12 @@ use Opcode qw(full_opset);
 pass;
 
 my $safe = Safe->new('PLPerl');
-$safe->permit(qw(pack));
+$safe->deny_only();
 
 # Expression that triggers require utf8 and call to SWASHNEW.
 # Fails with "Undefined subroutine PLPerl::utf8::SWASHNEW called"
 # if SWASHNEW is not shared, else returns true if unicode logic is working.
-my $trigger = q{ my $a = pack('U',0xC4); $a =~ /\\xE4/i };
+my $trigger = q{ my $a = pack('U',0xC4); my $b = chr 0xE4; utf8::upgrade $b; $a =~ /$b/i };
 
 ok $safe->reval( $trigger ), 'trigger expression should return true';
 is $@, '', 'trigger expression should not die';