adjust searchdict.t for EBCDIC (still needs documenting)

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

diff --git a/pp_sys.c b/pp_sys.c
index c6c208d..40628af 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -382,7 +382,7 @@ PP(pp_open)
     if (GvIOp(gv))
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
     tmps = SvPV(sv, len);
-    if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp))
+    if (do_open(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp))
        PUSHi( (I32)PL_forkprocess );
     else if (PL_forkprocess == 0)              /* we are a new child */
        PUSHi(0);
@@ -612,7 +612,7 @@ PP(pp_untie)
 
     sv = POPs;
 
-    if (PL_dowarn) {
+    if (ckWARN(WARN_UNTIE)) {
         MAGIC * mg ;
         if (SvMAGICAL(sv)) {
             if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
@@ -621,8 +621,9 @@ PP(pp_untie)
                 mg = mg_find(sv, 'q') ;
     
             if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
-               warn("untie attempted while %lu inner references still exist",
-                       (unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
+               warner(WARN_UNTIE,
+                   "untie attempted while %lu inner references still exist",
+                   (unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
         }
     }
  
@@ -754,7 +755,8 @@ PP(pp_sselect)
     }
 
 #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
-#if defined(__linux__) || defined(OS2)
+/* XXX Configure test needed. */
+#if defined(__linux__) || defined(OS2) || defined(NeXT) || defined(__osf__) || defined(sun)
     growsize = sizeof(fd_set);
 #else
     growsize = maxlen;         /* little endians can use vecs directly */
@@ -1082,18 +1084,18 @@ PP(pp_leavewrite)
 
     fp = IoOFP(io);
     if (!fp) {
-       if (PL_dowarn) {
+       if (ckWARN2(WARN_CLOSED,WARN_IO)) {
            if (IoIFP(io))
-               warn("Filehandle only opened for input");
-           else
-               warn("Write on closed filehandle");
+               warner(WARN_IO, "Filehandle only opened for input");
+           else if (ckWARN(WARN_CLOSED))
+               warner(WARN_CLOSED, "Write on closed filehandle");
        }
        PUSHs(&PL_sv_no);
     }
     else {
        if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
-           if (PL_dowarn)
-               warn("page overflow");
+           if (ckWARN(WARN_IO))
+               warner(WARN_IO, "page overflow");
        }
        if (!PerlIO_write(ofp, SvPVX(PL_formtarget), SvCUR(PL_formtarget)) ||
                PerlIO_error(fp))
@@ -1148,20 +1150,22 @@ PP(pp_prtf)
 
     sv = NEWSV(0,0);
     if (!(io = GvIO(gv))) {
-       if (PL_dowarn) {
+       if (ckWARN(WARN_UNOPENED)) {
            gv_fullname3(sv, gv, Nullch);
-           warn("Filehandle %s never opened", SvPV(sv,PL_na));
+           warner(WARN_UNOPENED, "Filehandle %s never opened", SvPV(sv,PL_na));
        }
        SETERRNO(EBADF,RMS$_IFI);
        goto just_say_no;
     }
     else if (!(fp = IoOFP(io))) {
-       if (PL_dowarn)  {
+       if (ckWARN2(WARN_CLOSED,WARN_IO))  {
            gv_fullname3(sv, gv, Nullch);
            if (IoIFP(io))
-               warn("Filehandle %s opened only for input", SvPV(sv,PL_na));
-           else
-               warn("printf on closed filehandle %s", SvPV(sv,PL_na));
+               warner(WARN_IO, "Filehandle %s opened only for input",
+                       SvPV(sv,PL_na));
+           else if (ckWARN(WARN_CLOSED))
+               warner(WARN_CLOSED, "printf on closed filehandle %s",
+                       SvPV(sv,PL_na));
        }
        SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
        goto just_say_no;
@@ -1395,11 +1399,11 @@ PP(pp_send)
     io = GvIO(gv);
     if (!io || !IoIFP(io)) {
        length = -1;
-       if (PL_dowarn) {
+       if (ckWARN(WARN_CLOSED)) {
            if (PL_op->op_type == OP_SYSWRITE)
-               warn("Syswrite on closed filehandle");
+               warner(WARN_CLOSED, "Syswrite on closed filehandle");
            else
-               warn("Send on closed socket");
+               warner(WARN_CLOSED, "Send on closed socket");
        }
     }
     else if (PL_op->op_type == OP_SYSWRITE) {
@@ -1812,8 +1816,8 @@ PP(pp_bind)
        RETPUSHUNDEF;
 
 nuts:
-    if (PL_dowarn)
-       warn("bind() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+       warner(WARN_CLOSED, "bind() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -1842,8 +1846,8 @@ PP(pp_connect)
        RETPUSHUNDEF;
 
 nuts:
-    if (PL_dowarn)
-       warn("connect() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+       warner(WARN_CLOSED, "connect() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -1868,8 +1872,8 @@ PP(pp_listen)
        RETPUSHUNDEF;
 
 nuts:
-    if (PL_dowarn)
-       warn("listen() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+       warner(WARN_CLOSED, "listen() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -1922,8 +1926,8 @@ PP(pp_accept)
     RETURN;
 
 nuts:
-    if (PL_dowarn)
-       warn("accept() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+       warner(WARN_CLOSED, "accept() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
 
 badexit:
@@ -1949,8 +1953,8 @@ PP(pp_shutdown)
     RETURN;
 
 nuts:
-    if (PL_dowarn)
-       warn("shutdown() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+       warner(WARN_CLOSED, "shutdown() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2027,8 +2031,8 @@ PP(pp_ssockopt)
     RETURN;
 
 nuts:
-    if (PL_dowarn)
-       warn("[gs]etsockopt() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+       warner(WARN_CLOSED, "[gs]etsockopt() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
@@ -2100,8 +2104,8 @@ PP(pp_getpeername)
     RETURN;
 
 nuts:
-    if (PL_dowarn)
-       warn("get{sock, peer}name() on closed fd");
+    if (ckWARN(WARN_CLOSED))
+       warner(WARN_CLOSED, "get{sock, peer}name() on closed fd");
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
@@ -2158,8 +2162,8 @@ PP(pp_stat)
 #endif
            PL_laststatval = PerlLIO_stat(SvPV(PL_statname, PL_na), &PL_statcache);
        if (PL_laststatval < 0) {
-           if (PL_dowarn && strchr(SvPV(PL_statname, PL_na), '\n'))
-               warn(warn_nl, "stat");
+           if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, PL_na), '\n'))
+               warner(WARN_NEWLINE, warn_nl, "stat");
            max = 0;
        }
     }
@@ -2563,8 +2567,8 @@ PP(pp_fttext)
                len = 512;
        }
        else {
-           if (PL_dowarn)
-               warn("Test on unopened file <%s>",
+           if (ckWARN(WARN_UNOPENED))
+               warner(WARN_UNOPENED, "Test on unopened file <%s>",
                  GvENAME(cGVOP->op_gv));
            SETERRNO(EBADF,RMS$_IFI);
            RETPUSHUNDEF;
@@ -2582,8 +2586,8 @@ PP(pp_fttext)
        i = PerlLIO_open(SvPV(sv, PL_na), 0);
 #endif
        if (i < 0) {
-           if (PL_dowarn && strchr(SvPV(sv, PL_na), '\n'))
-               warn(warn_nl, "open");
+           if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, PL_na), '\n'))
+               warner(WARN_NEWLINE, warn_nl, "open");
            RETPUSHUNDEF;
        }
        PL_laststatval = PerlLIO_fstat(i, &PL_statcache);
@@ -2607,12 +2611,17 @@ PP(pp_fttext)
            odd += len;
            break;
        }
+#ifdef EBCDIC
+        else if (!(isPRINT(*s) || isSPACE(*s))) 
+            odd++;
+#else
        else if (*s & 128)
            odd++;
        else if (*s < 32 &&
          *s != '\n' && *s != '\r' && *s != '\b' &&
          *s != '\t' && *s != '\f' && *s != 27)
            odd++;
+#endif
     }
 
     if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
@@ -2738,7 +2747,7 @@ PP(pp_rename)
        if (same_dirent(tmps2, tmps))   /* can always rename to same name */
            anum = 1;
        else {
-           if (euid || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode))
+           if (PL_euid || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode))
                (void)UNLINK(tmps2);
            if (!(anum = link(tmps, tmps2)))
                anum = UNLINK(tmps);