[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