, $a, $c, \$c, \%a);
isnt(store(\@a, "store$$"), undef);
$dumped = &dump(\@a);
isnt($dumped, undef);
$root = retrieve("store$$");
isnt($root, undef);
$got = &dump($root);
isnt($got, undef);
is($g
oo = FOO->make;
isnt($foo->store("store$$"), undef);
isnt(open(OUT, '>>', "store$$"), undef);
binmode OUT;
isnt(store_fd(\@a, ::OUT), undef);
isnt(nstore_fd($foo, ::OUT), undef);
isnt(nstore_fd(\%a,
::OUT), undef);
isnt(close(OUT), undef);
isnt(open(OUT, "store$$"), undef);
$r = fd_retrieve(::OUT);
isnt($r, undef);
is(&dump($r), &dump($foo));
$r = fd_retrieve(::OUT);
isnt($r, undef);
is(&dum
, \$c, \%a);
my $f1 = freeze(\@a);
isnt($f1, undef);
$dumped = &dump(\@a);
isnt($dumped, undef);
$root = thaw($f1);
isnt($root, undef);
$got = &dump($root);
isnt($got, undef);
is($got, $dumped);
package main;
$foo = FOO->make;
my $f2 = $foo->freeze;
isnt($f2, undef);
my $f3 = $foo->nfreeze;
isnt($f3, undef);
$root3 = thaw($f3);
isnt($root3, undef);
is(&dump($foo), &dump($root3));
$root
o Garcia -- RAM, 08/06/2001
my $thaw_me = 'asdasdasdasd';
eval {
my $thawed = thaw $thaw_me;
};
isnt($@, '');
my %to_be_frozen = (foo => 'bar');
my $frozen;
eval {
$frozen = freeze \%to_be_frozen;
-4, -3.14159, 456, 4.5,
$b, \$a, $a, $c, \$c, \%a);
isnt(store(\@a, "store$$"), undef);
is(Storable::Improved::last_op_in_netorder(), '');
isnt(nstore(\@a, 'nstore'), undef);
is(Storable::Improved:
;
isnt($root, undef);
is(Storable::Improved::last_op_in_netorder(), '');
$nroot = retrieve('nstore');
isnt($root, undef);
is(Storable::Improved::last_op_in_netorder(), 1);
$d1 = &dump($root);
isnt($
d1, undef);
$d2 = &dump($nroot);
isnt($d2, undef);
is($d1, $d2);
# Make sure empty string is defined at retrieval time
isnt($root->[1], undef);
is(length $root->[1], 0);
# $Storable::DEBUGME = 1;
{
hash, \@tied);
my $f = freeze(\@a);
isnt($f, undef);
$dumped = &dump(\@a);
isnt($dumped, undef);
$root = thaw($f);
isnt($root, undef);
$got = &dump($root);
isnt($got, undef);
### Used to see the
->{'x'}, 'FAULT', $h, 'x';
my $hf = freeze($h);
isnt($hf, undef);
is($FAULT::fault, 0);
is($h->{'x'}, 1);
is($FAULT::fault, 1);
my $ht = thaw($hf);
isnt($ht, undef);
is($ht->{'x'}, 1);
is($FAULT::fau
ject should be thawed blessed
my @a;
tie @a, TIED_ARRAY;
my $r = bless \@a, 'FOO99';
my $f = freeze($r);
my $t = thaw($f);
isnt($t, undef);
like("$t", qr/^FOO99=ARRAY/);
}
make;
my $x = freeze $real;
isnt($x, undef);
my $y = thaw $x;
is(ref $y, 'OBJ_REAL');
is($y->[0], 'a');
is($y->[1], 1);
my $sync = OBJ_SYNC->make;
$x = freeze $sync;
isnt($x, undef);
$y = thaw $x;
;
isnt($x, undef);
my $z = thaw $x;
$y = $z->[0];
is(ref $y, 'OBJ_SYNC2');
is($y->{ok}, $y);
is(ref $y->{sync}, 'OBJ_SYNC');
is($y->{ext}, $z->[1]);
$real = OBJ_REAL2->make;
$x = freeze $real;
isnt(
2::MAX);
$y = thaw $x;
is(ref $y, 'OBJ_REAL2');
is($OBJ_REAL2::recursed, 0);
$x = dclone $real;
isnt($x, undef);
is(ref $x, 'OBJ_REAL2');
is($OBJ_REAL2::recursed, 0);
is($OBJ_REAL2::hook_called, 2 *
eze \\(1 == 1)"
if !defined($f) and $] < 5.013 and $] > 5.009 and $immortal eq 'y';
isnt($f, undef);
}
my $t = thaw $f;
pass("thaw didn't crash");
}
}
# Test automatic req
, 1);
isnt($t, undef);
is(ref $t, 'HAS_HOOK');
delete $INC{"HAS_HOOK.pm"};
delete $HAS_HOOK::{STORABLE_thaw};
$t = thaw $f;
is($HAS_HOOK::loaded_count, 2);
is($HAS_HOOK::thawed_count, 2);
isnt($t, u
0);
$t = thaw $f;
is($STRESS_THE_STACK::freeze_count, 1);
is($STRESS_THE_STACK::thaw_count, 1);
isnt($t, undef);
is(ref $t, 'STRESS_THE_STACK');
my $file = "storable-testfile.$$";
die "Temporary fi
ed);
my $f = freeze(\@a);
isnt($f, undef);
$dumped = &dump(\@a);
isnt($dumped, undef);
$root = thaw($f);
isnt($root, undef);
$got = &dump($root);
isnt($got, undef);
isnt($got, $dumped); # our hoo
$b, \$a, $a, $c, \$c, \%a);
my $aref = dclone(\@a);
isnt($aref, undef);
$dumped = &dump(\@a);
isnt($dumped, undef);
$got = &dump($aref);
isnt($got, undef);
is($got, $dumped);
package FOO; @ISA
elf->{key} = \%main::a;
return $self;
};
package main;
$foo = FOO->make;
my $r = $foo->dclone;
isnt($r, undef);
is(&dump($foo), &dump($r));
# Ensure refs to "undef" values are properly shared dur
oo', \*GLOB, 'bar'];
my $result;
eval {$result = store ($bad , "store$$")};
is($result, undef);
isnt($@, '');
$Storable::Improved::forgive_me=1;
my $devnull = File::Spec->devnull;
open(SAVEERR, "
result = store ($bad , "store$$")};
open(STDERR, ">&SAVEERR");
isnt($result, undef);
is($@, '');
my $ret = retrieve("store$$");
isnt($ret, undef);
is($ret->[0], 'foo');
is($ret->[2], 'bar');
is(ref
$c1");
is(${^PREMATCH}, "a", "check p worked");
ok("cba" =~ $c2, "cba matches $c2");
isnt(${^PREMATCH}, "c", "check no p worked");
}
SKIP:
{
$version >= 24
or skip "n introduce
hes $c1");
is($1, "a", "check capturing preserved");
ok("b" =~ $c2, "b matches $c2");
isnt($1, "b", "check non-capturing preserved");
}
SKIP:
{
$version >= 8
or skip "Cannot ret
e're just ensuring things work, we're not validating locking.
#
isnt(lock_store(\@a, "store$$"), undef);
my $dumped = &dump(\@a);
isnt($dumped, undef);
$root = lock_retrieve("store$$");
is(ref $root
cted_length = $is_EBCDIC ? 217 : 278;
is(length $data, $expected_length);
my $y = thaw($data);
isnt($y, undef);
is(ref $y, 'ROOT');
$Storable::Improved::canonical = 1; # Prevent "used once" warni
} = 15 } ;
is($@, '', "Can assign to reserved key 'extra'?");
eval { $copy->{nono} = 7 } ;
isnt($@, '', "Can not assign to invalid key 'nono'?");
is(exists $copy->{undef}, 1, "key 'undef' ex
$b = chr($i); utf8::encode($b);
# warn sprintf "%d,%d" ,bytes::length($b), is_utf8($b);
isnt($u, $b, "equivalence - with utf8flag");
$utf8hash{$u} = $utf8hash{$b} = $i;
}
sub nkeys($){
eval { $freezed = freeze $obj[0]->[0] };
open(STDERR, ">&SAVEERR");
is($@, "");
isnt($freezed, '');
}
{
my $safe = new Safe;
local $Storable::Eval = sub { $safe->reval(shift