1N/A# Copyright 2002, Larry Wall. 1N/A# You may redistribute only under the same terms as Perl 5, as specified 1N/A# in the README file that comes with the distribution. 1N/A# I'm trying to keep this test easily backwards compatible to 5.004, so no 1N/A# This test tries to craft malicious data to test out as many different 1N/A# error traps in Storable as possible 1N/A# It also acts as a test for read_header 1N/A chdir('t') if -d 't'; 1N/A # This lets us distribute Test::More in t/ 1N/A print "1..0 # Skip: Storable was not built\n"; 1N/A# If it's 5.7.3 or later the hash will be stored with flags, which is 1N/A# 2 extra bytes. There are 2 * 2 * 2 tests per byte in the body and header 1N/A# common to normal and network order serialised objects (hence the 8) 1N/A# There are only 2 * 2 tests per byte in the parts of the header not present 1N/A# for network order, and 2 tests per byte on the 'pst0' "magic number" only 1N/A# present in files, but not in things store()ed to memory 1N/Adie "Temporary file 'malice.$$' already exists" if -e
$file;
1N/A# The chr 256 is a hack to force the hash to always have the utf8 keys flag 1N/A# set on 5.7.3 and later. Otherwise the test fails if run with -Mutf8 because 1N/A# only there does the hash has the flag on, and hence only there is it stored 1N/A# as a flagged hash, which is 2 bytes longer 1N/A # Network order header has no sizes 1N/A skip ("No \$Config{prtsize} on this perl version ($])", 1) 1N/A "nv size"); # 5.00405 doesn't even have doublesize in config. 1N/A # local $Storable::DEBUGME = 1; 1N/A like ($@, "/^Magic number checking on storable $what failed/", 1N/A "Should croak with magic number warning"); 1N/A is ($@, "", "Should not set \$\@"); 1N/A # Test that if we re-write it, everything still works: 1N/A is ($@, "", "There should be no error"); 1N/A # Now lets check the short version: 1N/A # Needs to be more than 1, as we're already coding a spread of 1 minor version 1N/A # number on writes (2.5, 2.4). May increase to 2 if we figure we can do 2.3 1N/A # on 5.005_03 (No utf8). 1N/A # 4 allows for a small safety margin 1N/A # Question: What is the value of pi? 1N/A # Mathematician answers "It's pi, isn't it" 1N/A # Physicist answers "3.1, within experimental error" 1N/A # Engineer answers "Well, allowing for a small safety margin, 18" 1N/A # Now by default newer minor version numbers are not a pain. 1N/A is ($@, "", "by default no error on higher minor"); 1N/A # Continue messing with the previous copy 1N/A "higher major, lower minor"); 1N/A # All these are omitted from the network order header. 1N/A # I'm not sure if it's correct to omit the byte size stuff. 1N/A foreach (['intsize', "Integer"], 1N/A ['longsize', "Long integer"], 1N/A ['ptrsize', "Pointer"], 1N/A ['nvsize', "Double"]) { 1N/A # Just the header and a tag 255. As 26 is currently the highest tag, this 1N/A # Now drop the minor version number 1N/A "bogus tag, minor less 1"); 1N/A # Now increase the minor version number 1N/A # local $Storable::DEBUGME = 1; 1N/A # This is the delayed croak 1N/A "/^Storable binary image v$header->{major}.$minor4 contains data of type 255. This Storable is v$header->{major}.$minor and can only handle data types up to 26/", 1N/A "bogus tag, minor plus 4"); 1N/A # And check again that this croak is not delayed: 1N/A # local $Storable::DEBUGME = 1; 1N/Adie "Don't seem to have written file '$file' as I can't get its length: $!" 1N/A# Read the contents into memory: 1N/A# Test the original direct from disk 1N/A# And now try almost everything again with a Storable string 1N/Adie "Don't seem to have written file '$file' as I can't get its length: $!" 1N/A# Read the contents into memory: 1N/A# Test the original direct from disk 1N/A# And now try almost everything again with a Storable string 1N/A# Test that the bug fixed by #20587 doesn't affect us under some older 1N/A # If we were built with -DDEBUGGING, the assert() should have killed 1N/A # us, which will probably alert the user that something went wrong.