100 lines
2.8 KiB
Diff
100 lines
2.8 KiB
Diff
diff --git a/Storable.pm b/Storable.pm
|
|
index 9d8b621..c8f6db1 100644
|
|
--- a/Storable.pm
|
|
+++ b/Storable.pm
|
|
@@ -22,7 +22,7 @@ package Storable; @ISA = qw(Exporter);
|
|
|
|
use vars qw($canonical $forgive_me $VERSION);
|
|
|
|
-$VERSION = '2.53';
|
|
+$VERSION = '2.56';
|
|
|
|
BEGIN {
|
|
if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) {
|
|
@@ -979,43 +979,43 @@ such.
|
|
|
|
Here are some code samples showing a possible usage of Storable:
|
|
|
|
- use Storable qw(store retrieve freeze thaw dclone);
|
|
+ use Storable qw(store retrieve freeze thaw dclone);
|
|
|
|
- %color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1);
|
|
+ %color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1);
|
|
|
|
- store(\%color, 'mycolors') or die "Can't store %a in mycolors!\n";
|
|
+ store(\%color, 'mycolors') or die "Can't store %a in mycolors!\n";
|
|
|
|
- $colref = retrieve('mycolors');
|
|
- die "Unable to retrieve from mycolors!\n" unless defined $colref;
|
|
- printf "Blue is still %lf\n", $colref->{'Blue'};
|
|
+ $colref = retrieve('mycolors');
|
|
+ die "Unable to retrieve from mycolors!\n" unless defined $colref;
|
|
+ printf "Blue is still %lf\n", $colref->{'Blue'};
|
|
|
|
- $colref2 = dclone(\%color);
|
|
+ $colref2 = dclone(\%color);
|
|
|
|
- $str = freeze(\%color);
|
|
- printf "Serialization of %%color is %d bytes long.\n", length($str);
|
|
- $colref3 = thaw($str);
|
|
+ $str = freeze(\%color);
|
|
+ printf "Serialization of %%color is %d bytes long.\n", length($str);
|
|
+ $colref3 = thaw($str);
|
|
|
|
which prints (on my machine):
|
|
|
|
- Blue is still 0.100000
|
|
- Serialization of %color is 102 bytes long.
|
|
+ Blue is still 0.100000
|
|
+ Serialization of %color is 102 bytes long.
|
|
|
|
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;
|
|
+ use Storable qw(freeze thaw);
|
|
+ use Safe;
|
|
+ use strict;
|
|
+ my $safe = new Safe;
|
|
# because of opcodes used in "use strict":
|
|
- $safe->permit(qw(:default require));
|
|
- local $Storable::Deparse = 1;
|
|
- local $Storable::Eval = sub { $safe->reval($_[0]) };
|
|
- my $serialized = freeze(sub { 42 });
|
|
- my $code = thaw($serialized);
|
|
- $code->() == 42;
|
|
+ $safe->permit(qw(:default require));
|
|
+ local $Storable::Deparse = 1;
|
|
+ local $Storable::Eval = sub { $safe->reval($_[0]) };
|
|
+ my $serialized = freeze(sub { 42 });
|
|
+ my $code = thaw($serialized);
|
|
+ $code->() == 42;
|
|
|
|
=for example end
|
|
|
|
diff --git a/Storable.xs b/Storable.xs
|
|
index e7d0329..83cd001 100644
|
|
--- a/Storable.xs
|
|
+++ b/Storable.xs
|
|
@@ -1667,6 +1667,7 @@ static void free_context(pTHX_ stcxt_t *cxt)
|
|
|
|
ASSERT(!cxt->s_dirty, ("clean context"));
|
|
ASSERT(prev, ("not freeing root context"));
|
|
+ assert(prev);
|
|
|
|
SvREFCNT_dec(cxt->my_sv);
|
|
SET_STCXT(prev);
|
|
@@ -6677,6 +6678,7 @@ SV * obj
|
|
ALIAS:
|
|
net_mstore = 1
|
|
CODE:
|
|
+ RETVAL = &PL_sv_undef;
|
|
if (!do_store(aTHX_ (PerlIO*) 0, obj, 0, ix, &RETVAL))
|
|
RETVAL = &PL_sv_undef;
|
|
OUTPUT:
|