perldelta up to abf9167d

[perl5.git] / doio.c

diff --git a/doio.c b/doio.c
index cd470c4..526e1b5 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -214,7 +214,8 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                goto say_false;
            }
 #endif /* USE_STDIO */
-           name = SvOK(*svp) ? savesvpv (*svp) : savepvs ("");
+           name = (SvOK(*svp) || SvGMAGICAL(*svp)) ?
+                       savesvpv (*svp) : savepvs ("");
            SAVEFREEPV(name);
        }
        else {
@@ -764,7 +765,7 @@ Perl_nextargv(pTHX_ register GV *gv)
                    do_close(gv,FALSE);
                    continue;
                }
-               if (*PL_inplace) {
+               if (*PL_inplace && strNE(PL_inplace, "*")) {
                    const char *star = strchr(PL_inplace, '*');
                    if (star) {
                        const char *begin = PL_inplace;
@@ -1240,7 +1241,9 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
            else {
                assert((char *)result == tmps);
                Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8),
-                                "Wide character in print");
+                                "Wide character in %s",
+                                  PL_op ? OP_DESC(PL_op) : "print"
+                               );
            }
        }
        /* To detect whether the process is about to overstep its
@@ -1257,7 +1260,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
 }
 
 I32
-Perl_my_stat(pTHX)
+Perl_my_stat_flags(pTHX_ const U32 flags)
 {
     dVAR;
     dSP;
@@ -1313,7 +1316,7 @@ Perl_my_stat(pTHX)
             goto do_fstat_have_io;
         }
 
-       s = SvPV_const(sv, len);
+       s = SvPV_flags_const(sv, len, flags);
        PL_statgv = NULL;
        sv_setpvn(PL_statname, s, len);
        s = SvPVX_const(PL_statname);           /* s now NUL-terminated */
@@ -1327,7 +1330,7 @@ Perl_my_stat(pTHX)
 
 
 I32
-Perl_my_lstat(pTHX)
+Perl_my_lstat_flags(pTHX_ const U32 flags)
 {
     dVAR;
     static const char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
@@ -1360,7 +1363,7 @@ Perl_my_lstat(pTHX)
                GvENAME((const GV *)SvRV(sv)));
        return (PL_laststatval = -1);
     }
-    file = SvPV_nolen_const(sv);
+    file = SvPV_flags_const_nolen(sv, flags);
     sv_setpv(PL_statname,file);
     PL_laststatval = PerlLIO_lstat(file,&PL_statcache);
     if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(file, '\n'))
@@ -1720,9 +1723,10 @@ nothing in the core.
            while (++mark <= sp) {
                I32 proc;
                register unsigned long int __vmssts;
+               SvGETMAGIC(*mark);
                if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
                    Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
-               proc = SvIV(*mark);
+               proc = SvIV_nomg(*mark);
                APPLY_TAINT_PROPER();
                if (!((__vmssts = sys$delprc(&proc,0)) & 1)) {
                    tot--;
@@ -1739,6 +1743,7 @@ nothing in the core.
                    }
                }
            }
+           PERL_ASYNC_CHECK();
            break;
        }
 #endif
@@ -1746,9 +1751,10 @@ nothing in the core.
            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(*mark);
+               proc = SvIV_nomg(*mark);
                APPLY_TAINT_PROPER();
 #ifdef HAS_KILLPG
                if (PerlProc_killpg(proc,val))  /* BSD */
@@ -1761,14 +1767,16 @@ nothing in the core.
        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(*mark);
+               proc = SvIV_nomg(*mark);
                APPLY_TAINT_PROPER();
                if (PerlProc_kill(proc, val))
                    tot--;
            }
        }
+       PERL_ASYNC_CHECK();
        break;
 #endif
     case OP_UNLINK:
@@ -1918,7 +1926,11 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp)
      return (mode & statbufp->st_mode) ? TRUE : FALSE;
 
 #else /* ! DOSISH */
+# ifdef __CYGWIN__
+    if (ingroup(544,effective)) {     /* member of Administrators */
+# else
     if ((effective ? PL_euid : PL_uid) == 0) { /* root is special */
+# endif
        if (mode == S_IXUSR) {
            if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
                return TRUE;