op.c: ck_grep does not need to call listkids

[perl5.git] / doio.c

diff --git a/doio.c b/doio.c
index d1f20d3..fd6683d 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -320,7 +320,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                    }
                    while (isSPACE(*type))
                        type++;
-                   if (num_svs && (SvIOK(*svp) || (SvPOK(*svp) && looks_like_number(*svp)))) {
+                   if (num_svs && (
+                            SvIOK(*svp)
+                         || (SvPOKp(*svp) && looks_like_number(*svp))
+                      )) {
                        fd = SvUV(*svp);
                        num_svs = 0;
                    }
@@ -1219,8 +1222,8 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
        U8 *tmpbuf = NULL;
        bool happy = TRUE;
 
-       if (PerlIO_isutf8(fp)) {
-           if (!SvUTF8(sv)) {
+       if (PerlIO_isutf8(fp)) { /* If the stream is utf8 ... */
+           if (!SvUTF8(sv)) {  /* Convert to utf8 if necessary */
                /* We don't modify the original scalar.  */
                tmpbuf = bytes_to_utf8((const U8*) tmps, &len);
                tmps = (char *) tmpbuf;
@@ -1228,17 +1231,22 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
            else if (ckWARN4_d(WARN_UTF8, WARN_SURROGATE, WARN_NON_UNICODE, WARN_NONCHAR)) {
                (void) check_utf8_print((const U8*) tmps, len);
            }
-       }
-       else if (DO_UTF8(sv)) {
+       } /* else stream isn't utf8 */
+       else if (DO_UTF8(sv)) { /* But if is utf8 internally, attempt to
+                                  convert to bytes */
            STRLEN tmplen = len;
            bool utf8 = TRUE;
            U8 * const result = bytes_from_utf8((const U8*) tmps, &tmplen, &utf8);
            if (!utf8) {
+
+               /* Here, succeeded in downgrading from utf8.  Set up to below
+                * output the converted value */
                tmpbuf = result;
                tmps = (char *) tmpbuf;
                len = tmplen;
            }
-           else {
+           else {  /* Non-utf8 output stream, but string only representable in
+                      utf8 */
                assert((char *)result == tmps);
                Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8),
                                 "Wide character in %s",
@@ -1557,6 +1565,10 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 
 #endif /* OS2 || WIN32 */
 
+#ifdef VMS
+#include <starlet.h> /* for sys$delprc */
+#endif
+
 I32
 Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 {
@@ -1567,6 +1579,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
     const char *s;
     STRLEN len;
     SV ** const oldmark = mark;
+    bool killgp = FALSE;
 
     PERL_ARGS_ASSERT_APPLY;
 
@@ -1677,6 +1690,12 @@ nothing in the core.
        if (mark == sp)
            break;
        s = SvPVx_const(*++mark, len);
+       if (*s == '-' && isALPHA(s[1]))
+       {
+           s++;
+           len--;
+            killgp = TRUE;
+       }
        if (isALPHA(*s)) {
            if (*s == 'S' && s[1] == 'I' && s[2] == 'G') {
                s += 3;
@@ -1686,14 +1705,19 @@ nothing in the core.
                Perl_croak(aTHX_ "Unrecognized signal name \"%"SVf"\"", SVfARG(*mark));
        }
        else
+       {
            val = SvIV(*mark);
+           if (val < 0)
+           {
+               killgp = TRUE;
+                val = -val;
+           }
+       }
        APPLY_TAINT_PROPER();
        tot = sp - mark;
 #ifdef VMS
        /* kill() doesn't do process groups (job trees?) under VMS */
-       if (val < 0) val = -val;
        if (val == SIGKILL) {
-#          include <starlet.h>
            /* Use native sys$delprc() to insure that target process is
             * deleted; supervisor-mode images don't pay attention to
             * CRTL's emulation of Unix-style signals and kill()
@@ -1725,34 +1749,19 @@ nothing in the core.
            break;
        }
 #endif
-       if (val < 0) {
-           val = -val;
-           while (++mark <= sp) {
-               I32 proc;
-               SvGETMAGIC(*mark);
-               if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
-                   Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
-               proc = SvIV_nomg(*mark);
-               APPLY_TAINT_PROPER();
-#ifdef HAS_KILLPG
-               if (PerlProc_killpg(proc,val))  /* BSD */
-#else
-               if (PerlProc_kill(-proc,val))   /* SYSV */
-#endif
-                   tot--;
-           }
-       }
-       else {
-           while (++mark <= sp) {
-               I32 proc;
-               SvGETMAGIC(*mark);
-               if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
-                   Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
-               proc = SvIV_nomg(*mark);
-               APPLY_TAINT_PROPER();
-               if (PerlProc_kill(proc, val))
-                   tot--;
+       while (++mark <= sp) {
+           Pid_t proc;
+           SvGETMAGIC(*mark);
+           if (!(SvNIOK(*mark) || looks_like_number(*mark)))
+               Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
+           proc = SvIV_nomg(*mark);
+           if (killgp)
+           {
+                proc = -proc;
            }
+           APPLY_TAINT_PROPER();
+           if (PerlProc_kill(proc, val))
+               tot--;
        }
        PERL_ASYNC_CHECK();
        break;
@@ -2274,9 +2283,10 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
     if (optype == OP_SHMREAD) {
        char *mbuf;
        /* suppress warning when reading into undef var (tchrist 3/Mar/00) */
+       SvGETMAGIC(mstr);
+       SvUPGRADE(mstr, SVt_PV);
        if (! SvOK(mstr))
            sv_setpvs(mstr, "");
-       SvUPGRADE(mstr, SVt_PV);
        SvPOK_only(mstr);
        mbuf = SvGROW(mstr, (STRLEN)msize+1);
 
@@ -2376,9 +2386,12 @@ Perl_vms_start_glob
     {
        GV * const envgv = gv_fetchpvs("ENV", 0, SVt_PVHV);
        SV ** const home = hv_fetchs(GvHV(envgv), "HOME", 0);
+       SV ** const path = hv_fetchs(GvHV(envgv), "PATH", 0);
        if (home && *home) SvGETMAGIC(*home);
+       if (path && *path) SvGETMAGIC(*path);
        save_hash(gv_fetchpvs("ENV", 0, SVt_PVHV));
        if (home && *home) SvSETMAGIC(*home);
+       if (path && *path) SvSETMAGIC(*path);
     }
     (void)do_open(PL_last_in_gv, (char*)SvPVX_const(tmpcmd), SvCUR(tmpcmd),
                  FALSE, O_RDONLY, 0, NULL);
@@ -2392,8 +2405,8 @@ Perl_vms_start_glob
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */