An exceptionally sticky typo.

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

diff --git a/doio.c b/doio.c
index 970eaed..ceb8321 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -108,7 +108,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 
     if (IoIFP(io)) {
        fd = PerlIO_fileno(IoIFP(io));
-       if (IoTYPE(io) == '-')
+       if (IoTYPE(io) == IoTYPE_STD)
            result = 0;
        else if (fd <= PL_maxsysfd) {
            saveifp = IoIFP(io);
@@ -116,7 +116,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            savetype = IoTYPE(io);
            result = 0;
        }
-       else if (IoTYPE(io) == '|')
+       else if (IoTYPE(io) == IoTYPE_PIPE)
            result = PerlProc_pclose(IoIFP(io));
        else if (IoIFP(io) != IoOFP(io)) {
            if (IoOFP(io)) {
@@ -146,14 +146,14 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 
        switch (result = rawmode & O_ACCMODE) {
        case O_RDONLY:
-            IoTYPE(io) = '<';
+            IoTYPE(io) = IoTYPE_RDONLY;
             break;
        case O_WRONLY:
-            IoTYPE(io) = '>';
+            IoTYPE(io) = IoTYPE_WRONLY;
             break;
        case O_RDWR:
        default:
-            IoTYPE(io) = '+';
+            IoTYPE(io) = IoTYPE_RDWR;
             break;
        }
 
@@ -265,7 +265,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            TAINT_PROPER("open");
            type++;
            if (*type == '>') {
-               mode[0] = IoTYPE(io) = 'a';
+               mode[0] = IoTYPE(io) = IoTYPE_APPEND;
                type++;
                tlen--;
            }
@@ -320,8 +320,8 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                             * fsetpos(src)+fgetpos(dst)?  --nik */
                            PerlIO_flush(fp);
                            fd = PerlIO_fileno(fp);
-                           if (IoTYPE(thatio) == 's')
-                               IoTYPE(io) = 's';
+                           if (IoTYPE(thatio) == IoTYPE_SOCKET)
+                               IoTYPE(io) = IoTYPE_SOCKET;
                        }
                        else
                            fd = -1;
@@ -341,7 +341,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                for (; isSPACE(*type); type++) ;
                if (strEQ(type,"-")) {
                    fp = PerlIO_stdout();
-                   IoTYPE(io) = '-';
+                   IoTYPE(io) = IoTYPE_STD;
                }
                else  {
                    fp = PerlIO_open((num_svs ? name : type), mode);
@@ -365,7 +365,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            }
            if (strEQ(type,"-")) {
                fp = PerlIO_stdin();
-               IoTYPE(io) = '-';
+               IoTYPE(io) = IoTYPE_STD;
            }
            else
                fp = PerlIO_open((num_svs ? name : type), mode);
@@ -403,18 +403,18 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                    mode = "r";
                fp = PerlProc_popen(name,mode);
            }
-           IoTYPE(io) = '|';
+           IoTYPE(io) = IoTYPE_PIPE;
        }
        else {
            if (num_svs)
                goto unknown_desr;
            name = type;
-           IoTYPE(io) = '<';
+           IoTYPE(io) = IoTYPE_RDONLY;
            /*SUPPRESS 530*/
            for (; isSPACE(*name); name++) ;
            if (strEQ(name,"-")) {
                fp = PerlIO_stdin();
-               IoTYPE(io) = '-';
+               IoTYPE(io) = IoTYPE_STD;
            }
            else {
                char *mode;
@@ -430,19 +430,19 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     }
     if (!fp) {
        dTHR;
-       if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == '<' && strchr(name, '\n'))
+       if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == IoTYPE_RDONLY && strchr(name, '\n'))
            Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open");
        goto say_false;
     }
     if (IoTYPE(io) &&
-      IoTYPE(io) != '|' && IoTYPE(io) != '-') {
+      IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD) {
        dTHR;
        if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) {
            (void)PerlIO_close(fp);
            goto say_false;
        }
        if (S_ISSOCK(PL_statbuf.st_mode))
-           IoTYPE(io) = 's';   /* in case a socket was passed in to us */
+           IoTYPE(io) = IoTYPE_SOCKET; /* in case a socket was passed in to us */
 #ifdef HAS_SOCKET
        else if (
 #ifdef S_IFMT
@@ -456,7 +456,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            if (PerlSock_getsockname(PerlIO_fileno(fp), (struct sockaddr *)tmpbuf,
                            &buflen) >= 0
                  || errno != ENOTSOCK)
-               IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
+               IoTYPE(io) = IoTYPE_SOCKET; /* some OS's return 0 on fstat()ed socket */
                                /* but some return 0 for streams too, sigh */
        }
 #endif
@@ -476,13 +476,13 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            SV *sv;
 
            PerlLIO_dup2(PerlIO_fileno(fp), fd);
-           MUTEX_LOCK(&PL_fdpid_mutex);
+           LOCK_FDPID_MUTEX;
            sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
            (void)SvUPGRADE(sv, SVt_IV);
            pid = SvIVX(sv);
            SvIVX(sv) = 0;
            sv = *av_fetch(PL_fdpid,fd,TRUE);
-           MUTEX_UNLOCK(&PL_fdpid_mutex);
+           UNLOCK_FDPID_MUTEX;
            (void)SvUPGRADE(sv, SVt_IV);
            SvIVX(sv) = pid;
            if (!was_fdopen)
@@ -504,8 +504,8 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     IoFLAGS(io) &= ~IOf_NOLINE;
     if (writing) {
        dTHR;
-       if (IoTYPE(io) == 's'
-           || (IoTYPE(io) == '>' && S_ISCHR(PL_statbuf.st_mode)) )
+       if (IoTYPE(io) == IoTYPE_SOCKET
+           || (IoTYPE(io) == IoTYPE_WRONLY && S_ISCHR(PL_statbuf.st_mode)) )
        {
            char *mode;
            if (out_raw)
@@ -773,8 +773,8 @@ Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv)
     IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
     IoOFP(wstio) = PerlIO_fdopen(fd[1], "w");
     IoIFP(wstio) = IoOFP(wstio);
-    IoTYPE(rstio) = '<';
-    IoTYPE(wstio) = '>';
+    IoTYPE(rstio) = IoTYPE_RDONLY;
+    IoTYPE(wstio) = IoTYPE_WRONLY;
     if (!IoIFP(rstio) || !IoOFP(wstio)) {
        if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
        else PerlLIO_close(fd[0]);
@@ -810,9 +810,8 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
     if (!io) {         /* never opened */
        if (not_implicit) {
            dTHR;
-           if (ckWARN(WARN_UNOPENED))
-               Perl_warner(aTHX_ WARN_UNOPENED, 
-                      "Close on unopened file <%s>",GvENAME(gv));
+           if (ckWARN(WARN_UNOPENED)) /* no check for closed here */
+               report_evil_fh(gv, io, PL_op->op_type);
            SETERRNO(EBADF,SS$_IVCHAN);
        }
        return FALSE;
@@ -823,7 +822,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
        IoPAGE(io) = 0;
        IoLINES_LEFT(io) = IoPAGE_LEN(io);
     }
-    IoTYPE(io) = ' ';
+    IoTYPE(io) = IoTYPE_CLOSED;
     return retval;
 }
 
@@ -834,7 +833,7 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit)
     int status;
 
     if (IoIFP(io)) {
-       if (IoTYPE(io) == '|') {
+       if (IoTYPE(io) == IoTYPE_PIPE) {
            status = PerlProc_pclose(IoIFP(io));
            if (not_implicit) {
                STATUS_NATIVE_SET(status);
@@ -844,7 +843,7 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit)
                retval = (status != -1);
            }
        }
-       else if (IoTYPE(io) == '-')
+       else if (IoTYPE(io) == IoTYPE_STD)
            retval = TRUE;
        else {
            if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {          /* a socket */
@@ -875,13 +874,22 @@ Perl_do_eof(pTHX_ GV *gv)
     if (!io)
        return TRUE;
     else if (ckWARN(WARN_IO)
-            && (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+            && (IoTYPE(io) == IoTYPE_WRONLY || IoIFP(io) == PerlIO_stdout()
                 || IoIFP(io) == PerlIO_stderr()))
     {
-       SV* sv = sv_newmortal();
-       gv_efullname3(sv, gv, Nullch);
-       Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
-                   SvPV_nolen(sv));
+       /* 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");
     }
 
     while (IoIFP(io)) {
@@ -925,8 +933,8 @@ Perl_do_tell(pTHX_ GV *gv)
     }
     {
        dTHR;
-       if (ckWARN(WARN_UNOPENED))
-           Perl_warner(aTHX_ WARN_UNOPENED, "tell() on unopened file");
+       if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+           report_evil_fh(gv, io, PL_op->op_type);
     }
     SETERRNO(EBADF,RMS$_IFI);
     return (Off_t)-1;
@@ -947,8 +955,8 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence)
     }
     {
        dTHR;
-       if (ckWARN(WARN_UNOPENED))
-           Perl_warner(aTHX_ WARN_UNOPENED, "seek() on unopened file");
+       if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+           report_evil_fh(gv, io, PL_op->op_type);
     }
     SETERRNO(EBADF,RMS$_IFI);
     return FALSE;
@@ -964,8 +972,8 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence)
        return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
     {
        dTHR;
-       if (ckWARN(WARN_UNOPENED))
-           Perl_warner(aTHX_ WARN_UNOPENED, "sysseek() on unopened file");
+       if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+           report_evil_fh(gv, io, PL_op->op_type);
     }
     SETERRNO(EBADF,RMS$_IFI);
     return (Off_t)-1;
@@ -1179,25 +1187,24 @@ Perl_my_stat(pTHX)
 {
     djSP;
     IO *io;
-    GV* tmpgv;
+    GV* gv;
 
     if (PL_op->op_flags & OPf_REF) {
        EXTEND(SP,1);
-       tmpgv = cGVOP_gv;
+       gv = cGVOP_gv;
       do_fstat:
-       io = GvIO(tmpgv);
+       io = GvIO(gv);
        if (io && IoIFP(io)) {
-           PL_statgv = tmpgv;
+           PL_statgv = gv;
            sv_setpv(PL_statname,"");
            PL_laststype = OP_STAT;
            return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
        }
        else {
-           if (tmpgv == PL_defgv)
+           if (gv == PL_defgv)
                return PL_laststatval;
-           if (ckWARN(WARN_UNOPENED))
-               Perl_warner(aTHX_ WARN_UNOPENED, "Stat on unopened file <%s>",
-                 GvENAME(tmpgv));
+           if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+               report_evil_fh(gv, io, PL_op->op_type);
            PL_statgv = Nullgv;
            sv_setpv(PL_statname,"");
            return (PL_laststatval = -1);
@@ -1209,11 +1216,11 @@ Perl_my_stat(pTHX)
        STRLEN n_a;
        PUTBACK;
        if (SvTYPE(sv) == SVt_PVGV) {
-           tmpgv = (GV*)sv;
+           gv = (GV*)sv;
            goto do_fstat;
        }
        else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
-           tmpgv = (GV*)SvRV(sv);
+           gv = (GV*)SvRV(sv);
            goto do_fstat;
        }
 
@@ -1917,6 +1924,9 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp)
 
     id = SvIVx(*++mark);
     mstr = *++mark;
+    /* suppress warning when reading into undef var --jhi */
+    if (! SvOK(mstr))
+       sv_setpvn(mstr, "", 0);
     msize = SvIVx(*++mark);
     mtype = (long)SvIVx(*++mark);
     flags = SvIVx(*++mark);