This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
(perl #133659) make an in-place edit successful if the exit status is zero
authorTony Cook <tony@develop-help.com>
Tue, 20 Nov 2018 23:05:27 +0000 (10:05 +1100)
committerTony Cook <tony@develop-help.com>
Mon, 26 Nov 2018 02:48:36 +0000 (13:48 +1100)
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.

doio.c
t/io/inplace.t
t/run/switches.t

diff --git a/doio.c b/doio.c
index 77421de..9fe222e 100644 (file)
--- 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
index ac50f1a..0403cd9 100644 (file)
@@ -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() ;
 
index 7ccef1e..594cad6 100644 (file)
@@ -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";
         }
     }