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