5 use Storable qw(store nstore);
6 use Config qw(%Config);
8 # The @tests array below was create by the following program
11 use Data::Dump qw(dump);
13 print "my \@tests = (\n";
14 for my $f (<data_*>) {
16 print " " . dump(substr(`cat $f`, 0, 32) . "...") , ",\n";
18 my $x = dump(Storable::file_magic($f));
29 "perl-store\x041234\4\4\4\xD4\xC2\32\b\3\13\0\0\0v\b\xC5\32\b...",
32 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.1.le32",
43 "perl-store\0\x041234\4\4\4\x8Co\34\b\3\13\0\0\0v\x94v\34...",
46 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.4_07.le32",
58 "perl-store\1\x8Co\34\b\3\0\0\0\13v\x94v\34\b\1\0\0\4\0\0\0...",
60 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.4_07.neutral",
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...",
72 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.604.le32",
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...",
86 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.604.neutral",
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...",
98 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.700.le32",
107 version_nv => "2.000",
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...",
113 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-0.700.neutral",
119 version_nv => "2.000",
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...",
126 file => "data_perl-5.006001_i686-linux-thread-multi_Storable-1.012.le32",
136 version_nv => "2.004",
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...",
143 file => "data_perl-5.006001_IA64.ARCHREV_0-thread-multi_Storable-1.006.be32",
153 version_nv => "2.003",
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...",
159 file => "data_perl-5.006001_IA64.ARCHREV_0-thread-multi_Storable-1.006.neutral",
165 version_nv => "2.003",
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...",
172 file => "data_perl-5.006001_IA64.ARCHREV_0-thread-multi_Storable-1.012.be32",
182 version_nv => "2.004",
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...",
188 file => "data_perl-5.006001_IA64.ARCHREV_0-thread-multi_Storable-1.012.neutral",
194 version_nv => "2.004",
198 "pst0\4\6\x044321\4\4\4\b\3\0\0\0\13\n\n4294967296...",
201 file => "data_perl-5.008001_darwin-thread-multi-2level_Storable-2.08.be32",
211 version_nv => "2.006",
215 "pst0\5\6\3\0\0\0\13\n\n4294967296\0\0\0\bfour_...",
217 file => "data_perl-5.008001_darwin-thread-multi-2level_Storable-2.08.neutral",
223 version_nv => "2.006",
227 "pst0\4\6\x044321\4\4\4\b\3\0\0\0\13\4\3\0\0\0\0\0\0\0\nem...",
230 file => "data_perl-5.008003_PA-RISC1.1-thread-multi_Storable-2.09.be32",
240 version_nv => "2.006",
244 "pst0\5\6\3\0\0\0\13\4\3\0\0\0\0\0\0\0\nempty_hash\n...",
246 file => "data_perl-5.008003_PA-RISC1.1-thread-multi_Storable-2.09.neutral",
252 version_nv => "2.006",
256 "pst0\4\6\b12345678\4\4\4\b\3\13\0\0\0\4\3\0\0\0\0\n\0...",
258 byteorder => 12_345_678,
259 file => "data_perl-5.008004_i86pc-solaris-64int_Storable-2.12.le64",
269 version_nv => "2.006",
273 "pst0\4\6\x041234\4\4\4\b\3\13\0\0\0\4\3\0\0\0\0\n\0\0\0em...",
276 file => "data_perl-5.008006_i686-linux-thread-multi_Storable-2.13.le32",
286 version_nv => "2.006",
290 "pst0\4\6\b87654321\4\b\b\b\3\0\0\0\13\4\3\0\0\0\0\0\0...",
292 byteorder => 87_654_321,
293 file => "data_perl-5.008007_IA64.ARCHREV_0-thread-multi-LP64_Storable-2.13.be64",
303 version_nv => "2.006",
307 "pst0\4\a\b12345678\4\b\b\b\3\13\0\0\0\4\3\0\0\0\0\n\0...",
309 byteorder => 12_345_678,
310 file => "data_perl-5.008007_x86-solaris-thread-multi-64_Storable-2.15.le64",
320 version_nv => "2.007",
324 "pst0\5\a\3\0\0\0\13\4\3\0\0\0\0\0\0\0\nempty_hash\n...",
326 file => "data_perl-5.008007_x86-solaris-thread-multi-64_Storable-2.15.neutral",
332 version_nv => "2.007",
336 "pst0\4\5\x041234\4\4\4\b\3\13\0\0\0\4\3\0\0\0\0\n\0\0\0em...",
339 file => "data_perl-5.008_i686-linux-thread-multi_Storable-2.04.le32",
349 version_nv => "2.005",
353 "pst0\5\5\3\0\0\0\13\4\3\0\0\0\0\0\0\0\nempty_hash\n...",
355 file => "data_perl-5.008_i686-linux-thread-multi_Storable-2.04.neutral",
361 version_nv => "2.005",
365 "pst0\4\a\x041234\4\4\4\b\3\13\0\0\0\4\3\0\0\0\0\n\0\0\0em...",
368 file => "data_perl-5.009003_i686-linux_Storable-2.15.le32",
378 version_nv => "2.007",
383 plan tests => 31 + 2 * @tests;
385 my $file = "xx-$$.pst";
387 is(eval { Storable::file_magic($file) }, undef, "empty file give undef");
388 like($@, qq{/^Can't open '\Q$file\E':/}, "...and croaks");
389 is(Storable::file_magic(__FILE__), undef, "not an image");
393 my $info = Storable::file_magic($file);
395 ok($info, "got info");
396 is($info->{file}, $file, "file set");
397 is($info->{hdrsize}, 11 + length($Config{byteorder}), "hdrsize");
398 like($info->{version}, q{/^2\.\d+$/}, "sane version");
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");
404 ok(!$info->{netorder}, "no netorder");
409 map {$_ => 5.004} qw(byteorder intsize longsize)
411 for my $attr (keys %attrs) {
413 skip "attribute $attr not available on this version of Perl", 1 if $attrs{$attr} > $];
414 is($info->{$attr}, $Config{$attr}, "$attr match Config");
421 my $info = Storable::file_magic($file);
423 ok($info, "got info");
424 is($info->{file}, $file, "file set");
425 is($info->{hdrsize}, 6, "hdrsize");
426 like($info->{version}, q{/^2\.\d+$/}, "sane version");
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");
432 ok($info->{netorder}, "no netorder");
433 for (qw(byteorder intsize longsize ptrsize nvsize)) {
434 ok(!exists $info->{$_}, "no $_");
438 for my $test (@tests) {
439 my($data, $expected) = @$test;
440 open(FH, ">$file") || die "Can't create $file: $!";
443 close(FH) || die "Can't write $file: $!";
445 my $name = $expected->{file};
446 $expected->{file} = $file;
448 my $info = Storable::file_magic($file);
451 is_deeply($info, $expected, "file_magic $name");
453 $expected->{file} = 1;
454 is_deeply(Storable::read_magic($data), $expected, "read magic $name");