ftrwrite, ftrexec, fteread, ftewrite and fteexec can all be merged

with Perl_pp_ftrread().

p4raw-id: //depot/perl@25986

5 files changed, 106 insertions, 138 deletions

diff --git a/mathoms.c b/mathoms.c
index 2fcf5f561e..9ec80e0fbf 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 7d7c7b4148..e38508ec80 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 27cf87b539..27f1de9a8d 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 59ca063e4c..7de53535c0 100644
--- a/pod/perltodo.pod
+++ b/pod/perltodo.pod
@@ -366,14 +366,6 @@ typically requiring 4 byte alignment, and then an odd C<bool> 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<pp_sys.c> has a lot of partially repeated code in the filetest operators (for
-example C<pp_ftrowned>, C<pp_ftzero>, C<pp_ftsize>, and C<pp_ftmtime>,
-C<pp_ftatime>, C<pp_ftctime>). It would be good to investigate whether some
-of this could be refactored out into common static functions. A similar
-refactoring on F<utf8.c> 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 ff8254adb8..9b08cac328 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;
 }