From: Nicholas Clark Date: Fri, 4 Nov 2005 13:02:42 +0000 (+0000) Subject: ftrwrite, ftrexec, fteread, ftewrite and fteexec can all be merged X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=af9e49b40a4cc2d6c0d5ebad7e84fb62143b24e1;p=p5sagit%2Fp5-mst-13.2.git ftrwrite, ftrexec, fteread, ftewrite and fteexec can all be merged with Perl_pp_ftrread(). p4raw-id: //depot/perl@25986 --- diff --git a/mathoms.c b/mathoms.c index 2fcf5f5..9ec80e0 100644 --- a/mathoms.c +++ b/mathoms.c @@ -946,6 +946,31 @@ PP(pp_symlink) return pp_link(); } +PP(pp_ftrwrite) +{ + return pp_ftrread(); +} + +PP(pp_ftrexec) +{ + return pp_ftrread(); +} + +PP(pp_fteread) +{ + return pp_ftrread(); +} + +PP(pp_ftewrite) +{ + return pp_ftrread(); +} + +PP(pp_fteexec) +{ + return pp_ftrread(); +} + U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv) { diff --git a/opcode.h b/opcode.h index 7d7c7b4..e38508e 100644 --- a/opcode.h +++ b/opcode.h @@ -1003,11 +1003,11 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ MEMBER_TO_FPTR(Perl_pp_stat), /* Perl_pp_lstat */ MEMBER_TO_FPTR(Perl_pp_stat), MEMBER_TO_FPTR(Perl_pp_ftrread), - MEMBER_TO_FPTR(Perl_pp_ftrwrite), - MEMBER_TO_FPTR(Perl_pp_ftrexec), - MEMBER_TO_FPTR(Perl_pp_fteread), - MEMBER_TO_FPTR(Perl_pp_ftewrite), - MEMBER_TO_FPTR(Perl_pp_fteexec), + MEMBER_TO_FPTR(Perl_pp_ftrread), /* Perl_pp_ftrwrite */ + MEMBER_TO_FPTR(Perl_pp_ftrread), /* Perl_pp_ftrexec */ + MEMBER_TO_FPTR(Perl_pp_ftrread), /* Perl_pp_fteread */ + MEMBER_TO_FPTR(Perl_pp_ftrread), /* Perl_pp_ftewrite */ + MEMBER_TO_FPTR(Perl_pp_ftrread), /* Perl_pp_fteexec */ MEMBER_TO_FPTR(Perl_pp_ftis), MEMBER_TO_FPTR(Perl_pp_ftrowned), /* Perl_pp_fteowned */ MEMBER_TO_FPTR(Perl_pp_ftrowned), diff --git a/opcode.pl b/opcode.pl index 27cf87b..27f1de9 100755 --- a/opcode.pl +++ b/opcode.pl @@ -70,6 +70,8 @@ my @raw_alias = ( Perl_pp_ftis => [qw(ftsize ftmtime ftatime ftctime)], Perl_pp_chown => [qw(unlink chmod utime kill)], Perl_pp_link => ['symlink'], + Perl_pp_ftrread => [qw(ftrwrite ftrexec fteread ftewrite + fteexec)], ); while (my ($func, $names) = splice @raw_alias, 0, 2) { diff --git a/pod/perltodo.pod b/pod/perltodo.pod index 59ca063..7de5353 100644 --- a/pod/perltodo.pod +++ b/pod/perltodo.pod @@ -366,14 +366,6 @@ typically requiring 4 byte alignment, and then an odd C later on. to review the ordering of the variables, to see how much alignment padding can be removed. -=head2 repeated code in filetest operators - -F has a lot of partially repeated code in the filetest operators (for -example C, C, C, and C, -C, C). It would be good to investigate whether some -of this could be refactored out into common static functions. A similar -refactoring on F saved about 1.5K of object code size. - =head2 bincompat functions There are lots of functions which are retained for binary compatibility. diff --git a/pp_sys.c b/pp_sys.c index ff8254a..9b08cac 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -2873,161 +2873,110 @@ PP(pp_stat) PP(pp_ftrread) { I32 result; - dSP; - STACKED_FTEST_CHECK; -#if defined(HAS_ACCESS) && defined(R_OK) - if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - result = access(POPpx, R_OK); - if (result == 0) - RETPUSHYES; - if (result < 0) - RETPUSHUNDEF; - RETPUSHNO; - } - else - result = my_stat(); + /* Not const, because things tweak this below. Not bool, because there's + no guarantee that OPp_FT_ACCESS is <= CHAR_MAX */ +#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS) + I32 use_access = PL_op->op_private & OPpFT_ACCESS; + /* Giving some sort of initial value silences compilers. */ +# ifdef R_OK + int access_mode = R_OK; +# else + int access_mode = 0; +# endif #else - result = my_stat(); + /* access_mode is never used, but leaving use_access in makes the + conditional compiling below much clearer. */ + I32 use_access = 0; #endif - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (cando(S_IRUSR, 0, &PL_statcache)) - RETPUSHYES; - RETPUSHNO; -} + int stat_mode = S_IRUSR; -PP(pp_ftrwrite) -{ - I32 result; + bool effective = FALSE; dSP; + STACKED_FTEST_CHECK; + + switch (PL_op->op_type) { + case OP_FTRREAD: +#if !(defined(HAS_ACCESS) && defined(R_OK)) + use_access = 0; +#endif + break; + + case OP_FTRWRITE: #if defined(HAS_ACCESS) && defined(W_OK) - if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - result = access(POPpx, W_OK); - if (result == 0) - RETPUSHYES; - if (result < 0) - RETPUSHUNDEF; - RETPUSHNO; - } - else - result = my_stat(); + access_mode = W_OK; #else - result = my_stat(); + use_access = 0; #endif - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (cando(S_IWUSR, 0, &PL_statcache)) - RETPUSHYES; - RETPUSHNO; -} + stat_mode = S_IWUSR; + break; -PP(pp_ftrexec) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; + case OP_FTREXEC: #if defined(HAS_ACCESS) && defined(X_OK) - if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - result = access(POPpx, X_OK); - if (result == 0) - RETPUSHYES; - if (result < 0) - RETPUSHUNDEF; - RETPUSHNO; - } - else - result = my_stat(); + access_mode = X_OK; #else - result = my_stat(); + use_access = 0; #endif - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (cando(S_IXUSR, 0, &PL_statcache)) - RETPUSHYES; - RETPUSHNO; -} + stat_mode = S_IXUSR; + break; -PP(pp_fteread) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; + case OP_FTEWRITE: #ifdef PERL_EFF_ACCESS - if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - result = PERL_EFF_ACCESS(POPpx, R_OK); - if (result == 0) - RETPUSHYES; - if (result < 0) - RETPUSHUNDEF; - RETPUSHNO; - } - else - result = my_stat(); -#else - result = my_stat(); + access_mode = W_OK; #endif - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (cando(S_IRUSR, 1, &PL_statcache)) - RETPUSHYES; - RETPUSHNO; -} + stat_mode = S_IWUSR; + /* Fall through */ -PP(pp_ftewrite) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; + case OP_FTEREAD: +#ifndef PERL_EFF_ACCESS + use_access = 0; +#endif + effective = TRUE; + break; + + + case OP_FTEEXEC: #ifdef PERL_EFF_ACCESS - if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - result = PERL_EFF_ACCESS(POPpx, W_OK); - if (result == 0) - RETPUSHYES; - if (result < 0) - RETPUSHUNDEF; - RETPUSHNO; - } - else - result = my_stat(); + access_mode = W_OK; #else - result = my_stat(); + use_access = 0; #endif - SPAGAIN; - if (result < 0) - RETPUSHUNDEF; - if (cando(S_IWUSR, 1, &PL_statcache)) - RETPUSHYES; - RETPUSHNO; -} + stat_mode = S_IXUSR; + effective = TRUE; + break; + } -PP(pp_fteexec) -{ - I32 result; - dSP; - STACKED_FTEST_CHECK; -#ifdef PERL_EFF_ACCESS - if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) { - result = PERL_EFF_ACCESS(POPpx, X_OK); + if (use_access) { +#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS) + const char *const name = POPpx; + if (effective) { +# ifdef PERL_EFF_ACCESS + result = PERL_EFF_ACCESS(name, access_mode); +# else + DIE(aTHX_ "panic: attempt to call PERL_EFF_ACCESS in %s", + OP_NAME(PL_op)); +# endif + } + else { +# ifdef HAS_ACCESS + result = access(name, access_mode); +# else + DIE(aTHX_ "panic: attempt to call access() in %s", OP_NAME(PL_op)); +# endif + } if (result == 0) RETPUSHYES; if (result < 0) RETPUSHUNDEF; RETPUSHNO; +#endif } - else - result = my_stat(); -#else + result = my_stat(); -#endif SPAGAIN; if (result < 0) RETPUSHUNDEF; - if (cando(S_IXUSR, 1, &PL_statcache)) + if (cando(stat_mode, effective, &PL_statcache)) RETPUSHYES; RETPUSHNO; }