Re: Not OK 17969

Message-Id: <87lm5fn5c5.fsf@vran.herceg.de>

p4raw-id: //depot/perl@17971

diff --git a/ext/Storable/Storable.pm b/ext/Storable/Storable.pm
index 4fba6b1..1283b79 100644 (file)
--- a/ext/Storable/Storable.pm
+++ b/ext/Storable/Storable.pm
@@ -521,6 +521,10 @@ to a subroutine reference which would be used instead of C<eval>. See
 below for an example using a L<Safe> compartment for deserialization
 of CODE references.
 
+If C<$Storable::Deparse> and/or C<$Storable::Eval> are set to false
+values, then the value of C<$Storable::forgive_me> (see below) is
+respected while serializing and deserializing.
+
 =head1 FORWARD COMPATIBILITY
 
 This release of Storable can be used on a newer version of Perl to
@@ -799,17 +803,24 @@ which prints (on my machine):
 Serialization of CODE references and deserialization in a safe
 compartment:
 
+=for example begin
+
        use Storable qw(freeze thaw);
        use Safe;
        use strict;
        my $safe = new Safe;
-       # permitting the "require" opcode is necessary when using "use strict"
-       $safe->permit(qw(:default require));
+        # because of opcodes used in "use strict":
+       $safe->permit(qw(:default require caller));
        local $Storable::Deparse = 1;
        local $Storable::Eval = sub { $safe->reval($_[0]) };
-       my $serialized = freeze(sub { print "42\n" });
+       my $serialized = freeze(sub { 42 });
        my $code = thaw($serialized);
-       $code->(); # prints 42
+       $code->() == 42;
+
+=for example end
+
+=for example_testing
+        is( $code->(), 42 );
 
 =head1 WARNING
 
@@ -839,9 +850,9 @@ your data.  There is no slowdown on retrieval.
 
 =head1 BUGS
 
-You can't store GLOB, CODE, FORMLINE, etc.... If you can define
-semantics for those operations, feel free to enhance Storable so that
-it can deal with them.
+You can't store GLOB, FORMLINE, etc.... If you can define semantics
+for those operations, feel free to enhance Storable so that it can
+deal with them.
 
 The store functions will C<croak> if they run into such references
 unless you set C<$Storable::forgive_me> to some C<TRUE> value. In that

diff --git a/ext/Storable/t/code.t b/ext/Storable/t/code.t
index 3a6d1a4..1912cd0 100644 (file)
--- a/ext/Storable/t/code.t
+++ b/ext/Storable/t/code.t
@@ -38,7 +38,7 @@ BEGIN {
     }
 }
 
-BEGIN { plan tests => 47 }
+BEGIN { plan tests => 49 }
 
 use Storable qw(retrieve store nstore freeze nfreeze thaw dclone);
 use Safe;
@@ -47,10 +47,14 @@ use Safe;
 
 use vars qw($freezed $thawed @obj @res $blessed_code);
 
-sub code { "JAPH" }
 $blessed_code = bless sub { "blessed" }, "Some::Package";
 { package Another::Package; sub foo { __PACKAGE__ } }
 
+{
+    no strict; # to make the life for Safe->reval easier
+    sub code { "JAPH" }
+}
+
 @obj =
     ([\&code,                   # code reference
       sub { 6*7 },
@@ -202,20 +206,13 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
 
 {
     my $safe = new Safe;
-    $safe->permit(qw(:default require));
     local $Storable::Eval = sub { $safe->reval(shift) };
 
-    for my $def ([0 => "JAPH",
-                 1 => 42,
-                ]
-               ) {
-       my($i, $res) = @$def;
-       $freezed = freeze $obj[0]->[$i];
-       $@ = "";
-       eval { $thawed = thaw $freezed };
-       ok($@, "");
-       ok($thawed->(), $res);
-    }
+    $freezed = freeze $obj[0]->[0];
+    $@ = "";
+    eval { $thawed = thaw $freezed };
+    ok($@, "");
+    ok($thawed->(), "JAPH");
 
     $freezed = freeze $obj[0]->[6];
     eval { $thawed = thaw $freezed };
@@ -240,6 +237,19 @@ ok(prototype($thawed->[4]), prototype($obj[0]->[4]));
 }
 
 {
+    my $safe = new Safe;
+    # because of opcodes used in "use strict":
+    $safe->permit(qw(:default require caller));
+    local $Storable::Eval = sub { $safe->reval(shift) };
+
+    $freezed = freeze $obj[0]->[1];
+    $@ = "";
+    eval { $thawed = thaw $freezed };
+    ok($@, "");
+    ok($thawed->(), 42);
+}
+
+{
     {
        package MySafe;
        sub new { bless {}, shift }

diff --git a/ext/Storable/t/downgrade.t b/ext/Storable/t/downgrade.t
index 5b88475..2274dc9 100644 (file)
--- a/ext/Storable/t/downgrade.t
+++ b/ext/Storable/t/downgrade.t
@@ -9,6 +9,13 @@
 # I ought to keep this test easily backwards compatible to 5.004, so no
 # qr//;
 
+BEGIN {
+    if ($] < 5.005) {
+       print "1..0 # Skip: usage of qr//\n";
+       exit 0;
+    }
+}
+
 # This test checks downgrade behaviour on pre-5.8 perls when new 5.8 features
 # are encountered.
 

diff --git a/ext/Storable/t/forgive.t b/ext/Storable/t/forgive.t
index 3110ac4..65a2e4c 100644 (file)
--- a/ext/Storable/t/forgive.t
+++ b/ext/Storable/t/forgive.t
@@ -16,11 +16,6 @@ sub BEGIN {
     } else {
        unshift @INC, 't';
     }
-    require File::Spec;
-    if ($File::Spec::VERSION < 0.8) {
-       print "1..0 # Skip: newer File::Spec needed\n";
-       exit 0;
-    }
     require Config; import Config;
     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
         print "1..0 # Skip: Storable was not built\n";
@@ -30,6 +25,11 @@ sub BEGIN {
 
 use Storable qw(store retrieve);
 
+# problems with 5.00404 when in an BEGIN block, so this is defined here
+if (eval { require File::Spec; 1 } || $File::Spec::VERSION < 0.8) {
+    print "1..0 # Skip: File::Spec 0.8 needed\n";
+    exit 0;
+}
 
 print "1..8\n";
 

diff --git a/ext/Storable/t/malice.t b/ext/Storable/t/malice.t
index b4951da..6d21776 100644 (file)
--- a/ext/Storable/t/malice.t
+++ b/ext/Storable/t/malice.t
@@ -23,6 +23,10 @@ sub BEGIN {
         print "1..0 # Skip: Storable was not built\n";
         exit 0;
     }
+    if ($] < 5.005) {
+        print "1..0 # Skip: Config{ptrsize} not defined\n";
+        exit 0;
+    }
 }
 
 use strict;