136 lines
4.6 KiB
Diff
136 lines
4.6 KiB
Diff
|
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
|
||
|
|