Re: [Patch] Fix some of the tests of Storable on Perl 5.004

Message-ID: <1173961567.45f93b5f0fc9f@imp.free.fr>
Date: Thu, 15 Mar 2007 13:26:07 +0100

p4raw-id: //depot/perl@30594

diff --git a/ext/Storable/Storable.pm b/ext/Storable/Storable.pm
index dd02fe6..77b1b5c 100644 (file)
--- a/ext/Storable/Storable.pm
+++ b/ext/Storable/Storable.pm
@@ -20,6 +20,7 @@ package Storable; @ISA = qw(Exporter DynaLoader);
 );
 
 use AutoLoader;
+use FileHandle;
 use vars qw($canonical $forgive_me $VERSION);
 
 $VERSION = '2.15_02';
@@ -116,7 +117,8 @@ EOM
 
 sub file_magic {
     my $file = shift;
-    open(my $fh, "<", $file) || die "Can't open '$file': $!";
+    my $fh = new FileHandle;
+    open($fh, "<". $file) || die "Can't open '$file': $!";
     binmode($fh);
     defined(sysread($fh, my $buf, 32)) || die "Can't read from '$file': $!";
     close($fh);

diff --git a/ext/Storable/t/file_magic.t b/ext/Storable/t/file_magic.t
index 5b4be82..f5606c5 100644 (file)
--- a/ext/Storable/t/file_magic.t
+++ b/ext/Storable/t/file_magic.t
@@ -385,7 +385,7 @@ plan tests => 31 + 2 * @tests;
 my $file = "xx-$$.pst";
 
 is(eval { Storable::file_magic($file) }, undef, "empty file give undef");
-like($@, qr/^Can't open '\Q$file\E':/, "...and croaks");
+like($@, qq{/^Can't open '\Q$file\E':/}, "...and croaks");
 is(Storable::file_magic(__FILE__), undef, "not an image");
 
 store({}, $file);
@@ -395,15 +395,24 @@ store({}, $file);
     ok($info, "got info");
     is($info->{file}, $file, "file set");
     is($info->{hdrsize}, 11 + length($Config{byteorder}), "hdrsize");
-    like($info->{version}, qr/^2\.\d+$/, "sane version");
+    like($info->{version}, q{/^2\.\d+$/}, "sane version");
     is($info->{version_nv}, Storable::BIN_WRITE_VERSION_NV, "version_nv match");
     is($info->{major}, 2, "sane major");
     ok($info->{minor}, "have minor");
     ok($info->{minor} >= Storable::BIN_WRITE_MINOR, "large enough minor");
 
     ok(!$info->{netorder}, "no netorder");
-    for (qw(byteorder intsize longsize ptrsize nvsize)) {
-       is($info->{$_}, $Config{$_}, "$_ match Config");
+
+    my %attrs = (
+        nvsize  => 5.006, 
+        ptrsize => 5.005, 
+        map {$_ => 5.004} qw(byteorder intsize longsize)
+    );
+    for my $attr (keys %attrs) {
+        SKIP: {
+            skip "attribute $attr not available on this version of Perl", 1 if $attrs{$attr} > $];
+            is($info->{$attr}, $Config{$attr}, "$attr match Config");
+        }
     }
 }
 
@@ -414,7 +423,7 @@ nstore({}, $file);
     ok($info, "got info");
     is($info->{file}, $file, "file set");
     is($info->{hdrsize}, 6, "hdrsize");
-    like($info->{version}, qr/^2\.\d+$/, "sane version");
+    like($info->{version}, q{/^2\.\d+$/}, "sane version");
     is($info->{version_nv}, Storable::BIN_WRITE_VERSION_NV, "version_nv match");
     is($info->{major}, 2, "sane major");
     ok($info->{minor}, "have minor");

diff --git a/ext/Storable/t/threads.t b/ext/Storable/t/threads.t
index 9c55b72..664566e 100644 (file)
--- a/ext/Storable/t/threads.t
+++ b/ext/Storable/t/threads.t
@@ -34,7 +34,7 @@ sub BEGIN {
     }
     # - is \W, so can't use \b at start. Negative look ahead and look behind
     # works at start/end of string, or where preceded/followed by spaces
-    if ($] == 5.008002 and $Config{'ccflags'} =~ /(?<!\S)-DDEBUGGING(?!\S)/) {
+    if ($] == 5.008002 and eval q{ $Config{'ccflags'} =~ /(?<!\S)-DDEBUGGING(?!\S)/ }) {
        # Bug caused by change 21610, fixed by change 21849
         print "1..0 # Skip: tickles bug in threads combined with -DDEBUGGING on 5.8.2\n";
         exit 0;