make op/write.t work better under stdio by running the subtests

[perl5.git] / doio.c

diff --git a/doio.c b/doio.c
index e2dcad8..7e13f1f 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -48,9 +48,7 @@
 #  define OPEN_EXCL 0
 #endif
 
-#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
 #include <signal.h>
-#endif
 
 bool
 Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
@@ -725,11 +723,13 @@ Perl_nextargv(pTHX_ register GV *gv)
     if (PL_filemode & (S_ISUID|S_ISGID)) {
        PerlIO_flush(IoIFP(GvIOn(PL_argvoutgv)));  /* chmod must follow last write */
 #ifdef HAS_FCHMOD
-       (void)fchmod(PL_lastfd,PL_filemode);
+       if (PL_lastfd != -1)
+           (void)fchmod(PL_lastfd,PL_filemode);
 #else
        (void)PerlLIO_chmod(PL_oldname,PL_filemode);
 #endif
     }
+    PL_lastfd = -1;
     PL_filemode = 0;
     if (!GvAV(gv))
         return Nullfp;
@@ -1338,6 +1338,9 @@ Perl_my_stat(pTHX)
            return (PL_laststatval = -1);
        }
     }
+    else if (PL_op->op_private & OPpFT_STACKED) {
+       return PL_laststatval;
+    }
     else {
        SV* sv = POPs;
        char *s;
@@ -1364,6 +1367,8 @@ Perl_my_stat(pTHX)
     }
 }
 
+static char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
+
 I32
 Perl_my_lstat(pTHX)
 {
@@ -1374,7 +1379,7 @@ Perl_my_lstat(pTHX)
        EXTEND(SP,1);
        if (cGVOP_gv == PL_defgv) {
            if (PL_laststype != OP_LSTAT)
-               Perl_croak(aTHX_ "The stat preceding -l _ wasn't an lstat");
+               Perl_croak(aTHX_ no_prev_lstat);
            return PL_laststatval;
        }
        if (ckWARN(WARN_IO)) {
@@ -1383,6 +1388,9 @@ Perl_my_lstat(pTHX)
            return (PL_laststatval = -1);
        }
     }
+    else if (ckWARN(WARN_IO) && PL_laststype != OP_LSTAT
+           && (PL_op->op_private & OPpFT_STACKED))
+       Perl_croak(aTHX_ no_prev_lstat);
 
     PL_laststype = OP_LSTAT;
     PL_statgv = Nullgv;
@@ -1548,7 +1556,7 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 
                while (*t && isSPACE(*t))
                    ++t;
-               if (!*t && (dup2(1,2) != -1)) {
+               if (!*t && (PerlLIO_dup2(1,2) != -1)) {
                    s[-2] = '\0';
                    break;
                }
@@ -2290,8 +2298,9 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
                if (*cp == '?') *cp = '%';  /* VMS style single-char wildcard */
            while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
                                               &dfltdsc,NULL,NULL,NULL))&1)) {
-               end = rstr + (unsigned long int) *rslt;
-               if (!hasver) while (*end != ';') end--;
+               /* with varying string, 1st word of buffer contains result length */
+               end = rstr + *((unsigned short int*)rslt);
+               if (!hasver) while (*end != ';' && end > rstr) end--;
                *(end++) = '\n';  *end = '\0';
                for (cp = rstr; *cp; cp++) *cp = _tolower(*cp);
                if (hasdir) {