This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
(perl #128996) prevent PL_op pointing to freed ops
[perl5.git] / doio.c
diff --git a/doio.c b/doio.c
index d95ad9c..b8f3c28 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -808,9 +808,13 @@ PerlIO *
 Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
 {
     IO * const io = GvIOp(gv);
+    SV *const old_out_name = PL_inplace ? newSVsv(GvSV(gv)) : NULL;
 
     PERL_ARGS_ASSERT_NEXTARGV;
 
+    if (old_out_name)
+        SAVEFREESV(old_out_name);
+
     if (!PL_argvoutgv)
        PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
     if (io && (IoFLAGS(io) & (IOf_ARGV|IOf_START)) == (IOf_ARGV|IOf_START)) {
@@ -852,6 +856,13 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
             }
         }
         else {
+            {
+                IO * const io = GvIOp(PL_argvoutgv);
+                if (io && IoIFP(io) && old_out_name && !io_close(io, PL_argvoutgv, FALSE, FALSE)) {
+                    Perl_croak(aTHX_ "Failed to close in-place edit file %"SVf": %s\n",
+                               old_out_name, Strerror(errno));
+                }
+            }
             /* This very long block ends with return IoIFP(GvIOp(gv));
                Both this block and the block above fall through on open
                failure to the warning code, and then the while loop above tries
@@ -1015,7 +1026,17 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
     if (io && (IoFLAGS(io) & IOf_ARGV))
        IoFLAGS(io) |= IOf_START;
     if (PL_inplace) {
-       (void)do_close(PL_argvoutgv,FALSE);
+        if (old_out_name) {
+            IO * const io = GvIOp(PL_argvoutgv);
+            if (io && IoIFP(io) && !io_close(io, PL_argvoutgv, FALSE, FALSE)) {
+                Perl_croak(aTHX_ "Failed to close in-place edit file %"SVf": %s\n",
+                           old_out_name, Strerror(errno));
+            }
+        }
+        else {
+            /* maybe this is no longer wanted */
+            (void)do_close(PL_argvoutgv,FALSE);
+        }
        if (io && (IoFLAGS(io) & IOf_ARGV)
            && PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0)
        {
@@ -2577,14 +2598,11 @@ Perl_vms_start_glob
 #endif /* !CSH */
 #endif /* !DOSISH */
     {
-       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);
+        SV ** const svp = hv_fetchs(GvHVn(PL_envgv), "LS_COLORS", 0);
+        if (svp && *svp)
+            save_helem_flags(GvHV(PL_envgv),
+                             newSVpvs_flags("LS_COLORS", SVs_TEMP), svp,
+                             SAVEf_SETMAGIC);
     }
     (void)do_open6(PL_last_in_gv, SvPVX_const(tmpcmd), SvCUR(tmpcmd),
                    NULL, NULL, 0);