[EMAIL PROTECTED] (Andreas J. Koenig) writes:
> ./ext/Storable/t/code.................NOK 38# Test 38 got: 'code sub {
> use strict 'refs';
> 'JAPH';
> } caused an error: caller trapped by operation mask at ../lib/strict.pm line 22.
> Compilation failed in require at (eval 37) line 2.
> BEGIN failed--compilation aborted at (eval 37) line 2, at ../ext/Storable/t/code
> .t line 215
> ' (../ext/Storable/t/code.t at line 216)
> # Expected: ''
> # ../ext/Storable/t/code.t line 216 is: ok($@, "");
> Not a CODE reference at ../ext/Storable/t/code.t line 217.
> ./ext/Storable/t/code.................dubious
> Test returned status 255 (wstat 65280, 0xff00)
> DIED. FAILED tests 38-47
> Failed 10/47 tests, 78.72% okay
>
The "use strict" issue again. OK, a new patch:
- more accurate documentation
- the second example in the documentation may be used with pod2test
from Test::Inline
- code.t now works again with bleedperl
- skip some tests on 5.00404
Storable builds and tests ok on 5.00503, 5.6.1, 5.8.0 and bleedperl.
With 5.00404, I sometimes get core dumps with canonical.t.
diff -urp /usr/local/src/bleedperl/ext/Storable/Storable.pm ./Storable.pm
--- /usr/local/src/bleedperl/ext/Storable/Storable.pm Thu Oct 3 05:25:50 2002
+++ ./Storable.pm Thu Oct 3 12:32:15 2002
@@ -521,6 +521,10 @@ to a subroutine reference which would be
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 retr
=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 -urp /usr/local/src/bleedperl/ext/Storable/t/code.t ./t/code.t
--- /usr/local/src/bleedperl/ext/Storable/t/code.t Thu Oct 3 05:25:50 2002
+++ ./t/code.t Thu Oct 3 12:15:22 2002
@@ -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($o
{
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 };
@@ -237,6 +234,19 @@ ok(prototype($thawed->[4]), prototype($o
eval { $thawed = thaw $freezed };
ok($@ =~ /trapped/);
}
+}
+
+{
+ 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);
}
{
diff -urp /usr/local/src/bleedperl/ext/Storable/t/downgrade.t ./t/downgrade.t
--- /usr/local/src/bleedperl/ext/Storable/t/downgrade.t Sat Jun 1 06:26:44 2002
+++ ./t/downgrade.t Thu Oct 3 12:46:00 2002
@@ -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 -urp /usr/local/src/bleedperl/ext/Storable/t/forgive.t ./t/forgive.t
--- /usr/local/src/bleedperl/ext/Storable/t/forgive.t Thu Aug 22 13:45:45 2002
+++ ./t/forgive.t Thu Oct 3 12:55:35 2002
@@ -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 -urp /usr/local/src/bleedperl/ext/Storable/t/malice.t ./t/malice.t
--- /usr/local/src/bleedperl/ext/Storable/t/malice.t Thu Aug 22 13:45:45 2002
+++ ./t/malice.t Thu Oct 3 12:53:53 2002
@@ -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;
Regards,
Slaven
--
Slaven Rezic - [EMAIL PROTECTED]
tknotes - A knotes clone, written in Perl/Tk.
http://ptktools.sourceforge.net/#tknotes
