From: Steve Peters Date: Tue, 1 May 2007 15:32:15 +0000 (+0000) Subject: Add Perl_my_dirfd() to util.c X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3497a01ff49c0a24f2db9e69c6bb89e36e940ed4;p=p5sagit%2Fp5-mst-13.2.git Add Perl_my_dirfd() to util.c p4raw-id: //depot/perl@31112 --- diff --git a/doio.c b/doio.c index 2d901fd..7269c28 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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