This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
op/readdir.t (was Re: perl@14152)
[perl5.git] / doio.c
diff --git a/doio.c b/doio.c
index 9dbb737..be27b93 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -141,59 +141,30 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
         /* sysopen style args, i.e. integer mode and permissions */
        STRLEN ix = 0;
        if (num_svs != 0) {
-            Perl_croak(aTHX_ "panic:sysopen with multiple args");
+            Perl_croak(aTHX_ "panic: sysopen with multiple args");
        }
+       if (rawmode & (O_WRONLY|O_RDWR|O_CREAT
+#ifdef O_APPEND        /* Not fully portable. */
+                      |O_APPEND
+#endif
+#ifdef O_TRUNC /* Not fully portable. */
+                      |O_TRUNC
+#endif
+                      ))
+           TAINT_PROPER("sysopen");
        mode[ix++] = '#'; /* Marker to openn to use numeric "sysopen" */
 
 #if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
-       rawmode |= O_LARGEFILE;
-#endif
-
-#ifndef O_ACCMODE
-#define O_ACCMODE 3            /* Assume traditional implementation */
+       rawmode |= O_LARGEFILE; /* Transparently largefiley. */
 #endif
 
-       switch (result = rawmode & O_ACCMODE) {
-       case O_RDONLY:
-            IoTYPE(io) = IoTYPE_RDONLY;
-            break;
-       case O_WRONLY:
-            IoTYPE(io) = IoTYPE_WRONLY;
-            break;
-       case O_RDWR:
-       default:
-            IoTYPE(io) = IoTYPE_RDWR;
-            break;
-       }
-       writing = (result > 0);
-
-       if (result == O_RDONLY) {
-           mode[ix++] = 'r';
-       }
-#ifdef O_APPEND
-       else if (rawmode & O_APPEND) {
-           mode[ix++] = 'a';
-           if (result != O_WRONLY)
-               mode[ix++] = '+';
-       }
-#endif
-       else {
-           if (result == O_WRONLY)
-               mode[ix++] = 'w';
-           else {
-               mode[ix++] = 'r';
-               mode[ix++] = '+';
-           }
-       }
-       if (rawmode & O_BINARY)
-           mode[ix++] = 'b';
-       mode[ix] = '\0';
+        IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing);
 
        namesv = sv_2mortal(newSVpvn(name,strlen(name)));
        num_svs = 1;
        svp = &namesv;
         type = Nullch;
-       fp = PerlIO_openn(aTHX_ type,mode, -1, rawmode, rawperm, NULL, num_svs, svp);
+       fp = PerlIO_openn(aTHX_ type, mode, -1, rawmode, rawperm, NULL, num_svs, svp);
     }
     else {
        /* Regular (non-sys) open */
@@ -201,29 +172,35 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        STRLEN olen = len;
        char *tend;
        int dodup = 0;
+       PerlIO *that_fp = NULL;
 
        type = savepvn(name, len);
        tend = type+len;
        SAVEFREEPV(type);
-       /* Loose trailing white space */
-       while (tend > type && isSPACE(tend[-1]))
-           *tend-- = '\0';
+
+        /* Lose leading and trailing white space */
+        /*SUPPRESS 530*/
+        for (; isSPACE(*type); type++) ;
+        while (tend > type && isSPACE(tend[-1]))
+           *--tend = '\0';
+
        if (num_svs) {
            /* New style explict name, type is just mode and discipline/layer info */
            STRLEN l = 0;
-           name = SvOK(*svp) && (*svp != &PL_sv_undef) ? SvPV(*svp, l) : "";
+           name = SvOK(*svp) ? SvPV(*svp, l) : "";
            len = (I32)l;
            name = savepvn(name, len);
            SAVEFREEPV(name);
-           /*SUPPRESS 530*/
-           for (; isSPACE(*type); type++) ;
        }
        else {
            name = type;
            len  = tend-type;
        }
        IoTYPE(io) = *type;
-       if ((*type == IoTYPE_RDWR) && ((!num_svs || tend > type+1 && tend[-1] != IoTYPE_PIPE))) { /* scary */
+       if ((*type == IoTYPE_RDWR) && /* scary */
+           (*(type+1) == IoTYPE_RDONLY || *(type+1) == IoTYPE_WRONLY) &&
+           ((!num_svs || (tend > type+1 && tend[-1] != IoTYPE_PIPE)))) {
+        TAINT_PROPER("open");
            mode[1] = *type++;
            writing = 1;
        }
@@ -290,7 +267,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 
            if (*type == '&') {
              duplicity:
-               dodup = 1;
+               dodup = PERLIO_DUP_FD;
                type++;
                if (*type == '=') {
                    dodup = 0;
@@ -330,8 +307,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 #endif
                            goto say_false;
                        }
-                       if (IoIFP(thatio)) {
-                           PerlIO *fp = IoIFP(thatio);
+                       if ((that_fp = IoIFP(thatio))) {
                            /* Flush stdio buffer before dup. --mjd
                             * Unfortunately SEEK_CURing 0 seems to
                             * be optimized away on most platforms;
@@ -341,21 +317,21 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                            /* sfio fails to clear error on next
                               sfwrite, contrary to documentation.
                               -- Nick Clark */
-                           if (PerlIO_seek(fp, 0, SEEK_CUR) == -1)
-                               PerlIO_clearerr(fp);
+                           if (PerlIO_seek(that_fp, 0, SEEK_CUR) == -1)
+                               PerlIO_clearerr(that_fp);
 #endif
                            /* On the other hand, do all platforms
                             * take gracefully to flushing a read-only
                             * filehandle?  Perhaps we should do
                             * fsetpos(src)+fgetpos(dst)?  --nik */
-                           PerlIO_flush(fp);
-                           fd = PerlIO_fileno(fp);
+                           PerlIO_flush(that_fp);
+                           fd = PerlIO_fileno(that_fp);
                            /* When dup()ing STDIN, STDOUT or STDERR
                             * explicitly set appropriate access mode */
-                           if (IoIFP(thatio) == PerlIO_stdout()
-                               || IoIFP(thatio) == PerlIO_stderr())
+                           if (that_fp == PerlIO_stdout()
+                               || that_fp == PerlIO_stderr())
                                IoTYPE(io) = IoTYPE_WRONLY;
-                           else if (IoIFP(thatio) == PerlIO_stdin())
+                           else if (that_fp == PerlIO_stdin())
                                 IoTYPE(io) = IoTYPE_RDONLY;
                            /* When dup()ing a socket, say result is
                             * one as well */
@@ -365,22 +341,24 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                        else
                            fd = -1;
                    }
-                   if (dodup)
-                       fd = PerlLIO_dup(fd);
-                   else
-                       was_fdopen = TRUE;
                    if (!num_svs)
                        type = Nullch;
-                   if (!(fp = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,num_svs,svp))) {
+                   if (that_fp) {
+                       fp = PerlIO_fdupopen(aTHX_ that_fp, NULL, dodup);
+                   }
+                   else {
                        if (dodup)
-                           PerlLIO_close(fd);
+                           fd = PerlLIO_dup(fd);
+                       else
+                           was_fdopen = TRUE;
+                       if (!(fp = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,num_svs,svp))) {
+                           if (dodup)
+                               PerlLIO_close(fd);
+                       }
                    }
                }
            } /* & */
            else {
-               if (num_svs > 1) {
-                   Perl_croak(aTHX_ "More than one argument to '>' open");
-               }
                /*SUPPRESS 530*/
                for (; isSPACE(*type); type++) ;
                if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
@@ -388,6 +366,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                    type++;
                    fp = PerlIO_stdout();
                    IoTYPE(io) = IoTYPE_STD;
+                   if (num_svs > 1) {
+                       Perl_croak(aTHX_ "More than one argument to '>%c' open",IoTYPE_STD);
+                   }
                }
                else  {
                    if (!num_svs) {
@@ -401,9 +382,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            } /* !& */
        }
        else if (*type == IoTYPE_RDONLY) {
-           if (num_svs > 1) {
-               Perl_croak(aTHX_ "More than one argument to '<' open");
-           }
            /*SUPPRESS 530*/
            for (type++; isSPACE(*type); type++) ;
            mode[0] = 'r';
@@ -420,6 +398,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                type++;
                fp = PerlIO_stdin();
                IoTYPE(io) = IoTYPE_STD;
+               if (num_svs > 1) {
+                   Perl_croak(aTHX_ "More than one argument to '<%c' open",IoTYPE_STD);
+               }
            }
            else {
                if (!num_svs) {
@@ -504,21 +485,28 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     if (ckWARN(WARN_IO)) {
        if ((IoTYPE(io) == IoTYPE_RDONLY) &&
            (fp == PerlIO_stdout() || fp == PerlIO_stderr())) {
-               Perl_warner(aTHX_ WARN_IO, "'std%s' opened only for input",
-                               (fp == PerlIO_stdout()) ? "out" : "err");
+               Perl_warner(aTHX_ WARN_IO,
+                           "Filehandle STD%s opened only for input",
+                           (fp == PerlIO_stdout()) ? "OUT" : "ERR");
        }
        else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
-               Perl_warner(aTHX_ WARN_IO, "'stdin' opened only for output");
+               Perl_warner(aTHX_ WARN_IO,
+                           "Filehandle STDIN opened only for output");
        }
     }
 
-    if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD &&
-       /* FIXME: This next term is a hack to avoid fileno on PerlIO::Scalar */
-       !(num_svs && SvROK(*svp))) {
-       if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) {
-           (void)PerlIO_close(fp);
+    fd = PerlIO_fileno(fp);
+    /* If there is no fd (e.g. PerlIO::Scalar) assume it isn't a
+     * socket - this covers PerlIO::Scalar - otherwise unless we "know" the
+     * type probe for socket-ness.
+     */
+    if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && fd >= 0) {
+       if (PerlLIO_fstat(fd,&PL_statbuf) < 0) {
+           /* If PerlIO claims to have fd we had better be able to fstat() it. */
+           (void) PerlIO_close(fp);
            goto say_false;
        }
+#ifndef PERL_MICRO
        if (S_ISSOCK(PL_statbuf.st_mode))
            IoTYPE(io) = IoTYPE_SOCKET; /* in case a socket was passed in to us */
 #ifdef HAS_SOCKET
@@ -531,21 +519,26 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            && IoTYPE(io) != IoTYPE_WRONLY  /* Dups of STD* filehandles already have */
            && IoTYPE(io) != IoTYPE_RDONLY  /* type so they aren't marked as sockets */
        ) {                                 /* on OS's that return 0 on fstat()ed pipe */
-           char tmpbuf[256];
-           Sock_size_t buflen = sizeof tmpbuf;
-           if (PerlSock_getsockname(PerlIO_fileno(fp), (struct sockaddr *)tmpbuf,
-                           &buflen) >= 0
-                 || errno != ENOTSOCK)
-               IoTYPE(io) = IoTYPE_SOCKET; /* some OS's return 0 on fstat()ed socket */
-                               /* but some return 0 for streams too, sigh */
-       }
-#endif
+            char tmpbuf[256];
+            Sock_size_t buflen = sizeof tmpbuf;
+            if (PerlSock_getsockname(fd, (struct sockaddr *)tmpbuf, &buflen) >= 0
+                     || errno != ENOTSOCK)
+                   IoTYPE(io) = IoTYPE_SOCKET; /* some OS's return 0 on fstat()ed socket */
+                                               /* but some return 0 for streams too, sigh */
+       }
+#endif /* HAS_SOCKET */
+#endif /* !PERL_MICRO */
     }
+
+    /* Eeek - FIXME !!!
+     * If this is a standard handle we discard all the layer stuff
+     * and just dup the fd into whatever was on the handle before !
+     */
+
     if (saveifp) {             /* must use old fp? */
         /* If fd is less that PL_maxsysfd i.e. STDIN..STDERR
            then dup the new fileno down
          */
-        fd = PerlIO_fileno(fp);
        if (saveofp) {
            PerlIO_flush(saveofp);      /* emulate PerlIO_close() */
            if (saveofp != saveifp) {   /* was a socket? */
@@ -555,13 +548,20 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (savefd != fd) {
            Pid_t pid;
            SV *sv;
-           PerlLIO_dup2(fd, savefd);
+           /* Still a small can-of-worms here if (say) PerlIO::Scalar
+              is assigned to (say) STDOUT - for now let dup2() fail
+              and provide the error
+            */
+           if (PerlLIO_dup2(fd, savefd) < 0) {
+               (void)PerlIO_close(fp);
+               goto say_false;
+           }
 #ifdef VMS
            if (savefd != PerlIO_fileno(PerlIO_stdin())) {
              char newname[FILENAME_MAX+1];
-             if (fgetname(fp, newname)) {
-               if (savefd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm("SYS$OUTPUT", newname);
-               if (savefd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm("SYS$ERROR",  newname);
+             if (PerlIO_getname(fp, newname)) {
+               if (fd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm(aTHX_ "SYS$OUTPUT", newname);
+               if (fd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm(aTHX_ "SYS$ERROR",  newname);
              }
            }
 #endif
@@ -574,16 +574,17 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            UNLOCK_FDPID_MUTEX;
            (void)SvUPGRADE(sv, SVt_IV);
            SvIVX(sv) = pid;
-           if (!was_fdopen)
+           if (!was_fdopen) {
                PerlIO_close(fp);
+           }
        }
        fp = saveifp;
        PerlIO_clearerr(fp);
+       fd = PerlIO_fileno(fp);
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
-    {
+    if (fd >= 0) {
        int save_errno = errno;
-       fd = PerlIO_fileno(fp);
        fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */
        errno = save_errno;
     }
@@ -593,9 +594,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     IoFLAGS(io) &= ~IOf_NOLINE;
     if (writing) {
        if (IoTYPE(io) == IoTYPE_SOCKET
-           || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) ) {
+           || (IoTYPE(io) == IoTYPE_WRONLY && fd >= 0 && S_ISCHR(PL_statbuf.st_mode)) ) {
            mode[0] = 'w';
-           if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,mode,PerlIO_fileno(fp),0,0,NULL,num_svs,svp))) {
+           if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,mode,fd,0,0,NULL,num_svs,svp))) {
                PerlIO_close(fp);
                IoIFP(io) = Nullfp;
                goto say_false;
@@ -690,11 +691,11 @@ Perl_nextargv(pTHX_ register GV *gv)
                        sv_catpv(sv,PL_inplace);
                    }
 #ifndef FLEXFILENAMES
-                   if (PerlLIO_stat(SvPVX(sv),&PL_statbuf) >= 0
-                     && PL_statbuf.st_dev == filedev
-                     && PL_statbuf.st_ino == fileino
+                   if ((PerlLIO_stat(SvPVX(sv),&PL_statbuf) >= 0
+                        && PL_statbuf.st_dev == filedev
+                        && PL_statbuf.st_ino == fileino)
 #ifdef DJGPP
-                      || (_djstat_fail_bits & _STFAIL_TRUENAME)!=0
+                       || ((_djstat_fail_bits & _STFAIL_TRUENAME)!=0)
 #endif
                       )
                    {
@@ -950,21 +951,7 @@ Perl_do_eof(pTHX_ GV *gv)
     if (!io)
        return TRUE;
     else if (ckWARN(WARN_IO) && (IoTYPE(io) == IoTYPE_WRONLY))
-    {
-       /* integrate to report_evil_fh()? */
-        char *name = NULL;
-       if (isGV(gv)) {
-           SV* sv = sv_newmortal();
-           gv_efullname4(sv, gv, Nullch, FALSE);
-           name = SvPV_nolen(sv);
-       }
-       if (name && *name)
-           Perl_warner(aTHX_ WARN_IO,
-                       "Filehandle %s opened only for output", name);
-       else
-           Perl_warner(aTHX_ WARN_IO,
-                       "Filehandle opened only for output");
-    }
+       report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY);
 
     while (IoIFP(io)) {
 
@@ -996,7 +983,7 @@ Perl_do_eof(pTHX_ GV *gv)
 Off_t
 Perl_do_tell(pTHX_ GV *gv)
 {
-    register IO *io;
+    register IO *io = 0;
     register PerlIO *fp;
 
     if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
@@ -1015,7 +1002,7 @@ Perl_do_tell(pTHX_ GV *gv)
 bool
 Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
 {
-    register IO *io;
+    register IO *io = 0;
     register PerlIO *fp;
 
     if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
@@ -1034,7 +1021,7 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
 Off_t
 Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence)
 {
-    register IO *io;
+    register IO *io = 0;
     register PerlIO *fp;
 
     if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
@@ -1106,7 +1093,11 @@ Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
  /* The old body of this is now in non-LAYER part of perlio.c
   * This is a stub for any XS code which might have been calling it.
   */
- char *name = (O_BINARY != O_TEXT && !(mode & O_BINARY)) ? ":crlf" : ":raw";
+ char *name = ":raw";
+#ifdef PERLIO_USING_CRLF
+ if (!(mode & O_BINARY))
+     name = ":crlf";
+#endif
  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
 }
 
@@ -1204,8 +1195,13 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
            if (!SvUTF8(sv))
                sv_utf8_upgrade(sv = sv_mortalcopy(sv));
        }
-       else if (DO_UTF8(sv))
-           sv_utf8_downgrade((sv = sv_mortalcopy(sv)), FALSE);
+       else if (DO_UTF8(sv)) {
+           if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)
+               && ckWARN(WARN_UTF8))
+           {
+               Perl_warner(aTHX_ WARN_UTF8, "Wide character in print");
+           }
+       }
        tmps = SvPV(sv, len);
        break;
     }
@@ -1314,7 +1310,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
     register char **a;
-    char *tmps;
+    char *tmps = Nullch;
     STRLEN n_a;
 
     if (sp > mark) {
@@ -1377,7 +1373,6 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 {
     register char **a;
     register char *s;
-    char flags[10];
 
     while (*cmd && isSPACE(*cmd))
        cmd++;
@@ -1385,28 +1380,32 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
     /* save an extra exec if possible */
 
 #ifdef CSH
-    if (strnEQ(cmd,PL_cshname,PL_cshlen) && strnEQ(cmd+PL_cshlen," -c",3)) {
-       strcpy(flags,"-c");
-       s = cmd+PL_cshlen+3;
-       if (*s == 'f') {
-           s++;
-           strcat(flags,"f");
-       }
-       if (*s == ' ')
-           s++;
-       if (*s++ == '\'') {
-           char *ncmd = s;
-
-           while (*s)
-               s++;
-           if (s[-1] == '\n')
-               *--s = '\0';
-           if (s[-1] == '\'') {
-               *--s = '\0';
-               PerlProc_execl(PL_cshname,"csh", flags,ncmd,(char*)0);
-               *s = '\'';
-               return FALSE;
-           }
+    {
+        char flags[10];
+       if (strnEQ(cmd,PL_cshname,PL_cshlen) &&
+           strnEQ(cmd+PL_cshlen," -c",3)) {
+         strcpy(flags,"-c");
+         s = cmd+PL_cshlen+3;
+         if (*s == 'f') {
+             s++;
+             strcat(flags,"f");
+         }
+         if (*s == ' ')
+             s++;
+         if (*s++ == '\'') {
+             char *ncmd = s;
+
+             while (*s)
+                 s++;
+             if (s[-1] == '\n')
+                 *--s = '\0';
+             if (s[-1] == '\'') {
+                 *--s = '\0';
+                 PerlProc_execl(PL_cshname,"csh", flags, ncmd, (char*)0);
+                 *s = '\'';
+                 return FALSE;
+             }
+         }
        }
     }
 #endif /* CSH */
@@ -1424,7 +1423,8 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
        goto doshell;
 
     for (s = cmd; *s; s++) {
-       if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
+       if (*s != ' ' && !isALPHA(*s) &&
+           strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
            if (*s == '\n' && !s[1]) {
                *s = '\0';
                break;
@@ -1657,20 +1657,31 @@ nothing in the core.
            } utbuf;
 #endif
 
+           SV* accessed = *++mark;
+           SV* modified = *++mark;
+           void * utbufp = &utbuf;
+
+           /* be like C, and if both times are undefined, let the C
+              library figure out what to do.  This usually means
+              "current time" */
+
+           if ( accessed == &PL_sv_undef && modified == &PL_sv_undef )
+             utbufp = NULL;
+
            Zero(&utbuf, sizeof utbuf, char);
 #ifdef BIG_TIME
-           utbuf.actime = (Time_t)SvNVx(*++mark);      /* time accessed */
-           utbuf.modtime = (Time_t)SvNVx(*++mark);     /* time modified */
+           utbuf.actime = (Time_t)SvNVx(accessed);     /* time accessed */
+           utbuf.modtime = (Time_t)SvNVx(modified);    /* time modified */
 #else
-           utbuf.actime = (Time_t)SvIVx(*++mark);      /* time accessed */
-           utbuf.modtime = (Time_t)SvIVx(*++mark);     /* time modified */
+           utbuf.actime = (Time_t)SvIVx(accessed);     /* time accessed */
+           utbuf.modtime = (Time_t)SvIVx(modified);    /* time modified */
 #endif
            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
                char *name = SvPVx(*mark, n_a);
                APPLY_TAINT_PROPER();
-               if (PerlLIO_utime(name, &utbuf))
+               if (PerlLIO_utime(name, utbufp))
                    tot--;
            }
        }
@@ -1995,13 +2006,42 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp)
     id = SvIVx(*++mark);
     opstr = *++mark;
     opbuf = SvPV(opstr, opsize);
-    if (opsize < sizeof(struct sembuf)
-       || (opsize % sizeof(struct sembuf)) != 0) {
+    if (opsize < 3 * SHORTSIZE
+       || (opsize % (3 * SHORTSIZE))) {
        SETERRNO(EINVAL,LIB$_INVARG);
        return -1;
     }
     SETERRNO(0,0);
-    return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
+    /* We can't assume that sizeof(struct sembuf) == 3 * sizeof(short). */
+    {
+        int nsops  = opsize / (3 * sizeof (short));
+        int i      = nsops;
+        short *ops = (short *) opbuf;
+        short *o   = ops;
+        struct sembuf *temps, *t;
+        I32 result;
+
+        New (0, temps, nsops, struct sembuf);
+        t = temps;
+        while (i--) {
+            t->sem_num = *o++;
+            t->sem_op  = *o++;
+            t->sem_flg = *o++;
+            t++;
+        }
+        result = semop(id, temps, nsops);
+        t = temps;
+        o = ops;
+        i = nsops;
+        while (i--) {
+            *o++ = t->sem_num;
+            *o++ = t->sem_op;
+            *o++ = t->sem_flg;
+            t++;
+        }
+        Safefree(temps);
+        return result;
+    }
 #else
     Perl_croak(aTHX_ "semop not implemented");
 #endif
@@ -2066,11 +2106,13 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 #endif /* SYSV IPC */
 
 /*
+=head1 IO Functions
+
 =for apidoc start_glob
 
 Function called by C<do_readline> to spawn a glob (or do the glob inside
 perl on VMS). This code used to be inline, but now perl uses C<File::Glob>
-this glob starter is only used by miniperl during the build proccess.
+this glob starter is only used by miniperl during the build process.
 Moving it away shrinks pp_hot.c; shrinking pp_hot.c helps speed perl up.
 
 =cut
@@ -2093,7 +2135,6 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
        char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'};
        char vmsspec[NAM$C_MAXRSS+1];
        char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
-       char tmpfnam[L_tmpnam] = "SYS$SCRATCH:";
        $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;");
        PerlIO *tmpfp;
        STRLEN i;
@@ -2108,7 +2149,6 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
           ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb
           but that's unsupported, so I don't want to do it now and
           have it bite someone in the future. */
-       strcat(tmpfnam,PerlLIO_tmpnam(NULL));
        cp = SvPV(tmpglob,i);
        for (; i; i--) {
            if (cp[i] == ';') hasver = 1;
@@ -2125,12 +2165,14 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io)
                break;
            }
        }
-       if ((tmpfp = PerlIO_open(tmpfnam,"w+","fop=dlt")) != NULL) {
+       if ((tmpfp = PerlIO_tmpfile()) != NULL) {
            Stat_t st;
            if (!PerlLIO_stat(SvPVX(tmpglob),&st) && S_ISDIR(st.st_mode))
                ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL);
            else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
            if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
+           for (cp=wilddsc.dsc$a_pointer; ok && cp && *cp; cp++)
+               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;