5.28.0 regression: In-place edit without "while(<>)" does not replace files #16748
Comments
From @ppisarHello, I'm forwarding a bug report If perl is asked for an in-place edit with an "-i" option and the Perl code $ cat test Expected behvior is that the "test" file ends up with "2\n" inside. As you can I can reproduce it with 5.28.0 as well as with latest blead Reducing the reproducer I got this code that works: $ ./perl -Ilib -i -e '$/=undef; while ($_=<>) {s/1/2/; print}' /tmp/test while this does not work: $ ./perl -Ilib -i -e '$/=undef; $_=<>; {s/1/2/; print}' /tmp/test It seems there is a special handling for "while(<>)" that triggers the final By the way, perlrun POD setion for "-i" option seems out-dated as it still [...] It does this by renaming the input file, opening While the 5.28.0 code first creates a temporary file, write an output there -- Petr |
From @jkeenanOn Thu, 15 Nov 2018 11:42:26 GMT, ppisar wrote:
[snip]
Does anyone have any idea how to bisect this? So far I haven't been able to figure out how to fit this into one of the examples in 'perldoc Porting/bisect-runner.pl'. [snip] Thank you very much. -- |
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Thu, 15 Nov 2018 03:42:26 -0800, ppisar wrote:
It's not the while() in particular that's special, but calling <> again to iterate to the next file (or the end of the list.) I hadn't considered the non-looping in-place editing (and none of the tests do it that I'm aware of), but I was trying to get reasonable behaviour for: perl -i -pe 's/FAILED/OK/ or die' somefile Should the file be replaced if the code dies? I don't know a way to detect in the magic that does the clean up whether we're cleaning up due to a die or falling off the end of the code as in your case. As a workaround you can explicitly close ARGVOUT: ./perl -i -e 'local $/; my $s=<>; $s=~s/FAILED/OK/; print $s; close ARGVOUT' Maybe it should always replace it like it did previously.
Yes, this needs to be updated. Tony |
From @ppisarOn 2018-11-15, "James E Keenan via RT" <perlbug-followup@perl.org> wrote:
I finished bisecting now (using my own scripts) and it converged to this commit commit e0d4aea (HEAD, refs/bisect/bad) (perl #127663) safer in-place editing -- Petr |
From @ppisarOn 2018-11-15, "Tony Cook via RT" <perlbug-followup@perl.org> wrote:
In my opinion, the file should be kept intact if the interpreter is However, I can image that a multiple file edit cannot have a correct $ perl -i -pe 's/FAILED/OK/ or die' somefile anotherfile because if somefile edits and replaces successfully but editing
Can we decide on $@ value? Or better on some flag that instructs perl
Yes, the explicit close helps here. -- Petr |
From @peffCreated by @peffIn perl 5.26.0 and earlier, using "-i" would modify the file even if you $ echo foo >file But in 5.28.0, the file is left untouched: $ cat file This bisects in the perl-git mirror to e0d4aea ((perl #127663) safer The above code is obviously a toy example to reproduce the issue. If you perl -i -ne 'print && exit 0 if /^[^#]/' $file Perl Info |
From @jkeenanOn Mon, 19 Nov 2018 20:23:24 GMT, peff@peff.net wrote:
This seems very similar to another recent report: https://rt-archive.perl.org/perl5/Ticket/Display.html?id=133659 TonyC, p5p list: Could you take a look at both? Thank you very much. -- |
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Mon, 19 Nov 2018 12:23:24 -0800, peff@peff.net wrote:
This is the same as 133659, merging. Tony |
From @tonycozOn Fri, 16 Nov 2018 02:44:10 -0800, ppisar wrote:
$@ isn't useful here, it may have been set by a previous eval. Perhaps: - if we're in global destruction, and PL_statusvalue ($?) is zero, treat this as a successful in-place edit (replace the original file with the work file) This would mean all of: perl -i -pe 's/FAILED/OK/ or die' somefile *wouldn't* replace the file, but all of: perl -i -ne 'last' somefile *would* replace the file. Unfortunately non-trivial code that uses in-place editing will still have problems: sub foo { eval { foo("somefile") }; at the point where ARGVOUT is cleaned up we aren't in global destruction, so the file isn't replaced. Tony |
From @tonycozOn Mon, 19 Nov 2018 16:31:12 -0800, tonyc wrote:
Oops, the input file *is* replaced. The attached does the simple version of the check, but doesn't handle the more complex case. Tony |
From @tonycoz0001-perl-133659-tests-for-global-destruction-handling-of.patchFrom bfcb1def3fc594025a4a38c4247f1c85e815b3fa Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 20 Nov 2018 16:43:43 +1100
Subject: (perl #133659) tests for global destruction handling of inplace
editing
---
t/io/inplace.t | 28 +++++++++++++++++++++++++++-
1 file changed, 27 insertions(+), 1 deletion(-)
diff --git a/t/io/inplace.t b/t/io/inplace.t
index 98159e06bf..ac50f1ab77 100644
--- a/t/io/inplace.t
+++ b/t/io/inplace.t
@@ -5,7 +5,7 @@ require './test.pl';
$^I = $^O eq 'VMS' ? '_bak' : '.bak';
-plan( tests => 6 );
+plan( tests => 8 );
my @tfiles = (tempfile(), tempfile(), tempfile());
my @tfiles_bak = map "$_$^I", @tfiles;
@@ -91,3 +91,29 @@ SKIP:
END { unlink_all(@ifiles); }
}
+
+{
+ 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" ],
+ );
+ our $file = tempfile() ;
+
+ for my $test (@tests) {
+ (my ($opts, $code, $result, $name), our $TODO) = @$test;
+ open my $fh, ">", $file or die;
+ print $fh "bar\n";
+ close $fh;
+
+ runperl( prog => $code,
+ switches => [ grep length, "-i", $opts ],
+ args => [ $file ],
+ stderr => 1, # discarded
+ );
+ open $fh, "<", $file or die;
+ my $data = do { local $/; <$fh>; };
+ close $fh;
+ is($data, $result, $name);
+ }
+}
--
2.11.0
|
From @tonycoz0002-perl-133659-make-an-in-place-edit-successful-if-the-.patchFrom 969988ae104a4f4bd7f6ce7028a2b94e6deb9eb4 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 21 Nov 2018 10:05:27 +1100
Subject: (perl #133659) make an in-place edit successful if the exit status is
zero
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 | 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.11.0
|
From @tonycozOn Wed, 21 Nov 2018 19:15:41 -0800, tonyc wrote:
The attached is the first step towards a solution for the more complex case, but as the tests show it doesn't handle at least one of the more painful possible ways for die_unwinding() to be interrupted (though it tries.) Tony |
From @tonycoz0003-DON-T-APPLY-THIS.patchFrom 55904124aeff51e3a674769f21750ee51b1a3502 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 22 Nov 2018 14:11:16 +1100
Subject: DON'T APPLY THIS
Attempt at defining an interpreter variable that detects unwinding
from a die.
Unfortunately it doesn't work.
---
MANIFEST | 1 +
embedvar.h | 1 +
ext/XS-APItest/APItest.pm | 2 +-
ext/XS-APItest/APItest.xs | 5 +++
ext/XS-APItest/t/die_unwinding.t | 75 ++++++++++++++++++++++++++++++++++++++++
intrpvar.h | 2 ++
pp_ctl.c | 30 ++++++++++++++++
sv.c | 1 +
8 files changed, 116 insertions(+), 1 deletion(-)
create mode 100644 ext/XS-APItest/t/die_unwinding.t
diff --git a/MANIFEST b/MANIFEST
index 006267323a..5adc1ec8db 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4276,6 +4276,7 @@ ext/XS-APItest/t/cv_name.t test cv_name
ext/XS-APItest/t/eval-filter.t Simple source filter/eval test
ext/XS-APItest/t/exception.t XS::APItest extension
ext/XS-APItest/t/extend.t test EXTEND() macro
+ext/XS-APItest/t/die_unwinding.t Test PL_die_unwinding
ext/XS-APItest/t/fetch_pad_names.t Tests for UTF8 names in pad
ext/XS-APItest/t/get.t test get_sv et al.
ext/XS-APItest/t/gotosub.t XS::APItest: tests goto &xsub and hints
diff --git a/embedvar.h b/embedvar.h
index 5bd4a4ea9e..022425be64 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -119,6 +119,7 @@
#define PL_delaymagic_gid (vTHX->Idelaymagic_gid)
#define PL_delaymagic_uid (vTHX->Idelaymagic_uid)
#define PL_destroyhook (vTHX->Idestroyhook)
+#define PL_die_unwinding (vTHX->Idie_unwinding)
#define PL_diehook (vTHX->Idiehook)
#define PL_doswitches (vTHX->Idoswitches)
#define PL_dowarn (vTHX->Idowarn)
diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm
index 61531fc97a..12d331b246 100644
--- a/ext/XS-APItest/APItest.pm
+++ b/ext/XS-APItest/APItest.pm
@@ -5,7 +5,7 @@ use strict;
use warnings;
use Carp;
-our $VERSION = '0.99';
+our $VERSION = '1.99';
require XSLoader;
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index a30659f14f..5a86773184 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -1345,6 +1345,8 @@ my_ck_rv2cv(pTHX_ OP *o)
return old_ck_rv2cv(aTHX_ o);
}
+#define die_unwinding() (PL_die_unwinding)
+
#include "const-c.inc"
MODULE = XS::APItest PACKAGE = XS::APItest
@@ -1600,6 +1602,9 @@ tryAMAGICunDEREF_var(sv, what)
/* The reference is owned by something else. */
PUSHs(sv);
+IV
+die_unwinding()
+
MODULE = XS::APItest PACKAGE = XS::APItest::XSUB
BOOT:
diff --git a/ext/XS-APItest/t/die_unwinding.t b/ext/XS-APItest/t/die_unwinding.t
new file mode 100644
index 0000000000..5be18a312b
--- /dev/null
+++ b/ext/XS-APItest/t/die_unwinding.t
@@ -0,0 +1,75 @@
+#!perl
+use Test::More;
+use XS::APItest qw(die_unwinding);
+
+is(die_unwinding(), 0, "start zero");
+
+{
+ my $x = Foo->new(0, "should be zero on normal destruction");
+}
+
+{
+ eval {
+ my $x = Foo->new(1, "should be non-zero on die in eval");
+ die;
+ };
+}
+{
+ eval {
+ my $x = Foo->new(0, "should be zero on normal exit in eval");
+ };
+}
+
+{
+ eval {
+ my $y = Foo->new(1, "should be non-zero before");
+ our $x;
+ tie $x, 'TieDie';
+ local $x = 0;
+ my $z = Foo->new(1, "should be non-zero after");
+ };
+}
+
+is(die_unwinding(), 0, "finish zero");
+
+done_testing();
+
+package Foo;
+use Test::More;
+use XS::APItest qw(die_unwinding);
+
+sub new {
+ my ($class, $expect, $name) = @_;
+
+ bless [ $expect, $name ], $class;
+}
+
+sub DESTROY {
+ my ($expect, $name) = @{$_[0]};
+
+ if ($expect) {
+ isnt(die_unwinding(), 0, $name);
+ }
+ else {
+ is(die_unwinding(), 0, $name);
+ }
+}
+
+package TieDie;
+use parent 'Tie::Scalar';
+
+sub TIESCALAR {
+ my ($class) = @_;
+
+ bless \(my $x = 1), $class;
+}
+
+sub FETCH {
+ ${$_[0]};
+}
+
+sub STORE {
+ my ($self, $val) = @_;
+
+ die if $val;
+}
diff --git a/intrpvar.h b/intrpvar.h
index fad1eaafbb..23dd8a608b 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -817,6 +817,8 @@ PERLVARI(I, dump_re_max_len, STRLEN, 60)
PERLVAR(I, internal_random_state, PL_RANDOM_STATE_TYPE)
+PERLVARI(I, die_unwinding, IV, 0);
+
/* If you are adding a U8 or U16, check to see if there are 'Space' comments
* above on where there are gaps which currently will be structure padding. */
diff --git a/pp_ctl.c b/pp_ctl.c
index 17d4f0d14a..261a2b4f2a 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1614,6 +1614,27 @@ Perl_qerror(pTHX_ SV *err)
++PL_parser->error_count;
}
+static int
+S_die_unwinding_free(pTHX_ SV *sv, MAGIC *mg) {
+ PERL_UNUSED_ARG(sv);
+ PERL_UNUSED_ARG(mg);
+
+ --PL_die_unwinding;
+ return 0;
+}
+
+static const MGVTBL die_unwinding_vtbl =
+ {
+ NULL, /* svt_get */
+ NULL, /* svt_set */
+ NULL, /* svt_len */
+ NULL, /* svt_clear */
+ S_die_unwinding_free, /* svt_free */
+ NULL, /* svt_copy */
+ NULL, /* svt_dup */
+ NULL /* svt_local */
+ };
+
/* pop a CXt_EVAL context and in addition, if it was a require then
@@ -1629,6 +1650,12 @@ S_pop_eval_context_maybe_croak(pTHX_ PERL_CONTEXT *cx, SV *errsv, int action)
SV *namesv = NULL; /* init to avoid dumb compiler warning */
bool do_croak;
+ DEBUG_U( PerlIO_printf(PerlIO_stderr(), "action %d old op %d unwinding %d\n",
+ action, CxOLD_OP_TYPE(cx), (int)PL_die_unwinding); );
+ if (action) {
+ ++PL_die_unwinding;
+ sv_magicext(errsv, NULL, PERL_MAGIC_uvar, &die_unwinding_vtbl, NULL, 0);
+ }
CX_LEAVE_SCOPE(cx);
do_croak = action && (CxOLD_OP_TYPE(cx) == OP_REQUIRE);
if (do_croak) {
@@ -1728,6 +1755,9 @@ Perl_die_unwind(pTHX_ SV *msv)
SVfARG(exceptsv));
}
+ ++PL_die_unwinding;
+ sv_magicext(exceptsv, NULL, PERL_MAGIC_uvar, &die_unwinding_vtbl, NULL, 0);
+
while ((cxix = dopoptoeval(cxstack_ix)) < 0
&& PL_curstackinfo->si_prev)
{
diff --git a/sv.c b/sv.c
index 983646f335..5c3ddbaebe 100644
--- a/sv.c
+++ b/sv.c
@@ -15327,6 +15327,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
PL_delaymagic = proto_perl->Idelaymagic;
PL_phase = proto_perl->Iphase;
PL_localizing = proto_perl->Ilocalizing;
+ PL_die_unwinding = proto_perl->Idie_unwinding;
PL_hv_fetch_ent_mh = NULL;
PL_modcount = proto_perl->Imodcount;
--
2.11.0
|
From @ppisarOn 2018-11-22, "Tony Cook via RT" <perlbug-followup@perl.org> wrote:
[...]
Thank you for the patches, but this code calls argvout_final() that does not -- Petr |
From @tonycozOn Thu, Nov 22, 2018 at 08:21:10AM -0000, Petr Pisar wrote:
Oops, no, I missed including a patch. Attached. This belongs before the other two. Tony |
From @tonycoz0001-perl-133659-move-argvout-cleanup-to-a-new-function.patchFrom a5665f6892b6ac67d291465265ed2eeee887d7ea Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 20 Nov 2018 15:30:20 +1100
Subject: (perl #133659) move argvout cleanup to a new function
---
doio.c | 62 ++++++++++++++++++++++++++++++++++++++------------------------
embed.fnc | 1 +
embed.h | 1 +
proto.h | 3 +++
4 files changed, 43 insertions(+), 24 deletions(-)
diff --git a/doio.c b/doio.c
index 8d9131cc85..77421de1d1 100644
--- a/doio.c
+++ b/doio.c
@@ -1526,31 +1526,14 @@ S_dir_unchanged(pTHX_ const char *orig_pv, MAGIC *mg) {
#define dir_unchanged(orig_psv, mg) \
S_dir_unchanged(aTHX_ (orig_psv), (mg))
-/* explicit renamed to avoid C++ conflict -- kja */
-bool
-Perl_do_close(pTHX_ GV *gv, bool not_implicit)
-{
+STATIC bool
+S_argvout_final(pTHX_ MAGIC *mg, IO *io, bool not_implicit) {
bool retval;
- IO *io;
- MAGIC *mg;
- if (!gv)
- gv = PL_argvgv;
- if (!gv || !isGV_with_GP(gv)) {
- if (not_implicit)
- SETERRNO(EBADF,SS_IVCHAN);
- return FALSE;
- }
- io = GvIO(gv);
- if (!io) { /* never opened */
- if (not_implicit) {
- report_evil_fh(gv);
- SETERRNO(EBADF,SS_IVCHAN);
- }
- return FALSE;
- }
- if ((mg = mg_findext((SV*)io, PERL_MAGIC_uvar, &argvout_vtbl))
- && mg->mg_obj) {
+ /* ensure args are checked before we start using them */
+ PERL_ARGS_ASSERT_ARGVOUT_FINAL;
+
+ {
/* handle to an in-place edit work file */
SV **back_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_BACKUP_NAME, FALSE);
SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
@@ -1717,7 +1700,38 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
SvPVX(*temp_psv), Strerror(errno));
}
}
- freext:
+ freext:
+ ;
+ }
+ return retval;
+}
+
+/* explicit renamed to avoid C++ conflict -- kja */
+bool
+Perl_do_close(pTHX_ GV *gv, bool not_implicit)
+{
+ bool retval;
+ IO *io;
+ MAGIC *mg;
+
+ if (!gv)
+ gv = PL_argvgv;
+ if (!gv || !isGV_with_GP(gv)) {
+ if (not_implicit)
+ SETERRNO(EBADF,SS_IVCHAN);
+ return FALSE;
+ }
+ io = GvIO(gv);
+ if (!io) { /* never opened */
+ if (not_implicit) {
+ report_evil_fh(gv);
+ SETERRNO(EBADF,SS_IVCHAN);
+ }
+ return FALSE;
+ }
+ if ((mg = mg_findext((SV*)io, PERL_MAGIC_uvar, &argvout_vtbl))
+ && mg->mg_obj) {
+ retval = argvout_final(mg, io, not_implicit);
mg_freeext((SV*)io, PERL_MAGIC_uvar, &argvout_vtbl);
}
else {
diff --git a/embed.fnc b/embed.fnc
index 2ed2cc32b9..408917e0a7 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -440,6 +440,7 @@ p |bool|do_exec3 |NN const char *incmd|int fd|int do_report
#endif
#if defined(PERL_IN_DOIO_C)
s |void |exec_failed |NN const char *cmd|int fd|int do_report
+s |bool |argvout_final |NN MAGIC *mg|NN IO *io|bool not_implicit
#endif
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
: Defined in doio.c, used only in pp_sys.c
diff --git a/embed.h b/embed.h
index 4cc97126bd..ffa5b1d581 100644
--- a/embed.h
+++ b/embed.h
@@ -1755,6 +1755,7 @@
#define deb_stack_n(a,b,c,d,e) S_deb_stack_n(aTHX_ a,b,c,d,e)
# endif
# if defined(PERL_IN_DOIO_C)
+#define argvout_final(a,b,c) S_argvout_final(aTHX_ a,b,c)
#define exec_failed(a,b,c) S_exec_failed(aTHX_ a,b,c)
#define ingroup(a,b) S_ingroup(aTHX_ a,b)
#define openn_cleanup(a,b,c,d,e,f,g,h,i,j,k,l,m) S_openn_cleanup(aTHX_ a,b,c,d,e,f,g,h,i,j,k,l,m)
diff --git a/proto.h b/proto.h
index e57df2f206..061a9d72a0 100644
--- a/proto.h
+++ b/proto.h
@@ -4752,6 +4752,9 @@ STATIC void S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, I
assert(stack_base)
#endif
#if defined(PERL_IN_DOIO_C)
+STATIC bool S_argvout_final(pTHX_ MAGIC *mg, IO *io, bool not_implicit);
+#define PERL_ARGS_ASSERT_ARGVOUT_FINAL \
+ assert(mg); assert(io)
STATIC void S_exec_failed(pTHX_ const char *cmd, int fd, int do_report);
#define PERL_ARGS_ASSERT_EXEC_FAILED \
assert(cmd)
--
2.11.0
|
From @ppisarOn 2018-11-22, Tony Cook <tony@develop-help.com> wrote:
That helped. I confirm that the tree patches: (perl #133659) tests for global destruction handling of inplace editing fix the trivial edit and that all Perl tests pass. -- Petr |
From @jkeenanThe original poster, Domibay - Hugo <hugo@domibay.org>, posted 3 Hi, Thank you for taking the time to look into this case. I executed your code and it worked fine at first. package Family; $self->baseMethod; So the expected output would be: We basically say Hello World To illustrate the intended functionality of the derived "Family::Child" package Family::Child; so the intented functionality should display this output: We basically say Hello World I found there is no way to achieve this in a streamlined development You can find more information about Object-oriented Design Patterns at Please, have also a look on this Talk about "Upcasting" and "Downcasting" As referring to additional Documentation about expected behaviour As the author of the Package "Family" would expect that any object # 2
So after adding the "Family::baseMethod" feature to the Method Deep recursion on subroutine "Family::Child::baseMethod" at Family.pm And my computer blocked with high workload until finally I was able to Certainly the Perl Engine found the code in "Family::extendedMethod" $self->baseMethod; and understood "$self" as "Family::Child" and started to execute # 3
This affects especially Packages published for third parties by authors And it limits the Polymorphism Capability of all derived Classes since |
From @jkeenanPlease ignore the previous post in #133659 (5.28.0 regression: In-place edit without .... It was posted to the wrong thread. |
From @tonycozOn Thu, 22 Nov 2018 03:26:07 -0800, ppisar wrote:
Applied as 404395d, 640e129 and 85d2f7c. Leaving this open as the more general issue isn't solved. Tony |
From @jmdhOn Sun, 25 Nov 2018 19:23:34 -0800, tonyc wrote:
Thanks. FTR, this was also reported in Debian as I think this should be proposed for a stable release since it's a regression (even if the whole issue isn't fixed, the use case reported by the OP is). So maybe that is a reason to split the more general issue into a new ticket and mark this one as blocking 5.28.x? Or do you think that it would be harmful/confusing to apply just the partial fix? (My motivation for asking the question: I'd like to fix the simple case in Debian since it is affecting our users). Cheers, |
From @tonycozOn Mon, 26 Nov 2018 04:54:56 -0800, dom wrote:
I've split the unfixed behaviour into https://rt-archive.perl.org/perl5/Ticket/Display.html?id=133709 I've proposed the changes for backporting in: https://perl5.git.perl.org/perl.git/commit/39fda5e8d93f00ab7ec77a2f35074c0aceb28c1e and marking this as resolved. Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
From @jmdhOn Mon, 03 Dec 2018 15:09:22 -0800, tonyc wrote:
Thanks! For the record, I have cherry-picked the three commits onto Debian's 5.28.1 which should be uploaded to unstable in the next few days. |
From [Unknown Contact. See original ticket]On Mon, 03 Dec 2018 15:09:22 -0800, tonyc wrote:
Thanks! For the record, I have cherry-picked the three commits onto Debian's 5.28.1 which should be uploaded to unstable in the next few days. |
From @steve-m-hayOn Fri, 07 Dec 2018 04:57:37 -0800, dom wrote:
Now cherry-picked into maint-5.28 for 5.28.1. The original report at the top of this ticket noted that the POD needed updating too. |
From @steve-m-hayOn Wed, 09 Jan 2019 10:09:16 -0800, shay wrote:
Oops! That should have been 5.28.2. |
From @khwilliamsonThank you for filing this report. You have helped make Perl better. With the release today of Perl 5.30.0, this and 160 other issues have been Perl 5.30.0 may be downloaded via: If you find that the problem persists, feel free to reopen this ticket. |
|
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#133659 (status was 'resolved')
Searchable as RT133659$
The text was updated successfully, but these errors were encountered: