1#!./perl -w 2# 3# Copyright 2002, Larry Wall. 4# 5# You may redistribute only under the same terms as Perl 5, as specified 6# in the README file that comes with the distribution. 7# 8 9# I ought to keep this test easily backwards compatible to 5.004, so no 10# qr//; 11 12# This test checks whether the kludge to interwork with 5.6 Storables compiled 13# on Unix systems with IV as long long works. 14 15sub BEGIN { 16 unshift @INC, 't'; 17 unshift @INC, 't/compat' if $] < 5.006002; 18 require Config; import Config; 19 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { 20 print "1..0 # Skip: Storable was not built\n"; 21 exit 0; 22 } 23 unless ($Config{ivsize} and $Config{ivsize} > $Config{longsize}) { 24 print "1..0 # Skip: Your IVs are no larger than your longs\n"; 25 exit 0; 26 } 27} 28 29use Storable qw(freeze thaw); 30use strict; 31use Test::More tests=>30; 32 33our (%tests); 34 35{ 36 local $/ = "\n\nend\n"; 37 while (<DATA>) { 38 next unless /\S/s; 39 unless (/begin ([0-7]{3}) ([^\n]*)\n(.*)$/s) { 40 s/\n.*//s; 41 warn "Dodgy data in section starting '$_'"; 42 next; 43 } 44 next unless oct $1 == ord 'A'; # Skip ASCII on EBCDIC, and vice versa 45 my $data = unpack 'u', $3; 46 $tests{$2} = $data; 47 } 48} 49 50# perl makes easy things easy, and hard things possible: 51my $test = freeze \'Hell'; 52 53my $header = Storable::read_magic ($test); 54 55is ($header->{byteorder}, $Config{byteorder}, 56 "header's byteorder and Config.pm's should agree"); 57 58my $result = eval {thaw $test}; 59isa_ok ($result, 'SCALAR', "Check thawing test data"); 60is ($@, '', "causes no errors"); 61is ($$result, 'Hell', 'and gives the expected data'); 62 63my $kingdom = $Config{byteorder} =~ /23/ ? "Lillput" : "Belfuscu"; 64 65my $name = join ',', $kingdom, @$header{qw(intsize longsize ptrsize nvsize)}; 66 67SKIP: { 68 my $real_thing = $tests{$name}; 69 if (!defined $real_thing) { 70 print << "EOM"; 71# No test data for Storable 1.x for: 72# 73# byteorder '$Config{byteorder}' 74# sizeof(int) $$header{intsize} 75# sizeof(long) $$header{longsize} 76# sizeof(char *) $$header{ptrsize} 77# sizeof(NV) $$header{nvsize} 78 79# If you have Storable 1.x built with perl 5.6.x on this platform, please 80# make_56_interwork.pl to generate test data, and append the test data to 81# this test. 82# You may find that make_56_interwork.pl reports that your platform has no 83# interworking problems, in which case you need do nothing. 84EOM 85 skip "# No 1.x test file", 9; 86 } 87 my $result = eval {thaw $real_thing}; 88 is ($result, undef, "By default should not be able to thaw"); 89 like ($@, qr/Byte order is not compatible/, 90 "because the header byte order strings differ"); 91 local $Storable::interwork_56_64bit = 1; 92 $result = eval {thaw $real_thing}; 93 isa_ok ($result, 'ARRAY', "With flag should now thaw"); 94 is ($@, '', "with no errors"); 95 96 # However, as the file is written with Storable pre 2.01, it's a known 97 # bug that large (positive) UVs become IVs 98 my $value = (~0 ^ (~0 >> 1) ^ 2); 99 100 is (@$result, 4, "4 elements in array"); 101 like ($$result[0], 102 qr/^This file was written with [0-9.]+ on perl [0-9.]+\z/, 103 "1st element"); 104 is ($$result[1], "$kingdom was correct", "2nd element"); 105 cmp_ok ($$result[2] ^ $value, '==', 0, "3rd element") or 106 printf "# expected %#X, got %#X\n", $value, $$result[2]; 107 is ($$result[3], "The End", "4th element"); 108} 109 110$result = eval {thaw $test}; 111isa_ok ($result, 'SCALAR', "CHORUS: check thawing test data"); 112is ($@, '', " causes no errors"); 113is ($$result, 'Hell', " and gives the expected data"); 114 115my $test_kludge; 116{ 117 local $Storable::interwork_56_64bit = 1; 118 $test_kludge = freeze \'Heck'; 119} 120 121my $header_kludge = Storable::read_magic ($test_kludge); 122 123cmp_ok (length ($header_kludge->{byteorder}), '==', $Config{longsize}, 124 "With 5.6 interwork kludge byteorder string should be same size as long" 125 ); 126$result = eval {thaw $test_kludge}; 127is ($result, undef, "By default should not be able to thaw"); 128like ($@, qr/Byte order is not compatible/, 129 "because the header byte order strings differ"); 130 131$result = eval {thaw $test}; 132isa_ok ($result, 'SCALAR', "CHORUS: check thawing test data"); 133is ($@, '', " causes no errors"); 134is ($$result, 'Hell', " and gives the expected data"); 135 136{ 137 local $Storable::interwork_56_64bit = 1; 138 139 $result = eval {thaw $test_kludge}; 140 isa_ok ($result, 'SCALAR', "should be able to thaw kludge data"); 141 is ($@, '', "with no errors"); 142 is ($$result, 'Heck', "and gives expected data"); 143 144 $result = eval {thaw $test}; 145 is ($result, undef, "But now can't thaw real data"); 146 like ($@, qr/Byte order is not compatible/, 147 "because the header byte order strings differ"); 148} 149 150# All together now: 151$result = eval {thaw $test}; 152isa_ok ($result, 'SCALAR', "CHORUS: check thawing test data"); 153is ($@, '', " causes no errors"); 154is ($$result, 'Hell', " and gives the expected data"); 155 156__END__ 157# A whole run of 1.1.14 freeze data, uuencoded. The "mode bits" are the octal 158# value of 'A', the "file name" is the test name. Use make_56_interwork.pl 159# with a copy of Storable 1.X generate these. 160 161# byteorder '1234' 162# sizeof(int) 4 163# sizeof(long) 4 164# sizeof(char *) 4 165# sizeof(NV) 8 166begin 101 Lillput,4,4,4,8 167M!`0$,3(S-`0$!`@"!`````HQ5&AI<R!F:6QE('=A<R!W<FET=&5N('=I=&@@ 168M,2XP,30@;VX@<&5R;"`U+C`P-C`P,0H33&EL;'!U="!W87,@8V]R<F5C=`8" 1690````````@`H'5&AE($5N9``` 170 171end 172 173# byteorder '4321' 174# sizeof(int) 4 175# sizeof(long) 4 176# sizeof(char *) 4 177# sizeof(NV) 8 178begin 101 Belfuscu,4,4,4,8 179M!`0$-#,R,00$!`@"````!`HQ5&AI<R!F:6QE('=A<R!W<FET=&5N('=I=&@@ 180M,2XP,30@;VX@<&5R;"`U+C`P-C`P,0H40F5L9G5S8W4@=V%S(&-O<G)E8W0& 1811@`````````(*!U1H92!%;F0` 182 183end 184 185# byteorder '1234' 186# sizeof(int) 4 187# sizeof(long) 4 188# sizeof(char *) 4 189# sizeof(NV) 12 190begin 101 Lillput,4,4,4,12 191M!`0$,3(S-`0$!`P"!`````HQ5&AI<R!F:6QE('=A<R!W<FET=&5N('=I=&@@ 192M,2XP,30@;VX@<&5R;"`U+C`P-C`P,0H33&EL;'!U="!W87,@8V]R<F5C=`8" 1930````````@`H'5&AE($5N9``` 194 195end 196 197