Commit | Line | Data |
d4b9b6e4 |
1 | #!perl -w |
2 | |
3 | use strict; |
4 | use Test::More; |
5 | use Storable qw(store nstore); |
6 | use Config qw(%Config); |
7 | |
8 | # The @tests array below was create by the following program |
9 | my $dummy = <<'EOT'; |
10 | use Storable; |
11 | use Data::Dump qw(dump); |
12 | |
13 | print "my \@tests = (\n"; |
14 | for my $f (<data_*>) { |
15 | print " [\n"; |
16 | print " " . dump(substr(`cat $f`, 0, 32) . "...") , ",\n"; |
17 | |
18 | my $x = dump(Storable::file_magic($f)); |
19 | $x =~ s/^/ /gm; |
20 | print "$x,\n"; |
21 | |
22 | print " ],\n"; |
23 | } |
24 | print ");\n"; |
25 | EOT |
26 | |
27 | my @tests = ( |
28 | [ |
29 | "perl-store\x041234\4\4\4\xD4\xC2\32\b\3\13\0\0\0v\b\xC5\32\b...", |
30 | { |
31 | byteorder => 1234, |
32 | file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.1.le32", |
33 | hdrsize => 18, |
34 | intsize => 4, |
35 | longsize => 4, |
36 | netorder => 0, |
37 | ptrsize => 4, |
38 | version => -1, |
39 | version_nv => -1, |
40 | }, |
41 | ], |
42 | [ |
43 | "perl-store\0\x041234\4\4\4\x8Co\34\b\3\13\0\0\0v\x94v\34...", |
44 | { |
45 | byteorder => 1234, |
46 | file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.4_07.le32", |
47 | hdrsize => 19, |
48 | intsize => 4, |
49 | longsize => 4, |
50 | major => 0, |
51 | netorder => 0, |
52 | ptrsize => 4, |
53 | version => 0, |
54 | version_nv => 0, |
55 | }, |
56 | ], |
57 | [ |
58 | "perl-store\1\x8Co\34\b\3\0\0\0\13v\x94v\34\b\1\0\0\4\0\0\0...", |
59 | { |
60 | file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.4_07.neutral", |
61 | hdrsize => 11, |
62 | major => 0, |
63 | netorder => 1, |
64 | version => 0, |
65 | version_nv => 0, |
66 | }, |
67 | ], |
68 | [ |
69 | "pst0\2\x041234\4\4\4\3\13\0\0\0\1\0\4\0\0\0\0\0\0\0\0\0\0\0...", |
70 | { |
71 | byteorder => 1234, |
72 | file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.604.le32", |
73 | hdrsize => 13, |
74 | intsize => 4, |
75 | longsize => 4, |
76 | major => 1, |
77 | netorder => 0, |
78 | ptrsize => 4, |
79 | version => 1, |
80 | version_nv => 1, |
81 | }, |
82 | ], |
83 | [ |
84 | "pst0\3\3\0\0\0\13\1\0\0\4\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0...", |
85 | { |
86 | file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.604.neutral", |
87 | hdrsize => 5, |
88 | major => 1, |
89 | netorder => 1, |
90 | version => 1, |
91 | version_nv => 1, |
92 | }, |
93 | ], |
94 | [ |
95 | "pst0\4\0\x041234\4\4\4\3\13\0\0\0\1\0\4\0\0\0\0\0\0\0\0\0\0...", |
96 | { |
97 | byteorder => 1234, |
98 | file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.700.le32", |
99 | hdrsize => 14, |
100 | intsize => 4, |
101 | longsize => 4, |
102 | major => 2, |
103 | minor => 0, |
104 | netorder => 0, |
105 | ptrsize => 4, |
106 | version => "2.0", |
107 | version_nv => "2.000", |
108 | }, |
109 | ], |
110 | [ |
111 | "pst0\5\0\3\0\0\0\13\1\0\0\4\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0...", |
112 | { |
113 | file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.700.neutral", |
114 | hdrsize => 6, |
115 | major => 2, |
116 | minor => 0, |
117 | netorder => 1, |
118 | version => "2.0", |
119 | version_nv => "2.000", |
120 | }, |
121 | ], |
122 | [ |
123 | "pst0\4\4\x041234\4\4\4\b\3\13\0\0\0\1\0\4\0\0\0\0\0\0\0\0\0...", |
124 | { |
125 | byteorder => 1234, |
126 | file => "data_perl-5.006001_i686-linux-thread-multi_Storable-1.012.le32", |
127 | hdrsize => 15, |
128 | intsize => 4, |
129 | longsize => 4, |
130 | major => 2, |
131 | minor => 4, |
132 | netorder => 0, |
133 | nvsize => 8, |
134 | ptrsize => 4, |
135 | version => "2.4", |
136 | version_nv => "2.004", |
137 | }, |
138 | ], |
139 | [ |
140 | "pst0\4\3\x044321\4\4\4\b\3\0\0\0\13\1\0\0\4\0\0\0\0\0\0\0\0...", |
141 | { |
142 | byteorder => 4321, |
143 | file => "data_perl-5.006001_IA64.ARCHREV_0-thread-multi_Storable-1.006.be32", |
144 | hdrsize => 15, |
145 | intsize => 4, |
146 | longsize => 4, |
147 | major => 2, |
148 | minor => 3, |
149 | netorder => 0, |
150 | nvsize => 8, |
151 | ptrsize => 4, |
152 | version => "2.3", |
153 | version_nv => "2.003", |
154 | }, |
155 | ], |
156 | [ |
157 | "pst0\5\3\3\0\0\0\13\1\0\0\4\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0...", |
158 | { |
159 | file => "data_perl-5.006001_IA64.ARCHREV_0-thread-multi_Storable-1.006.neutral", |
160 | hdrsize => 6, |
161 | major => 2, |
162 | minor => 3, |
163 | netorder => 1, |
164 | version => "2.3", |
165 | version_nv => "2.003", |
166 | }, |
167 | ], |
168 | [ |
169 | "pst0\4\4\x044321\4\4\4\b\3\0\0\0\13\1\0\0\4\0\0\0\0\0\0\0\0...", |
170 | { |
171 | byteorder => 4321, |
172 | file => "data_perl-5.006001_IA64.ARCHREV_0-thread-multi_Storable-1.012.be32", |
173 | hdrsize => 15, |
174 | intsize => 4, |
175 | longsize => 4, |
176 | major => 2, |
177 | minor => 4, |
178 | netorder => 0, |
179 | nvsize => 8, |
180 | ptrsize => 4, |
181 | version => "2.4", |
182 | version_nv => "2.004", |
183 | }, |
184 | ], |
185 | [ |
186 | "pst0\5\4\3\0\0\0\13\1\0\0\4\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0...", |
187 | { |
188 | file => "data_perl-5.006001_IA64.ARCHREV_0-thread-multi_Storable-1.012.neutral", |
189 | hdrsize => 6, |
190 | major => 2, |
191 | minor => 4, |
192 | netorder => 1, |
193 | version => "2.4", |
194 | version_nv => "2.004", |
195 | }, |
196 | ], |
197 | [ |
198 | "pst0\4\6\x044321\4\4\4\b\3\0\0\0\13\n\n4294967296...", |
199 | { |
200 | byteorder => 4321, |
201 | file => "data_perl-5.008001_darwin-thread-multi-2level_Storable-2.08.be32", |
202 | hdrsize => 15, |
203 | intsize => 4, |
204 | longsize => 4, |
205 | major => 2, |
206 | minor => 6, |
207 | netorder => 0, |
208 | nvsize => 8, |
209 | ptrsize => 4, |
210 | version => "2.6", |
211 | version_nv => "2.006", |
212 | }, |
213 | ], |
214 | [ |
215 | "pst0\5\6\3\0\0\0\13\n\n4294967296\0\0\0\bfour_...", |
216 | { |
217 | file => "data_perl-5.008001_darwin-thread-multi-2level_Storable-2.08.neutral", |
218 | hdrsize => 6, |
219 | major => 2, |
220 | minor => 6, |
221 | netorder => 1, |
222 | version => "2.6", |
223 | version_nv => "2.006", |
224 | }, |
225 | ], |
226 | [ |
227 | "pst0\4\6\x044321\4\4\4\b\3\0\0\0\13\4\3\0\0\0\0\0\0\0\nem...", |
228 | { |
229 | byteorder => 4321, |
230 | file => "data_perl-5.008003_PA-RISC1.1-thread-multi_Storable-2.09.be32", |
231 | hdrsize => 15, |
232 | intsize => 4, |
233 | longsize => 4, |
234 | major => 2, |
235 | minor => 6, |
236 | netorder => 0, |
237 | nvsize => 8, |
238 | ptrsize => 4, |
239 | version => "2.6", |
240 | version_nv => "2.006", |
241 | }, |
242 | ], |
243 | [ |
244 | "pst0\5\6\3\0\0\0\13\4\3\0\0\0\0\0\0\0\nempty_hash\n...", |
245 | { |
246 | file => "data_perl-5.008003_PA-RISC1.1-thread-multi_Storable-2.09.neutral", |
247 | hdrsize => 6, |
248 | major => 2, |
249 | minor => 6, |
250 | netorder => 1, |
251 | version => "2.6", |
252 | version_nv => "2.006", |
253 | }, |
254 | ], |
255 | [ |
256 | "pst0\4\6\b12345678\4\4\4\b\3\13\0\0\0\4\3\0\0\0\0\n\0...", |
257 | { |
258 | byteorder => 12_345_678, |
259 | file => "data_perl-5.008004_i86pc-solaris-64int_Storable-2.12.le64", |
260 | hdrsize => 19, |
261 | intsize => 4, |
262 | longsize => 4, |
263 | major => 2, |
264 | minor => 6, |
265 | netorder => 0, |
266 | nvsize => 8, |
267 | ptrsize => 4, |
268 | version => "2.6", |
269 | version_nv => "2.006", |
270 | }, |
271 | ], |
272 | [ |
273 | "pst0\4\6\x041234\4\4\4\b\3\13\0\0\0\4\3\0\0\0\0\n\0\0\0em...", |
274 | { |
275 | byteorder => 1234, |
276 | file => "data_perl-5.008006_i686-linux-thread-multi_Storable-2.13.le32", |
277 | hdrsize => 15, |
278 | intsize => 4, |
279 | longsize => 4, |
280 | major => 2, |
281 | minor => 6, |
282 | netorder => 0, |
283 | nvsize => 8, |
284 | ptrsize => 4, |
285 | version => "2.6", |
286 | version_nv => "2.006", |
287 | }, |
288 | ], |
289 | [ |
290 | "pst0\4\6\b87654321\4\b\b\b\3\0\0\0\13\4\3\0\0\0\0\0\0...", |
291 | { |
292 | byteorder => 87_654_321, |
293 | file => "data_perl-5.008007_IA64.ARCHREV_0-thread-multi-LP64_Storable-2.13.be64", |
294 | hdrsize => 19, |
295 | intsize => 4, |
296 | longsize => 8, |
297 | major => 2, |
298 | minor => 6, |
299 | netorder => 0, |
300 | nvsize => 8, |
301 | ptrsize => 8, |
302 | version => "2.6", |
303 | version_nv => "2.006", |
304 | }, |
305 | ], |
306 | [ |
307 | "pst0\4\a\b12345678\4\b\b\b\3\13\0\0\0\4\3\0\0\0\0\n\0...", |
308 | { |
309 | byteorder => 12_345_678, |
310 | file => "data_perl-5.008007_x86-solaris-thread-multi-64_Storable-2.15.le64", |
311 | hdrsize => 19, |
312 | intsize => 4, |
313 | longsize => 8, |
314 | major => 2, |
315 | minor => 7, |
316 | netorder => 0, |
317 | nvsize => 8, |
318 | ptrsize => 8, |
319 | version => "2.7", |
320 | version_nv => "2.007", |
321 | }, |
322 | ], |
323 | [ |
324 | "pst0\5\a\3\0\0\0\13\4\3\0\0\0\0\0\0\0\nempty_hash\n...", |
325 | { |
326 | file => "data_perl-5.008007_x86-solaris-thread-multi-64_Storable-2.15.neutral", |
327 | hdrsize => 6, |
328 | major => 2, |
329 | minor => 7, |
330 | netorder => 1, |
331 | version => "2.7", |
332 | version_nv => "2.007", |
333 | }, |
334 | ], |
335 | [ |
336 | "pst0\4\5\x041234\4\4\4\b\3\13\0\0\0\4\3\0\0\0\0\n\0\0\0em...", |
337 | { |
338 | byteorder => 1234, |
339 | file => "data_perl-5.008_i686-linux-thread-multi_Storable-2.04.le32", |
340 | hdrsize => 15, |
341 | intsize => 4, |
342 | longsize => 4, |
343 | major => 2, |
344 | minor => 5, |
345 | netorder => 0, |
346 | nvsize => 8, |
347 | ptrsize => 4, |
348 | version => "2.5", |
349 | version_nv => "2.005", |
350 | }, |
351 | ], |
352 | [ |
353 | "pst0\5\5\3\0\0\0\13\4\3\0\0\0\0\0\0\0\nempty_hash\n...", |
354 | { |
355 | file => "data_perl-5.008_i686-linux-thread-multi_Storable-2.04.neutral", |
356 | hdrsize => 6, |
357 | major => 2, |
358 | minor => 5, |
359 | netorder => 1, |
360 | version => "2.5", |
361 | version_nv => "2.005", |
362 | }, |
363 | ], |
364 | [ |
365 | "pst0\4\a\x041234\4\4\4\b\3\13\0\0\0\4\3\0\0\0\0\n\0\0\0em...", |
366 | { |
367 | byteorder => 1234, |
368 | file => "data_perl-5.009003_i686-linux_Storable-2.15.le32", |
369 | hdrsize => 15, |
370 | intsize => 4, |
371 | longsize => 4, |
372 | major => 2, |
373 | minor => 7, |
374 | netorder => 0, |
375 | nvsize => 8, |
376 | ptrsize => 4, |
377 | version => "2.7", |
378 | version_nv => "2.007", |
379 | }, |
380 | ], |
381 | ); |
382 | |
383 | plan tests => 31 + 2 * @tests; |
384 | |
385 | my $file = "xx-$$.pst"; |
386 | |
387 | is(eval { Storable::file_magic($file) }, undef, "empty file give undef"); |
ab6f8ca1 |
388 | like($@, qq{/^Can't open '\Q$file\E':/}, "...and croaks"); |
d4b9b6e4 |
389 | is(Storable::file_magic(__FILE__), undef, "not an image"); |
390 | |
391 | store({}, $file); |
392 | { |
393 | my $info = Storable::file_magic($file); |
394 | unlink($file); |
395 | ok($info, "got info"); |
396 | is($info->{file}, $file, "file set"); |
397 | is($info->{hdrsize}, 11 + length($Config{byteorder}), "hdrsize"); |
ab6f8ca1 |
398 | like($info->{version}, q{/^2\.\d+$/}, "sane version"); |
d4b9b6e4 |
399 | is($info->{version_nv}, Storable::BIN_WRITE_VERSION_NV, "version_nv match"); |
400 | is($info->{major}, 2, "sane major"); |
401 | ok($info->{minor}, "have minor"); |
402 | ok($info->{minor} >= Storable::BIN_WRITE_MINOR, "large enough minor"); |
403 | |
404 | ok(!$info->{netorder}, "no netorder"); |
ab6f8ca1 |
405 | |
406 | my %attrs = ( |
407 | nvsize => 5.006, |
408 | ptrsize => 5.005, |
409 | map {$_ => 5.004} qw(byteorder intsize longsize) |
410 | ); |
411 | for my $attr (keys %attrs) { |
412 | SKIP: { |
413 | skip "attribute $attr not available on this version of Perl", 1 if $attrs{$attr} > $]; |
414 | is($info->{$attr}, $Config{$attr}, "$attr match Config"); |
415 | } |
d4b9b6e4 |
416 | } |
417 | } |
418 | |
419 | nstore({}, $file); |
420 | { |
421 | my $info = Storable::file_magic($file); |
422 | unlink($file); |
423 | ok($info, "got info"); |
424 | is($info->{file}, $file, "file set"); |
425 | is($info->{hdrsize}, 6, "hdrsize"); |
ab6f8ca1 |
426 | like($info->{version}, q{/^2\.\d+$/}, "sane version"); |
d4b9b6e4 |
427 | is($info->{version_nv}, Storable::BIN_WRITE_VERSION_NV, "version_nv match"); |
428 | is($info->{major}, 2, "sane major"); |
429 | ok($info->{minor}, "have minor"); |
430 | ok($info->{minor} >= Storable::BIN_WRITE_MINOR, "large enough minor"); |
431 | |
432 | ok($info->{netorder}, "no netorder"); |
433 | for (qw(byteorder intsize longsize ptrsize nvsize)) { |
434 | ok(!exists $info->{$_}, "no $_"); |
435 | } |
436 | } |
437 | |
438 | for my $test (@tests) { |
439 | my($data, $expected) = @$test; |
440 | open(FH, ">$file") || die "Can't create $file: $!"; |
441 | binmode(FH); |
442 | print FH $data; |
443 | close(FH) || die "Can't write $file: $!"; |
444 | |
445 | my $name = $expected->{file}; |
446 | $expected->{file} = $file; |
447 | |
448 | my $info = Storable::file_magic($file); |
449 | unlink($file); |
450 | |
451 | is_deeply($info, $expected, "file_magic $name"); |
452 | |
453 | $expected->{file} = 1; |
454 | is_deeply(Storable::read_magic($data), $expected, "read magic $name"); |
455 | } |