Avoid Storable locking on DJGPP for now.

Subject: [PATCH] Re: [ID 20001020.009] Not OK: perl v5.7.0 +DEVEL7368 on dos-djgpp djgpp
Message-Id: <4.3.1.0.20001022194247.00acfee0@pop5.banet.net>

p4raw-id: //depot/perl@7409

diff --git a/ext/Storable/Storable.pm b/ext/Storable/Storable.pm
index 76c3209..aada65e 100644 (file)
--- a/ext/Storable/Storable.pm
+++ b/ext/Storable/Storable.pm
@@ -118,6 +118,11 @@ sub _store {
        open(FILE, ">$file") || logcroak "can't create $file: $!";
        binmode FILE;                           # Archaic systems...
        if ($use_locking) {
+               if ($^O eq 'dos') {
+                   require Carp;
+                   Carp::carp "Storable::lock_store: fcntl/flock emulation broken on $^O\n";
+                   return undef;
+               }
                flock(FILE, LOCK_EX) ||
                        logcroak "can't get exclusive lock on $file: $!";
                truncate FILE, 0;
@@ -234,7 +239,13 @@ sub _retrieve {
        my $self;
        my $da = $@;                                                    # Could be from exception handler
        if ($use_locking) {
-               flock(FILE, LOCK_SH) || logcroak "can't get shared lock on $file: $!";
+               if ($^O eq 'dos') {
+                       require Carp;
+                       Carp::carp "Storable::lock_retrieve: fcntl/flock emulation broken on $^O\n";
+                       return undef;
+               }
+               flock(FILE, LOCK_SH) ||
+                   logcroak "can't get shared lock on $file: $!";
                # Unlocking will happen when FILE is closed
        }
        eval { $self = pretrieve(*FILE) };              # Call C routine

diff --git a/t/lib/st-lock.t b/t/lib/st-lock.t
index 28fe664..1e6ae63 100644 (file)
--- a/t/lib/st-lock.t
+++ b/t/lib/st-lock.t
@@ -12,7 +12,7 @@
 
 sub BEGIN {
     chdir('t') if -d 't';
-    @INC = '.'; 
+    @INC = '.';
     push @INC, '../lib';
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bStorable\b/) {
@@ -23,6 +23,10 @@ sub BEGIN {
         print "1..0 # Skip: no flock or flock emulation on this platform\n";
         exit 0;
     }
+    if ($Config{'osname'} eq 'dos') {
+       print "1..0 # Skip: fcntl/flock emulation broken on this platform\n";
+       exit 0;
+    }
     require 'lib/st-dump.pl';
 }