This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regex: Remove FOLDCHAR regnode type
[perl5.git] / pp_sys.c
index c7212b3..c804958 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1017,7 +1017,10 @@ PP(pp_dbmopen)
     if (SvIV(right))
        mPUSHu(O_RDWR|O_CREAT);
     else
+    {
        mPUSHu(O_RDWR);
+       if (!SvOK(right)) right = &PL_sv_no;
+    }
     PUSHs(right);
     PUTBACK;
     call_sv(MUTABLE_SV(GvCV(gv)), G_SCALAR);
@@ -2756,11 +2759,14 @@ PP(pp_stat)
 
     if (PL_op->op_flags & OPf_REF ? (gv = cGVOP_gv, 1)
                                   : !!(sv=POPs, gv = MAYBE_DEREF_GV(sv))) {
+       bool havefp;
        if (PL_op->op_type == OP_LSTAT) {
            if (gv != PL_defgv) {
            do_fstat_warning_check:
                Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                              "lstat() on filehandle %"SVf, SVfARG(gv
+                              "lstat() on filehandle%s%"SVf,
+                               gv ? " " : "",
+                               SVfARG(gv
                                         ? sv_2mortal(newSVhek(GvENAME_HEK(gv)))
                                         : &PL_sv_no));
            } else if (PL_laststype != OP_LSTAT)
@@ -2768,29 +2774,32 @@ PP(pp_stat)
                Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
        }
 
+       havefp = FALSE;
        if (gv != PL_defgv) {
+          do_fstat_have_io:
            PL_laststype = OP_STAT;
-           PL_statgv = gv;
+           PL_statgv = gv ? gv : (GV *)io;
            sv_setpvs(PL_statname, "");
             if(gv) {
                 io = GvIO(gv);
-                do_fstat_have_io:
-                if (io) {
+           }
+            if (io) {
                     if (IoIFP(io)) {
                         PL_laststatval = 
                             PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache);   
+                        havefp = TRUE;
                     } else if (IoDIRP(io)) {
                         PL_laststatval =
                             PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache);
+                        havefp = TRUE;
                     } else {
                         PL_laststatval = -1;
                     }
-               }
             }
         }
 
        if (PL_laststatval < 0) {
-           report_evil_fh(gv);
+           if (!havefp) report_evil_fh(gv);
            max = 0;
        }
     }
@@ -3245,7 +3254,6 @@ PP(pp_fttty)
     dSP;
     int fd;
     GV *gv;
-    SV *tmpsv = NULL;
     char *name = NULL;
     STRLEN namelen;
 
@@ -3255,20 +3263,18 @@ PP(pp_fttty)
 
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
-    else if (!(gv = MAYBE_DEREF_GV_nomg(TOPs))) {
-       tmpsv = POPs;
+    else {
+      SV *tmpsv = POPs;
+      if (!(gv = MAYBE_DEREF_GV_nomg(tmpsv))) {
        name = SvPV_nomg(tmpsv, namelen);
        gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO);
+      }
     }
 
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
        fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
-    else if (tmpsv && SvOK(tmpsv)) {
-       if (isDIGIT(*name))
+    else if (name && isDIGIT(*name))
            fd = atoi(name);
-       else 
-           RETPUSHUNDEF;
-    }
     else
        RETPUSHUNDEF;
     if (PerlLIO_isatty(fd))
@@ -3294,7 +3300,7 @@ PP(pp_fttext)
     STDCHAR tbuf[512];
     register STDCHAR *s;
     register IO *io;
-    register SV *sv;
+    register SV *sv = NULL;
     GV *gv;
     PerlIO *fp;
 
@@ -3303,25 +3309,31 @@ PP(pp_fttext)
     STACKED_FTEST_CHECK;
 
     if (PL_op->op_flags & OPf_REF)
+    {
        gv = cGVOP_gv;
-    else gv = MAYBE_DEREF_GV_nomg(TOPs);
+       EXTEND(SP, 1);
+    }
+    else if (PL_op->op_private & OPpFT_STACKED)
+       gv = PL_defgv;
+    else sv = POPs, gv = MAYBE_DEREF_GV_nomg(sv);
 
     if (gv) {
-       EXTEND(SP, 1);
        if (gv == PL_defgv) {
            if (PL_statgv)
-               io = GvIO(PL_statgv);
+               io = SvTYPE(PL_statgv) == SVt_PVIO
+                   ? (IO *)PL_statgv
+                   : GvIO(PL_statgv);
            else {
-               sv = PL_statname;
                goto really_filename;
            }
        }
        else {
            PL_statgv = gv;
-           PL_laststatval = -1;
            sv_setpvs(PL_statname, "");
            io = GvIO(PL_statgv);
        }
+       PL_laststatval = -1;
+       PL_laststype = OP_STAT;
        if (io && IoIFP(io)) {
            if (! PerlIO_has_base(IoIFP(io)))
                DIE(aTHX_ "-T and -B not implemented on filehandles");
@@ -3348,23 +3360,27 @@ PP(pp_fttext)
                len = 512;
        }
        else {
-           report_evil_fh(cGVOP_gv);
+           SETERRNO(EBADF,RMS_IFI);
+           report_evil_fh(gv);
            SETERRNO(EBADF,RMS_IFI);
            RETPUSHUNDEF;
        }
     }
     else {
-       sv = POPs;
+       sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
       really_filename:
        PL_statgv = NULL;
-       PL_laststype = OP_STAT;
-       sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv));
        if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
+           if (!gv) {
+               PL_laststatval = -1;
+               PL_laststype = OP_STAT;
+           }
            if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
                                               '\n'))
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
            RETPUSHUNDEF;
        }
+       PL_laststype = OP_STAT;
        PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache);
        if (PL_laststatval < 0) {
            (void)PerlIO_close(fp);
@@ -4182,7 +4198,7 @@ PP(pp_system)
                PerlLIO_close(pp[0]);
                if (n) {                        /* Error */
                    if (n != sizeof(int))
-                       DIE(aTHX_ "panic: kid popen errno read");
+                       DIE(aTHX_ "panic: kid popen errno read, n=%u", n);
                    errno = errkid;             /* Propagate errno from kid */
                    STATUS_NATIVE_CHILD_SET(-1);
                }