Remove POSIX's internal implementation of S_ISBLK, S_ISCHR, S_ISDIR,

S_ISFIFO and S_ISREG, and pull them in from Fcntl. Spotted as a result
of bug #54186, but there has been a redefined subroutine warning for
ages if you elected to import all of POSIX and Fcntl's exports.

p4raw-id: //depot/perl@33826

diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index 7b9dd16..6b818a8 100644 (file)
--- a/ext/B/t/concise-xs.t
+++ b/ext/B/t/concise-xs.t
@@ -177,7 +177,10 @@ my $testpkgs = {
                 },
 
     POSIX => { dflt => 'constant',                     # all but 252/589
-              skip => [qw/ _POSIX_JOB_CONTROL /],      # platform varying
+              skip => [qw/ _POSIX_JOB_CONTROL /,       # platform varying
+                       # Might be XS or imported from Fctnl, depending on your
+                       # perl version:
+                       qw / S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG /],
               perl => [qw/ import croak AUTOLOAD /],
 
               XS => [qw/ write wctomb wcstombs uname tzset tzname

diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm
index 9704d4f..2ceba9f 100644 (file)
--- a/ext/POSIX/POSIX.pm
+++ b/ext/POSIX/POSIX.pm
@@ -14,6 +14,7 @@ use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD
             F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND
             O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC
             O_WRONLY SEEK_CUR SEEK_END SEEK_SET
+            S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG
             S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID
             S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR);
 
@@ -34,9 +35,9 @@ sub usage;
 
 XSLoader::load 'POSIX', $VERSION;
 
-my %NON_CONSTS = (map {($_,1)}
-                  qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS
-                     WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
+my %NON_CONSTS
+  = (map {($_,1)} qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG
+                    WTERMSIG));
 
 sub AUTOLOAD {
     no strict;

diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 3092934..b61b0a6 100644 (file)
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -404,7 +404,7 @@ int_macro_int (const char *name, STRLEN len, IV *arg_result) {
 use ExtUtils::Constant qw (constant_types C_constant XS_constant);
 
 my $types = {map {($_, 1)} qw(IV)};
-my @names = (qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS WIFEXITED
+my @names = (qw(WEXITSTATUS WIFEXITED
               WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
 
 print constant_types(); # macro defs
@@ -416,65 +416,14 @@ print XS_constant ("POSIX", $types);
    */
 
   switch (len) {
-  case 7:
-    /* Names all of length 7.  */
-    /* S_ISBLK S_ISCHR S_ISDIR S_ISREG */
-    /* Offset 5 gives the best switch position.  */
-    switch (name[5]) {
-    case 'E':
-      if (memEQ(name, "S_ISREG", 7)) {
-      /*                    ^       */
-#ifdef S_ISREG
-        *arg_result = S_ISREG(*arg_result);
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'H':
-      if (memEQ(name, "S_ISCHR", 7)) {
-      /*                    ^       */
-#ifdef S_ISCHR
-        *arg_result = S_ISCHR(*arg_result);
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'I':
-      if (memEQ(name, "S_ISDIR", 7)) {
-      /*                    ^       */
-#ifdef S_ISDIR
-        *arg_result = S_ISDIR(*arg_result);
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    case 'L':
-      if (memEQ(name, "S_ISBLK", 7)) {
-      /*                    ^       */
-#ifdef S_ISBLK
-        *arg_result = S_ISBLK(*arg_result);
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
-    }
-    break;
   case 8:
     /* Names all of length 8.  */
-    /* S_ISFIFO WSTOPSIG WTERMSIG */
-    /* Offset 3 gives the best switch position.  */
-    switch (name[3]) {
-    case 'O':
+    /* WSTOPSIG WTERMSIG */
+    /* Offset 1 gives the best switch position.  */
+    switch (name[1]) {
+    case 'S':
       if (memEQ(name, "WSTOPSIG", 8)) {
-      /*                  ^          */
+      /*                ^            */
 #ifdef WSTOPSIG
         int i = *arg_result;
         *arg_result = WSTOPSIG(WMUNGE(i));
@@ -484,9 +433,9 @@ print XS_constant ("POSIX", $types);
 #endif
       }
       break;
-    case 'R':
+    case 'T':
       if (memEQ(name, "WTERMSIG", 8)) {
-      /*                  ^          */
+      /*                ^            */
 #ifdef WTERMSIG
         int i = *arg_result;
         *arg_result = WTERMSIG(WMUNGE(i));
@@ -496,17 +445,6 @@ print XS_constant ("POSIX", $types);
 #endif
       }
       break;
-    case 'S':
-      if (memEQ(name, "S_ISFIFO", 8)) {
-      /*                  ^          */
-#ifdef S_ISFIFO
-        *arg_result = S_ISFIFO(*arg_result);
-        return PERL_constant_ISIV;
-#else
-        return PERL_constant_NOTDEF;
-#endif
-      }
-      break;
     }
     break;
   case 9: