tied_hook.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl
#
# Copyright (c) 1995-2000, Raphael Manfredi
#
# You may redistribute only under the same terms as Perl 5, as specified
# in the README file that comes with the distribution.
#
sub BEGIN {
chdir('t') if -d 't';
} else {
}
print "1..0 # Skip: Storable was not built\n";
exit 0;
}
}
sub ok;
print "1..25\n";
($scalar_fetch, $array_fetch, $hash_fetch) = (0, 0, 0);
sub TIEHASH {
return $self;
}
sub FETCH {
my $self = shift;
$main::hash_fetch++;
}
sub STORE {
my $self = shift;
}
sub FIRSTKEY {
my $self = shift;
}
sub NEXTKEY {
my $self = shift;
}
sub STORABLE_freeze {
my $self = shift;
$main::hash_hook1++;
}
sub STORABLE_thaw {
}
$main::hash_hook2++;
}
sub TIEARRAY {
return $self;
}
sub FETCH {
my $self = shift;
$main::array_fetch++;
}
sub STORE {
my $self = shift;
}
sub FETCHSIZE {
my $self = shift;
return @{$self};
}
sub STORABLE_freeze {
my $self = shift;
$main::array_hook1++;
}
sub STORABLE_thaw {
$main::array_hook2++;
}
sub TIESCALAR {
my $scalar;
return $self;
}
sub FETCH {
my $self = shift;
$main::scalar_fetch++;
return $$self;
}
sub STORE {
my $self = shift;
}
sub STORABLE_freeze {
my $self = shift;
$main::scalar_hook1++;
return $$self;
}
sub STORABLE_thaw {
$main::scalar_hook2++;
}
$a = 'toto';
$b = \$a;
$scalar = 'foo';
$array[1] = $c;
@a = ('first', 3, -4, -3.14159, 456, 4.5, $d, \$d,
# Ensure the tied items in the retrieved image work
@old = ($scalar_fetch, $array_fetch, $hash_fetch);
@new = ($scalar_fetch, $array_fetch, $hash_fetch);
# Tests 10..15
for ($i = 0; $i < @new; $i++) {
}
# Ensure hooks were called
#
# And now for the "blessed ref to tied hash" with "store hook" test...
#
my $old_hash_fetch = $hash_fetch;
sub STORABLE_freeze {
return if $cloning;
return('ref lost');
}
sub STORABLE_thaw {
return if $cloning;
}