This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
h2ph: more evilness in the form of Linux inline assembler.
[perl5.git] / pp_sys.c
index 5e1908f..200ed94 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -173,6 +173,8 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
 #  define FD_CLOEXEC 1         /* NeXT needs this */
 #endif
 
+#include "reentr.h"
+
 #undef PERL_EFF_ACCESS_R_OK    /* EFFective uid/gid ACCESS R_OK */
 #undef PERL_EFF_ACCESS_W_OK
 #undef PERL_EFF_ACCESS_X_OK
@@ -321,10 +323,13 @@ PP(pp_backtick)
                ;
        }
        else if (gimme == G_SCALAR) {
+           SV *oldrs = PL_rs;
+           PL_rs = &PL_sv_undef;
            sv_setpv(TARG, ""); /* note that this preserves previous buffer */
            while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
                /*SUPPRESS 530*/
                ;
+           PL_rs = oldrs;
            XPUSHs(TARG);
            SvTAINTED_on(TARG);
        }
@@ -605,6 +610,7 @@ PP(pp_pipe_op)
 
     IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
     IoOFP(wstio) = PerlIO_fdopen(fd[1], "w");
+    IoOFP(rstio) = IoIFP(rstio);
     IoIFP(wstio) = IoOFP(wstio);
     IoTYPE(rstio) = IoTYPE_RDONLY;
     IoTYPE(wstio) = IoTYPE_WRONLY;
@@ -731,11 +737,16 @@ PP(pp_binmode)
         RETPUSHUNDEF;
     }
 
+    PUTBACK;
     if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
-                       (discp) ? SvPV_nolen(discp) : Nullch))
+                       (discp) ? SvPV_nolen(discp) : Nullch)) {
+       SPAGAIN;
        RETPUSHYES;
-    else
+    }
+    else {
+       SPAGAIN;
        RETPUSHUNDEF;
+    }
 }
 
 PP(pp_tie)
@@ -817,11 +828,11 @@ PP(pp_tie)
        sv_unmagic(varsv, how);
        /* Croak if a self-tie on an aggregate is attempted. */
        if (varsv == SvRV(sv) &&
-           (SvTYPE(sv) == SVt_PVAV ||
-            SvTYPE(sv) == SVt_PVHV))
+           (SvTYPE(varsv) == SVt_PVAV ||
+            SvTYPE(varsv) == SVt_PVHV))
            Perl_croak(aTHX_
                       "Self-ties of arrays and hashes are not supported");
-       sv_magic(varsv, sv, how, Nullch, 0);
+       sv_magic(varsv, (SvRV(sv) == varsv ? Nullsv : sv), how, Nullch, 0);
     }
     LEAVE;
     SP = PL_stack_base + markoff;
@@ -2173,9 +2184,6 @@ PP(pp_ioctl)
 #else
        retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s);
 #endif
-#else
-       DIE(aTHX_ "fcntl is not implemented");
-#endif
 
     if (SvPOK(argsv)) {
        if (s[SvCUR(argsv)] != 17)
@@ -2194,6 +2202,10 @@ PP(pp_ioctl)
        PUSHp(zero_but_true, ZBTLEN);
     }
     RETURN;
+
+#else
+    DIE(aTHX_ "fcntl is not implemented");
+#endif
 }
 
 PP(pp_flock)
@@ -4040,7 +4052,7 @@ PP(pp_system)
        TAINT_ENV();
        while (++MARK <= SP) {
            (void)SvPV_nolen(*MARK);      /* stringify for taint check */
-           if (PL_tainted) 
+           if (PL_tainted)
                break;
        }
        MARK = ORIGMARK;
@@ -4123,17 +4135,17 @@ PP(pp_system)
            fcntl(pp[1], F_SETFD, FD_CLOEXEC);
 #endif
        }
+       if (PL_op->op_flags & OPf_STACKED) {
+           SV *really = *++MARK;
+           value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
+       }
+       else if (SP - MARK != 1)
+           value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes);
+       else {
+           value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes);
+       }
+       PerlProc__exit(-1);
     }
-    if (PL_op->op_flags & OPf_STACKED) {
-       SV *really = *++MARK;
-       value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
-    }
-    else if (SP - MARK != 1)
-       value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes);
-    else {
-       value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes);
-    }
-    PerlProc__exit(-1);
 #else /* ! FORK or VMS or OS/2 */
     PL_statusvalue = 0;
     result = 0;
@@ -4166,7 +4178,7 @@ PP(pp_exec)
        TAINT_ENV();
        while (++MARK <= SP) {
            (void)SvPV_nolen(*MARK);      /* stringify for taint check */
-           if (PL_tainted) 
+           if (PL_tainted)
                break;
        }
        MARK = ORIGMARK;