This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
GvIO(gv) returns NULL for a NULL gv, so refactor to take advantage of this.
[perl5.git] / pp_sys.c
index d93cc87..262fefe 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -358,7 +358,22 @@ PP(pp_glob)
 {
     dVAR;
     OP *result;
-    tryAMAGICunTARGET(iter, -1);
+    dSP;
+    /* make a copy of the pattern, to ensure that magic is called once
+     * and only once */
+    TOPm1s = sv_2mortal(newSVsv(TOPm1s));
+
+    tryAMAGICunTARGET(iter_amg, -1, (PL_op->op_flags & OPf_SPECIAL));
+
+    if (PL_op->op_flags & OPf_SPECIAL) {
+       /* call Perl-level glob function instead. Stack args are:
+        * MARK, wildcard, csh_glob context index
+        * and following OPs should be: gv(CORE::GLOBAL::glob), entersub
+        * */
+       return NORMAL;
+    }
+    /* stack args are: wildcard, gv(_GEN_n) */
+
 
     /* Note that we only ever get here if File::Glob fails to load
      * without at the same time croaking, for some reason, or if
@@ -689,14 +704,15 @@ PP(pp_fileno)
     if (MAXARG < 1)
        RETPUSHUNDEF;
     gv = MUTABLE_GV(POPs);
+    io = GvIO(gv);
 
-    if (gv && (io = GvIO(gv))
+    if (io
        && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar)))
     {
        return tied_handle_method("FILENO", SP, io, mg);
     }
 
-    if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io))) {
+    if (!io || !(fp = IoIFP(io))) {
        /* Can't do this because people seem to do things like
           defined(fileno($foo)) to check whether $foo is a valid fh.
 
@@ -755,8 +771,9 @@ PP(pp_binmode)
     }
 
     gv = MUTABLE_GV(POPs);
+    io = GvIO(gv);
 
-    if (gv && (io = GvIO(gv))) {
+    if (io) {
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
            /* This takes advantage of the implementation of the varargs
@@ -771,7 +788,7 @@ PP(pp_binmode)
        }
     }
 
-    if (!(io = GvIO(gv)) || !(fp = IoIFP(io))) {
+    if (!io || !(fp = IoIFP(io))) {
        report_evil_fh(gv);
        SETERRNO(EBADF,RMS_IFI);
         RETPUSHUNDEF;
@@ -1239,13 +1256,13 @@ PP(pp_select)
 PP(pp_getc)
 {
     dVAR; dSP; dTARGET;
-    IO *io = NULL;
     GV * const gv = (MAXARG==0) ? PL_stdingv : MUTABLE_GV(POPs);
+    IO *const io = GvIO(gv);
 
     if (MAXARG == 0)
        EXTEND(SP, 1);
 
-    if (gv && (io = GvIO(gv))) {
+    if (io) {
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
            const U32 gimme = GIMME_V;
@@ -1479,14 +1496,14 @@ PP(pp_leavewrite)
 PP(pp_prtf)
 {
     dVAR; dSP; dMARK; dORIGMARK;
-    IO *io;
     PerlIO *fp;
     SV *sv;
 
     GV * const gv
        = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv;
+    IO *const io = GvIO(gv);
 
-    if (gv && (io = GvIO(gv))) {
+    if (io) {
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
            if (MARK == ORIGMARK) {
@@ -1506,7 +1523,7 @@ PP(pp_prtf)
     }
 
     sv = newSV(0);
-    if (!(io = GvIO(gv))) {
+    if (!io) {
        report_evil_fh(gv);
        SETERRNO(EBADF,RMS_IFI);
        goto just_say_no;
@@ -2100,7 +2117,8 @@ PP(pp_tell)
        EXTEND(SP, 1);
     gv = PL_last_in_gv;
 
-    if (gv && (io = GvIO(gv))) {
+    io = GvIO(gv);
+    if (io) {
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
            return tied_handle_method("TELL", SP, io, mg);
@@ -2132,9 +2150,9 @@ PP(pp_sysseek)
 #endif
 
     GV * const gv = PL_last_in_gv = MUTABLE_GV(POPs);
-    IO *io;
+    IO *const io = GvIO(gv);
 
-    if (gv && (io = GvIO(gv))) {
+    if (io) {
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
 #if LSEEKSIZE > IVSIZE
@@ -2197,11 +2215,11 @@ PP(pp_truncate)
            tmpgv = gv_fetchsv(POPs, 0, SVt_PVIO);
 
        do_ftruncate_gv:
-           if (!GvIO(tmpgv))
+           io = GvIO(tmpgv);
+           if (!io)
                result = 0;
            else {
                PerlIO *fp;
-               io = GvIOp(tmpgv);
            do_ftruncate_io:
                TAINT_PROPER("truncate");
                if (!(fp = IoIFP(io))) {
@@ -2342,17 +2360,11 @@ PP(pp_flock)
 #ifdef FLOCK
     dVAR; dSP; dTARGET;
     I32 value;
-    IO *io = NULL;
-    PerlIO *fp;
     const int argtype = POPi;
     GV * const gv = (MAXARG == 0) ? PL_last_in_gv : MUTABLE_GV(POPs);
+    IO *const io = GvIO(gv);
+    PerlIO *const fp = io ? IoIFP(io) : NULL;
 
-    if (gv && (io = GvIO(gv)))
-       fp = IoIFP(io);
-    else {
-       fp = NULL;
-       io = NULL;
-    }
     /* XXX Looks to me like io is always NULL at this point */
     if (fp) {
        (void)PerlIO_flush(fp);
@@ -2383,7 +2395,7 @@ PP(pp_socket)
     register IO * const io = gv ? GvIOn(gv) : NULL;
     int fd;
 
-    if (!gv || !io) {
+    if (!io) {
        report_evil_fh(gv);
        if (io && IoIFP(io))
            do_close(gv, FALSE);
@@ -2434,12 +2446,10 @@ PP(pp_sockpair)
     register IO * const io2 = gv2 ? GvIOn(gv2) : NULL;
     int fd[2];
 
-    if (!gv1 || !gv2 || !io1 || !io2) {
-       if (!gv1 || !io1)
-           report_evil_fh(gv1);
-       if (!gv2 || !io2)
-           report_evil_fh(gv2);
-    }
+    if (!io1)
+       report_evil_fh(gv1);
+    if (!io2)
+       report_evil_fh(gv2);
 
     if (io1 && IoIFP(io1))
        do_close(gv1, FALSE);
@@ -2488,42 +2498,17 @@ PP(pp_bind)
     GV * const gv = MUTABLE_GV(POPs);
     register IO * const io = GvIOn(gv);
     STRLEN len;
+    const int op_type = PL_op->op_type;
 
     if (!io || !IoIFP(io))
        goto nuts;
 
     addr = SvPV_const(addrsv, len);
-    TAINT_PROPER("bind");
-    if (PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
-       RETPUSHYES;
-    else
-       RETPUSHUNDEF;
-
-nuts:
-    report_evil_fh(gv);
-    SETERRNO(EBADF,SS_IVCHAN);
-    RETPUSHUNDEF;
-#else
-    DIE(aTHX_ PL_no_sock_func, "bind");
-#endif
-}
-
-PP(pp_connect)
-{
-#ifdef HAS_SOCKET
-    dVAR; dSP;
-    SV * const addrsv = POPs;
-    GV * const gv = MUTABLE_GV(POPs);
-    register IO * const io = GvIOn(gv);
-    const char *addr;
-    STRLEN len;
-
-    if (!io || !IoIFP(io))
-       goto nuts;
-
-    addr = SvPV_const(addrsv, len);
-    TAINT_PROPER("connect");
-    if (PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+    TAINT_PROPER(PL_op_desc[op_type]);
+    if ((op_type == OP_BIND
+        ? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)
+        : PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len))
+       >= 0)
        RETPUSHYES;
     else
        RETPUSHUNDEF;
@@ -2533,7 +2518,7 @@ nuts:
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
 #else
-    DIE(aTHX_ PL_no_sock_func, "connect");
+    DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
 #endif
 }
 
@@ -2545,7 +2530,7 @@ PP(pp_listen)
     GV * const gv = MUTABLE_GV(POPs);
     register IO * const io = gv ? GvIOn(gv) : NULL;
 
-    if (!gv || !io || !IoIFP(io))
+    if (!io || !IoIFP(io))
        goto nuts;
 
     if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)