Cross Reference: tie_storable.t
xref
: /
osnet-11
/
usr
/
src
/
cmd
/
perl
/
5.8.4
/
distrib
/
lib
/
Memoize
/
t
/
tie_storable.t
Home
History
Annotate
Line#
Navigate
Download
Search
only in
./
1
N/A
#!/
usr
/
bin
/
perl
1
N/A
# -*- mode: perl; perl-indent-level: 2 -*-
1
N/A
1
N/A
use
lib
qw
(. ..)
;
1
N/A
use
Memoize
0.45
qw
(
memoize
unmemoize
)
;
1
N/A
# $Memoize::Storable::Verbose = 0;
1
N/A
1
N/A
eval
{
require
Memoize
::
Storable
};
1
N/A
if
($@)
{
1
N/A
print
"1..0\n"
;
1
N/A
exit
0
;
1
N/A
}
1
N/A
1
N/A
sub
i
{
1
N/A
$_[
0
];
1
N/A
}
1
N/A
1
N/A
sub
c119
{
119
}
1
N/A
sub
c7
{
7
}
1
N/A
sub
c43
{
43
}
1
N/A
sub
c23
{
23
}
1
N/A
sub
c5
{
5
}
1
N/A
1
N/A
sub
n
{
1
N/A
$_[
0
]+
1
;
1
N/A
}
1
N/A
1
N/A
eval
{
require
Storable
};
1
N/A
if
($@)
{
1
N/A
print
"1..0\n"
;
1
N/A
exit
0
;
1
N/A
}
1
N/A
1
N/A
print
"1..4\n"
;
1
N/A
1
N/A
1
N/A
if
(
eval
{
require
File
::
Spec
::
Functions
})
{
1
N/A
File
::
Spec
::
Functions
->
import
()
;
1
N/A
}
else
{
1
N/A
*
catfile
=
sub
{
join
'/'
, @_ };
1
N/A
}
1
N/A
$tmpdir
=
$ENV
{
TMP
} ||
$ENV
{
TMPDIR
} ||
'/tmp'
;
1
N/A
$file
=
catfile
(
$tmpdir
,
"storable$$"
)
;
1
N/A
1
while
unlink
$file
;
1
N/A
tryout
(
'Memoize::Storable'
,
$file
,
1
)
;
# Test 1..4
1
N/A
1
while
unlink
$file
;
1
N/A
1
N/A
sub
tryout
{
1
N/A
my
(
$tiepack
,
$file
,
$testno
)
= @_;
1
N/A
1
N/A
tie
my
%
cache
=>
$tiepack
,
$file
1
N/A
or
die
$!;
1
N/A
1
N/A
memoize
'c5'
,
1
N/A
SCALAR_CACHE
=> [
HASH
=> \%
cache
],
1
N/A
LIST_CACHE
=>
'FAULT'
1
N/A
;
1
N/A
1
N/A
my
$t1
=
c5
()
;
1
N/A
my
$t2
=
c5
()
;
1
N/A
print
(
(
$t1
==
5
)
?
"ok
$testno
\n"
:
"not ok
$testno
\n"
)
;
1
N/A
$testno
++;
1
N/A
print
(
(
$t2
==
5
)
?
"ok
$testno
\n"
:
"not ok
$testno
\n"
)
;
1
N/A
unmemoize
'c5'
;
1
N/A
1
;
1
N/A
1
;
1
N/A
1
N/A
# Now something tricky---we'll memoize c23 with the wrong table that
1
N/A
# has the 5 already cached.
1
N/A
memoize
'c23'
,
1
N/A
SCALAR_CACHE
=> [
HASH
=> \%
cache
],
1
N/A
LIST_CACHE
=>
'FAULT'
1
N/A
;
1
N/A
1
N/A
my
$t3
=
c23
()
;
1
N/A
my
$t4
=
c23
()
;
1
N/A
$testno
++;
1
N/A
print
(
(
$t3
==
5
)
?
"ok
$testno
\n"
:
"not ok
$testno
\n"
)
;
1
N/A
$testno
++;
1
N/A
print
(
(
$t4
==
5
)
?
"ok
$testno
\n"
:
"not ok
$testno
\n"
)
;
1
N/A
unmemoize
'c23'
;
1
N/A
}
1
N/A