This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
amigaos4: unlink of open/locked files will fail
authorAndy Broad <andy@broad.ology.org.uk>
Mon, 31 Aug 2015 16:20:52 +0000 (12:20 -0400)
committerJarkko Hietaniemi <jhi@iki.fi>
Sat, 5 Sep 2015 15:12:46 +0000 (11:12 -0400)
doio.c

diff --git a/doio.c b/doio.c
index f41a559..b2d269b 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1975,7 +1975,21 @@ nothing in the core.
             }
            else if (PL_unsafe) {
                if (UNLINK(s))
+               {
                    tot--;
+               }
+#if defined(__amigaos4__) && defined(NEWLIB)
+               else
+               {
+                  /* Under AmigaOS4 unlink only 'fails' if the
+                   * filename is invalid.  It may not remove the file
+                   * if it's locked, so check if it's still around. */
+                  if ((access(s,F_OK) != -1))
+                  {
+                    tot--;
+                  }
+               }
+#endif
            }
            else {      /* don't let root wipe out directories without -U */
                if (PerlLIO_lstat(s,&PL_statbuf) < 0)
@@ -1986,7 +2000,21 @@ nothing in the core.
                }
                else {
                    if (UNLINK(s))
-                       tot--;
+                   {
+                               tot--;
+                       }
+#if defined(__amigaos4__) && defined(NEWLIB)
+                       else
+                       {
+                               /* Under AmigaOS4 unlink only 'fails' if the filename is invalid */
+                               /* It may not remove the file if it's Locked, so check if it's still */
+                               /* arround */
+                               if((access(s,F_OK) != -1))
+                               {
+                                       tot--;
+                               }
+                       }       
+#endif
                }
            }
        }