downgrade.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl -w
#
# Copyright 2002, Larry Wall.
#
# You may redistribute only under the same terms as Perl 5, as specified
# in the README file that comes with the distribution.
#
# I ought to keep this test easily backwards compatible to 5.004, so no
# qr//;
# This test checks downgrade behaviour on pre-5.8 perls when new 5.8 features
# are encountered.
sub BEGIN {
chdir('t') if -d 't';
} else {
}
print "1..0 # Skip: Storable was not built\n";
exit 0;
}
}
use Storable 'thaw';
use strict;
'Locked keys', 'Locked keys placeholder',
);
if ($] > 5.007002) {
# This is cheating. "\xdf" in Latin 1 is beta S, so will match \w if it
# is stored in utf8, not bytes.
# "\xdf" is y diaresis in EBCDIC (except for cp875, but so far no-one seems
# to use that) which has exactly the same properties for \w
# So the tests happen to pass.
# \xe5 is V in EBCDIC. That doesn't have the same properties w.r.t. \w as
# an a circumflex, so we need to be explicit.
# and its these very properties we're trying to test - an edge case
# involving whether scalars are being stored in bytes or in utf8.
} elsif ($] >= 5.006) {
} else {
}
$UTF8_CROAK = "/^Cannot retrieve UTF8 data in non-UTF8 perl/";
$RESTRICTED_CROAK = "/^Cannot retrieve restricted hash/";
my %tests;
{
local $/ = "\n\nend\n";
next unless /\S/s;
s/\n.*//s;
next;
}
}
}
# use Data::Dumper; $Data::Dumper::Useqq = 1; print Dumper \%tests;
sub thaw_hash {
"And it is the hash we expected?");
}
sub thaw_scalar {
# Aargh. <expletive> <expletive> 5.6.0's harness doesn't even honour
# TODO tests.
ok ("I'd really like to fail this test on 5.6.0 but I'm told that CPAN auto-dependancies mess up, and certain vendors only ship 5.6.0. Get your vendor to ugrade. Else upgrade your vendor.");
# One such vendor being the folks who brought you LONG_MIN as a positive
# integer.
} else {
}
}
sub thaw_fail {
}
sub test_locked_hash {
my $hash = shift;
'trying to change a locked key' );
'trying to add another key' );
}
sub test_restricted_hash {
my $hash = shift;
'trying to change a restricted key' );
'trying to add another key' );
}
sub test_placeholder {
my $hash = shift;
}
sub test_newkey {
my $hash = shift;
}
# $Storable::DEBUGME = 1;
if (eval "use Hash::Util; 1") {
print "# We have Hash::Util, so test that the restricted hashes in <DATA> are valid\n";
}
} else {
print "# We don't have Hash::Util, so test that the restricted hashes downgrade\n";
local $Storable::downgrade_restricted = 0;
}
if ($] >= 5.006) {
print "# We have utf8 scalars, so test that the utf8 scalars in <DATA> are valid\n";
} else {
print "# We don't have utf8 scalars, so test that the utf8 scalars downgrade\n";
}
if ($] > 5.007002) {
print "# We have utf8 hashes, so test that the utf8 hashes in <DATA> are valid\n";
my $l = 0 + /^\w+$/;
my $r = 0 + $hash->{$_} =~ /^\w+$/;
}
if (eval "use Hash::Util; 1") {
print "# We have Hash::Util, so test that the restricted utf8 hash is valid\n";
my $l = 0 + /^\w+$/;
my $r = 0 + $hash->{$_} =~ /^\w+$/;
}
} else {
print "# We don't have Hash::Util, so test that the utf8 hash downgrades\n";
}
} else {
print "# We don't have utf8 hashes, so test that the utf8 hashes downgrade\n";
#foreach (keys %$expect) { print "'$_':\t'$expect->{$_}'\n"; }
#foreach (keys %$got) { print "'$_':\t'$got->{$_}'\n"; }
if (eval "use Hash::Util; 1") {
print "# We have Hash::Util, so test that the restricted hashes in <DATA> are valid\n";
} else {
print "# We don't have Hash::Util, so test that the restricted hashes downgrade\n";
local $Storable::downgrade_restricted = 0;
# Which croak comes first is a bit of an implementation issue :-)
}
}
# A whole run of 2.x nfreeze data, uuencoded. The "mode bits" are the octal
# value of 'A', the "file name" is the test name. Use make_downgrade.pl to
# generate these.
end
end
end
begin 101 Locked keys placeholder
end
&!047`L.?
end
&!04*`L.?
end
MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#
MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#
MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#
MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#
MPY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?PY_#
8PY_#G\.?PY_#G\.?PY_#G\.?PY_#G\.?
end
)!047!?BPC[^N
end
)!04*!?BPC[^N
end
end
begin 101 Hash with utf8 flag but no utf8 keys
8!049``````$*!7)U;&5S``````1P97)L
end
begin 101 Hash with utf8 keys
end
begin 101 Locked hash with utf8 keys
M!049`0````0*!F-A<W1L900````&8V%S=&QE"@=C:.5T96%U!`````=C:.5T
end
end
begin 101 Hash with utf8 keys for 5.6
end
begin 301 Locked hash
end
begin 301 Locked hash placeholder
end
end
begin 301 Locked keys placeholder
end
&!047`HMS
end
&!04*`HMS
end
end
end
end
end
end
end
end
GHX6!I`H'XH.(DY:+<P(````&XH.(DY;?"@3<9')5``````3<9')5
end
begin 301 Hash with utf8 keys for 5.6
M!049``````0*!H.!HJ.3A0`````&@X&BHY.%"@>#B$>CA8&D``````>#B$>C
FA8&D%P?B@XB3EHMS`@````;B@XB3EM\7!-QD<E4`````!-QD<E4`
end