CPAN::Groonga

, $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;

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/);
}

f, 3, -4, -3.14159, 456, 4.5,
	$b, \$a, $a, $c, \$c, \%a);

isnt(store(\@a, "store$$"), undef);
is(Storable::last_op_in_netorder(), '');
isnt(nstore(\@a, 'nstore'), undef);
is(Storable::last_op_in_net

"store$$");
isnt($root, undef);
is(Storable::last_op_in_netorder(), '');

$nroot = retrieve('nstore');
isnt($root, undef);
is(Storable::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;
{
    # len

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

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 *

	$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::forgive_me=1;

my $devnull = File::Spec->devnull;

open(SAVEERR, ">&STDERR")

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

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

 $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

cted_length = $is_EBCDIC ? 217 : 278;
is(length $data, $expected_length);
  
my $y = thaw($data);
isnt($y, undef);
is(ref $y, 'ROOT');

$Storable::canonical = 1;		# Prevent "used once" warning
$Storab

} = 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