Replace #7409 with

Subject: Re: [PATCH] Re: [ID 20001020.009] Not OK: perl v5.7.0 +DEVEL7368 on dos-djgpp djgp
Message-ID: <20001023200855.A14850@nice.ram.loc>

p4raw-id: //depot/perl@7418

diff --git a/ext/Storable/Storable.pm b/ext/Storable/Storable.pm
index aada65e..df3e946 100644 (file)
--- a/ext/Storable/Storable.pm
+++ b/ext/Storable/Storable.pm
@@ -26,7 +26,7 @@ package Storable; @ISA = qw(Exporter DynaLoader);
 use AutoLoader;
 use vars qw($forgive_me $VERSION);
 
-$VERSION = '1.003';
+$VERSION = '1.004';
 *AUTOLOAD = \&AutoLoader::AUTOLOAD;            # Grrr...
 
 #
@@ -41,6 +41,10 @@ unless (defined @Log::Agent::EXPORT) {
                        require Carp;
                        Carp::croak(@_);
                }
+               sub logcarp {
+                       require Carp;
+                       Carp::carp(@_);
+               }
        };
 }
 
@@ -61,6 +65,7 @@ BEGIN {
 }
 
 sub logcroak;
+sub logcarp;
 
 sub retrieve_fd { &fd_retrieve }               # Backward compatibility
 
@@ -119,9 +124,8 @@ sub _store {
        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;
+                       logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O";
+                       return undef;
                }
                flock(FILE, LOCK_EX) ||
                        logcroak "can't get exclusive lock on $file: $!";
@@ -239,13 +243,11 @@ sub _retrieve {
        my $self;
        my $da = $@;                                                    # Could be from exception handler
        if ($use_locking) {
-               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: $!";
+               if ($^O eq 'dos') {
+                       logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O";
+                       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 1e6ae63..80a7d2c 100644 (file)
--- a/t/lib/st-lock.t
+++ b/t/lib/st-lock.t
@@ -1,18 +1,28 @@
 #!./perl
 
-# $Id: lock.t,v 1.0.1.1 2000/09/28 21:44:06 ram Exp $
+# $Id: lock.t,v 1.0.1.2 2000/10/23 18:03:07 ram Exp ram $
 #
 #  @COPYRIGHT@
 #
 # $Log: lock.t,v $
+# Revision 1.0.1.2  2000/10/23 18:03:07  ram
+# patch4: protected calls to flock() for dos platform
+#
 # Revision 1.0.1.1  2000/09/28 21:44:06  ram
 # patch2: created.
 #
 #
 
+use Config;
+
+if ($Config{'osname'} eq 'dos') {
+       print "1..0 # Skip: fcntl/flock emulation broken on this platform\n";
+       exit 0;
+}
+
 sub BEGIN {
     chdir('t') if -d 't';
-    @INC = '.';
+    @INC = '.'; 
     push @INC, '../lib';
     require Config; import Config;
     if ($Config{'extensions'} !~ /\bStorable\b/) {
@@ -23,10 +33,6 @@ 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';
 }