From 85d2f7cacba4b0088ae0c67cc6d4c9b7495355c0 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 21 Nov 2018 10:05:27 +1100
Subject: [PATCH 3/3] (perl #133659) make an in-place edit successful if the
 exit status is zero
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

during global destruction.

This means that code like:

  perl -i -ne '...; last'

will replace the input file with the in-place edit output of the file,
but:

  perl -i -ne '...; die'

or

  perl -i -ne '...; exit 1'

won't.

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 doio.c           | 45 +++++++++++++++++++++++++--------------------
 t/io/inplace.t   |  2 +-
 t/run/switches.t |  4 ++--
 3 files changed, 28 insertions(+), 23 deletions(-)

diff --git a/doio.c b/doio.c
index 77421de1d1..9fe222e082 100644
--- a/doio.c
+++ b/doio.c
@@ -1173,34 +1173,39 @@ S_argvout_free(pTHX_ SV *io, MAGIC *mg) {
         dir = INT2PTR(DIR *, SvIV(*dir_psv));
 #endif
         if (IoIFP(io)) {
-            SV **pid_psv;
-            PerlIO *iop = IoIFP(io);
+            if (PL_phase == PERL_PHASE_DESTRUCT && PL_statusvalue == 0) {
+                (void)argvout_final(mg, (IO*)io, FALSE);
+            }
+            else {
+                SV **pid_psv;
+                PerlIO *iop = IoIFP(io);
 
-            assert(SvTYPE(mg->mg_obj) == SVt_PVAV);
+                assert(SvTYPE(mg->mg_obj) == SVt_PVAV);
 
-            pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE);
+                pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE);
 
-            assert(pid_psv && *pid_psv);
+                assert(pid_psv && *pid_psv);
 
-            if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) {
-                /* if we get here the file hasn't been closed explicitly by the
-                   user and hadn't been closed implicitly by nextargv(), so
-                   abandon the edit */
-                SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
-                const char *temp_pv = SvPVX(*temp_psv);
+                if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) {
+                    /* if we get here the file hasn't been closed explicitly by the
+                       user and hadn't been closed implicitly by nextargv(), so
+                       abandon the edit */
+                    SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
+                    const char *temp_pv = SvPVX(*temp_psv);
 
-                assert(temp_psv && *temp_psv && SvPOK(*temp_psv));
-                (void)PerlIO_close(iop);
-                IoIFP(io) = IoOFP(io) = NULL;
+                    assert(temp_psv && *temp_psv && SvPOK(*temp_psv));
+                    (void)PerlIO_close(iop);
+                    IoIFP(io) = IoOFP(io) = NULL;
 #ifdef ARGV_USE_ATFUNCTIONS
-                if (dir) {
-                    if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 &&
-                        NotSupported(errno))
-                        (void)UNLINK(temp_pv);
-                }
+                    if (dir) {
+                        if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 &&
+                            NotSupported(errno))
+                            (void)UNLINK(temp_pv);
+                    }
 #else
-                (void)UNLINK(temp_pv);
+                    (void)UNLINK(temp_pv);
 #endif
+                }
             }
         }
 #ifdef ARGV_USE_ATFUNCTIONS
diff --git a/t/io/inplace.t b/t/io/inplace.t
index ac50f1ab77..0403cd9250 100644
--- a/t/io/inplace.t
+++ b/t/io/inplace.t
@@ -96,7 +96,7 @@ SKIP:
     my @tests =
       ( # opts, code, result, name, $TODO
        [ "-n", "die", "bar\n", "die shouldn't touch file" ],
-       [ "-n", "last", "", "last should update file", "not implemented yet" ],
+       [ "-n", "last", "", "last should update file" ],
       );
     our $file = tempfile() ;
 
diff --git a/t/run/switches.t b/t/run/switches.t
index 7ccef1e063..594cad6e7f 100644
--- a/t/run/switches.t
+++ b/t/run/switches.t
@@ -429,7 +429,7 @@ __EOF__
 
     # exit or die should leave original content in file
     for my $inplace (qw/-i -i.bak/) {
-        for my $prog (qw/die exit/) {
+        for my $prog ("die", "exit 1") {
             open my $fh, ">", $work or die "$0: failed to open '$work': $!";
             print $fh $yada;
             close $fh or die "Failed to close: $!";
@@ -443,7 +443,7 @@ __EOF__
             my $data = do { local $/; <$in> };
             close $in;
             is ($data, $yada, "check original content still in file");
-            unlink $work;
+            unlink $work, "$work.bak";
         }
     }
 
-- 
2.17.2