Add Perl_my_dirfd() to util.c

p4raw-id: //depot/perl@31112

diff --git a/doio.c b/doio.c
index 2d901fd..7269c28 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1274,17 +1274,7 @@ Perl_my_stat(pTHX)
            if (IoIFP(io)) {
                return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
             } else if (IoDIRP(io)) {
-#ifdef HAS_DIRFD
-                return (PL_laststatval = PerlLIO_fstat(dirfd(IoDIRP(io)), &PL_statcache));
-#else
-                Perl_die(aTHX_ PL_no_func, "dirfd");
-               /* NOT REACHED */
-               return 0;
-               /* Can't use NORETURN_FUNCTION_END because Perl_die is not
-                *     __attribute__noreturn__
-                * Can't use DIE because that does not return an integer
-                */
-#endif
+                return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache));
             } else {
                 if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
                     report_evil_fh(gv, io, PL_op->op_type);

diff --git a/embed.fnc b/embed.fnc
index e92a477..16b75b1 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1585,6 +1585,7 @@ Apd       |char*  |sv_pvn_force_flags|NN SV* sv|NULLOK STRLEN* lp|I32 flags
 Apd    |void   |sv_copypv      |NN SV* dsv|NN SV* ssv
 Ap     |char*  |my_atof2       |NN const char *s|NN NV* value
 Apn    |int    |my_socketpair  |int family|int type|int protocol|int fd[2]
+Apn    |int    |my_dirfd       |NULLOK DIR* dir
 #ifdef PERL_OLD_COPY_ON_WRITE
 pMXE   |SV*    |sv_setsv_cow   |NN SV* dsv|NN SV* ssv
 #endif

diff --git a/embed.h b/embed.h
index 8a14bd6..f73e55b 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1582,6 +1582,7 @@
 #define sv_copypv              Perl_sv_copypv
 #define my_atof2               Perl_my_atof2
 #define my_socketpair          Perl_my_socketpair
+#define my_dirfd               Perl_my_dirfd
 #ifdef PERL_OLD_COPY_ON_WRITE
 #if defined(PERL_CORE) || defined(PERL_EXT)
 #define sv_setsv_cow           Perl_sv_setsv_cow
@@ -3853,6 +3854,7 @@
 #define sv_copypv(a,b)         Perl_sv_copypv(aTHX_ a,b)
 #define my_atof2(a,b)          Perl_my_atof2(aTHX_ a,b)
 #define my_socketpair          Perl_my_socketpair
+#define my_dirfd               Perl_my_dirfd
 #ifdef PERL_OLD_COPY_ON_WRITE
 #if defined(PERL_CORE) || defined(PERL_EXT)
 #define sv_setsv_cow(a,b)      Perl_sv_setsv_cow(aTHX_ a,b)

diff --git a/global.sym b/global.sym
index f76482b..1109892 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -694,6 +694,7 @@ Perl_sv_pvn_force_flags
 Perl_sv_copypv
 Perl_my_atof2
 Perl_my_socketpair
+Perl_my_dirfd
 Perl_sv_setsv_cow
 Perl_PerlIO_context_layers
 Perl_PerlIO_close

diff --git a/handy.h b/handy.h
index 72d7122..2f76f0a 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -175,7 +175,7 @@ typedef U64TYPE U64;
 #endif
 
 /* HMB H.Merijn Brand - a placeholder for preparing Configure patches */
-#if defined(HAS_MALLOC_SIZE) && defined(LOCALTIME_R_NEEDS_TZSET) && defined(HAS_DIR_DD_FD) && defined(HAS_PSEUDOFORK)
+#if defined(HAS_MALLOC_SIZE) && defined(LOCALTIME_R_NEEDS_TZSET) && defined(HAS_PSEUDOFORK)
 /* Not (yet) used at top level, but mention them for metaconfig */
 #endif
 

diff --git a/pp_sys.c b/pp_sys.c
index 4fc8196..222b1f5 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2828,12 +2828,8 @@ PP(pp_stat)
                         PL_laststatval = 
                             PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);   
                     } else if (IoDIRP(io)) {
-#ifdef HAS_DIRFD
                         PL_laststatval =
-                            PerlLIO_fstat(dirfd(IoDIRP(io)), &PL_statcache);
-#else
-                        DIE(aTHX_ PL_no_func, "dirfd");
-#endif
+                            PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache);
                     } else {
                         PL_laststatval = -1;
                     }
@@ -3448,11 +3444,7 @@ PP(pp_chdir)
        IO* const io = GvIO(gv);
        if (io) {
            if (IoDIRP(io)) {
-#ifdef HAS_DIRFD
-               PUSHi(fchdir(dirfd(IoDIRP(io))) >= 0);
-#else
-               DIE(aTHX_ PL_no_func, "dirfd");
-#endif
+               PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0);
            } else if (IoIFP(io)) {
                 PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
            }

diff --git a/proto.h b/proto.h
index 49bab12..85e1d4c 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -4197,6 +4197,7 @@ PERL_CALLCONV char*       Perl_my_atof2(pTHX_ const char *s, NV* value)
                        __attribute__nonnull__(pTHX_2);
 
 PERL_CALLCONV int      Perl_my_socketpair(int family, int type, int protocol, int fd[2]);
+PERL_CALLCONV int      Perl_my_dirfd(DIR* dir);
 #ifdef PERL_OLD_COPY_ON_WRITE
 PERL_CALLCONV SV*      Perl_sv_setsv_cow(pTHX_ SV* dsv, SV* ssv)
                        __attribute__nonnull__(pTHX_1)

diff --git a/t/op/stat.t b/t/op/stat.t
index 4ebe55b..f00bd28 100755 (executable)
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -480,7 +480,7 @@ ok(unlink($f), 'unlink tmp file');
 }
 
 SKIP: {
-    skip "No dirfd()", 9 unless $Config{d_dirfd};
+    skip "No dirfd()", 9 unless $Config{d_dirfd} || $Config{d_dir_dd_fd};
     ok(opendir(DIR, "."), 'Can open "." dir') || diag "Can't open '.':  $!";
     ok(stat(DIR), "stat() on dirhandle works"); 
     ok(-d -r _ , "chained -x's on dirhandle"); 
@@ -510,7 +510,7 @@ SKIP: {
     #PVIO's hold dirhandle information, so let's test them too.
 
     SKIP: {
-        skip "No dirfd()", 9 unless $Config{d_dirfd};
+        skip "No dirfd()", 9 unless $Config{d_dirfd} || $Config{d_dir_dd_fd};
         ok(opendir(DIR, "."), 'Can open "." dir') || diag "Can't open '.':  $!";
         ok(stat(*DIR{IO}), "stat() on *DIR{IO} works");
        ok(-d _ , "The special file handle _ is set correctly"); 

diff --git a/util.c b/util.c
index 6396ed2..2ec3940 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5807,6 +5807,23 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv)
     }
 }
 
+int
+Perl_my_dirfd(DIR * dir) {
+
+    /* Most dirfd implementations have problems when passed NULL. */
+    if(!dir)
+        return -1;
+#ifdef HAS_DIRFD
+    return dirfd(dir);
+#elif defined(HAS_DIR_DD_FD)
+    return dir->dd_fd;
+#else
+    Perl_die(aTHX_ PL_no_func, "dirfd");
+   /* NOT REACHED */
+    return 0;
+#endif 
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd