Tweak corelist.pl's heuristics to cope with the renamed directoriess in ext/

[p5sagit/p5-mst-13.2.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 374e5c1..0179323 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -804,11 +804,6 @@ PP(pp_tie)
            break;
        case SVt_PVGV:
            if (isGV_with_GP(varsv)) {
-#ifdef GV_UNIQUE_CHECK
-               if (GvUNIQUE((const GV *)varsv)) {
-                   Perl_croak(aTHX_ "Attempt to tie unique GV");
-               }
-#endif
                methname = "TIEHANDLE";
                how = PERL_MAGIC_tiedscalar;
                /* For tied filehandles, we apply tiedscalar magic to the IO
@@ -2986,18 +2981,26 @@ PP(pp_ftrread)
     char opchar = '?';
     dSP;
 
+    switch (PL_op->op_type) {
+    case OP_FTRREAD:   opchar = 'R'; break;
+    case OP_FTRWRITE:  opchar = 'W'; break;
+    case OP_FTREXEC:   opchar = 'X'; break;
+    case OP_FTEREAD:   opchar = 'r'; break;
+    case OP_FTEWRITE:  opchar = 'w'; break;
+    case OP_FTEEXEC:   opchar = 'x'; break;
+    }
+    tryAMAGICftest(opchar);
+
     STACKED_FTEST_CHECK;
 
     switch (PL_op->op_type) {
     case OP_FTRREAD:
-       opchar = 'R';
 #if !(defined(HAS_ACCESS) && defined(R_OK))
        use_access = 0;
 #endif
        break;
 
     case OP_FTRWRITE:
-       opchar = 'W';
 #if defined(HAS_ACCESS) && defined(W_OK)
        access_mode = W_OK;
 #else
@@ -3007,7 +3010,6 @@ PP(pp_ftrread)
        break;
 
     case OP_FTREXEC:
-       opchar = 'X';
 #if defined(HAS_ACCESS) && defined(X_OK)
        access_mode = X_OK;
 #else
@@ -3017,19 +3019,13 @@ PP(pp_ftrread)
        break;
 
     case OP_FTEWRITE:
-       opchar = 'w';
 #ifdef PERL_EFF_ACCESS
        access_mode = W_OK;
 #endif
        stat_mode = S_IWUSR;
-#ifndef PERL_EFF_ACCESS
-       use_access = 0;
-#endif
-       effective = TRUE;
-       break;
+       /* fall through */
 
     case OP_FTEREAD:
-       opchar = 'r';
 #ifndef PERL_EFF_ACCESS
        use_access = 0;
 #endif
@@ -3037,7 +3033,6 @@ PP(pp_ftrread)
        break;
 
     case OP_FTEEXEC:
-       opchar = 'x';
 #ifdef PERL_EFF_ACCESS
        access_mode = X_OK;
 #else
@@ -3048,8 +3043,6 @@ PP(pp_ftrread)
        break;
     }
 
-    tryAMAGICftest(opchar);
-
     if (use_access) {
 #if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
        const char *name = POPpx;
@@ -3092,7 +3085,6 @@ PP(pp_ftis)
     const int op_type = PL_op->op_type;
     char opchar = '?';
     dSP;
-    STACKED_FTEST_CHECK;
 
     switch (op_type) {
     case OP_FTIS:      opchar = 'e'; break;
@@ -3103,6 +3095,8 @@ PP(pp_ftis)
     }
     tryAMAGICftest(opchar);
 
+    STACKED_FTEST_CHECK;
+
     result = my_stat();
     SPAGAIN;
     if (result < 0)
@@ -3142,9 +3136,24 @@ PP(pp_ftrowned)
     char opchar = '?';
     dSP;
 
+    switch (PL_op->op_type) {
+    case OP_FTROWNED:  opchar = 'O'; break;
+    case OP_FTEOWNED:  opchar = 'o'; break;
+    case OP_FTZERO:    opchar = 'z'; break;
+    case OP_FTSOCK:    opchar = 'S'; break;
+    case OP_FTCHR:     opchar = 'c'; break;
+    case OP_FTBLK:     opchar = 'b'; break;
+    case OP_FTFILE:    opchar = 'f'; break;
+    case OP_FTDIR:     opchar = 'd'; break;
+    case OP_FTPIPE:    opchar = 'p'; break;
+    case OP_FTSUID:    opchar = 'u'; break;
+    case OP_FTSGID:    opchar = 'g'; break;
+    case OP_FTSVTX:    opchar = 'k'; break;
+    }
+    tryAMAGICftest(opchar);
+
     /* I believe that all these three are likely to be defined on most every
        system these days.  */
-    if (!SvAMAGIC(TOPs)) {
 #ifndef S_ISUID
     if(PL_op->op_type == OP_FTSUID)
        RETPUSHNO;
@@ -3157,26 +3166,9 @@ PP(pp_ftrowned)
     if(PL_op->op_type == OP_FTSVTX)
        RETPUSHNO;
 #endif
-    }
 
     STACKED_FTEST_CHECK;
 
-    switch (PL_op->op_type) {
-    case OP_FTROWNED:  opchar = 'O'; break;
-    case OP_FTEOWNED:  opchar = 'o'; break;
-    case OP_FTZERO:    opchar = 'z'; break;
-    case OP_FTSOCK:    opchar = 'S'; break;
-    case OP_FTCHR:     opchar = 'c'; break;
-    case OP_FTBLK:     opchar = 'b'; break;
-    case OP_FTFILE:    opchar = 'f'; break;
-    case OP_FTDIR:     opchar = 'd'; break;
-    case OP_FTPIPE:    opchar = 'p'; break;
-    case OP_FTSUID:    opchar = 'u'; break;
-    case OP_FTSGID:    opchar = 'g'; break;
-    case OP_FTSVTX:    opchar = 'k'; break;
-    }
-    tryAMAGICftest(opchar);
-
     result = my_stat();
     SPAGAIN;
     if (result < 0)
@@ -3243,11 +3235,13 @@ PP(pp_ftrowned)
 PP(pp_ftlink)
 {
     dVAR;
-    I32 result;
     dSP;
+    I32 result;
 
     tryAMAGICftest('l');
     result = my_lstat();
+    SPAGAIN;
+
     if (result < 0)
        RETPUSHUNDEF;
     if (S_ISLNK(PL_statcache.st_mode))
@@ -3263,10 +3257,10 @@ PP(pp_fttty)
     GV *gv;
     SV *tmpsv = NULL;
 
-    STACKED_FTEST_CHECK;
-
     tryAMAGICftest('t');
 
+    STACKED_FTEST_CHECK;
+
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
     else if (isGV(TOPs))
@@ -3314,10 +3308,10 @@ PP(pp_fttext)
     GV *gv;
     PerlIO *fp;
 
-    STACKED_FTEST_CHECK;
-
     tryAMAGICftest(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
 
+    STACKED_FTEST_CHECK;
+
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
     else if (isGV(TOPs))
@@ -4524,9 +4518,9 @@ PP(pp_gmtime)
     }
 
     if (PL_op->op_type == OP_LOCALTIME)
-        err = localtime64_r(&when, &tmbuf);
+        err = S_localtime64_r(&when, &tmbuf);
     else
-       err = gmtime64_r(&when, &tmbuf);
+       err = S_gmtime64_r(&when, &tmbuf);
 #endif
 
     if (err == NULL && ckWARN(WARN_OVERFLOW)) {