diff options
| -rw-r--r-- | doio.c | 12 | ||||
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | handy.h | 2 | ||||
| -rw-r--r-- | pp_sys.c | 12 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rwxr-xr-x | t/op/stat.t | 4 | ||||
| -rw-r--r-- | util.c | 17 |
9 files changed, 28 insertions, 24 deletions
@@ -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); @@ -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 @@ -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 f76482b2eb..1109892b34 100644 --- 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 @@ -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 @@ -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); } @@ -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 4ebe55b2c6..f00bd284ca 100755 --- 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"); @@ -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 |