Skip Menu |
Report information
Id: 133659
Status: pending release
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: peff [at] peff.net
ppisar <ppisar [at] redhat.com>
Cc:
AdminCc:

Operating System: (no value)
PatchStatus: (no value)
Severity: low
Type: unknown
Perl Version: (no value)
Fixed In: (no value)



To: perlbug [...] perl.org
From: Petr Pisar <ppisar [...] redhat.com>
Date: Thu, 15 Nov 2018 12:42:18 +0100
Subject: 5.28.0 regression: In-place edit without "while(<>)" does not replace files
Hello, I'm forwarding a bug report <https://bugzilla.redhat.com/show_bug.cgi?id=1650041> about a regression in in-place edits first seen in perl 5.28.0: If perl is asked for an in-place edit with an "-i" option and the Perl code does not use "while(<>){...}" idiom, the output file is deleted instead of renamed back to the input file name: $ cat test 1 $ strace perl -i -e '$/=undef; $a=<>; $a=~s/1/2/; print $a' test [...] openat(AT_FDCWD, "test", O_RDONLY|O_CLOEXEC) = 3 ioctl(3, TCGETS, 0x7ffeb193f510) = -1 ENOTTY (Inappropriate ioctl for device) lseek(3, 0, SEEK_CUR) = 0 fstat(3, {st_mode=S_IFREG|0664, st_size=2, ...}) = 0 umask(0177) = 002 getpid() = 1192 openat(AT_FDCWD, "XXH6qplJ", O_RDWR|O_CREAT|O_EXCL|O_CLOEXEC, 0600) = 4 fcntl(4, F_GETFD) = 0x1 (flags FD_CLOEXEC) umask(002) = 0177 fcntl(4, F_SETFD, FD_CLOEXEC) = 0 ioctl(4, TCGETS, 0x7ffeb193f5a0) = -1 ENOTTY (Inappropriate ioctl for device) lseek(4, 0, SEEK_CUR) = 0 fstat(4, {st_mode=S_IFREG|0600, st_size=0, ...}) = 0 getpid() = 1192 openat(AT_FDCWD, ".", O_RDONLY|O_NONBLOCK|O_CLOEXEC|O_DIRECTORY) = 5 fstat(5, {st_mode=S_IFDIR|S_ISVTX|0777, st_size=180, ...}) = 0 brk(NULL) = 0x55f03b859000 brk(0x55f03b87b000) = 0x55f03b87b000 fstat(4, {st_mode=S_IFREG|0600, st_size=0, ...}) = 0 fchmod(4, 0100664) = 0 fstat(3, {st_mode=S_IFREG|0664, st_size=2, ...}) = 0 read(3, "1\n", 8192) = 2 read(3, "", 8192) = 0 [...] write(4, "2\n", 2) = 2 close(3) = 0 getpid() = 1192 close(4) = 0 unlinkat(5, "XXH6qplJ", 0) = 0 [...] close(5) = 0 exit_group(0) = ? Expected behvior is that the "test" file ends up with "2\n" inside. As you can see in ther strace output, the output file was unlinked instead of renamed from "XXH6qplJ" to "test". I can reproduce it with 5.28.0 as well as with latest blead v5.29.4-43-ged0ccc61a6. The example works with 5.26.2. 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 rename. I believe this regression comes with the more secure file replacement introduced in 5.28.0. By the way, perlrun POD setion for "-i" option seems out-dated as it still reads: [...] It does this by renaming the input file, opening the output file by the original name, and selecting that output file as the default for print() statements. While the 5.28.0 code first creates a temporary file, write an output there and then renames it back to the original name. -- Petr
Download signature.asc
application/pgp-signature 228b

Message body not shown because it is not plain text.

RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 906b
On Thu, 15 Nov 2018 11:42:26 GMT, ppisar wrote: Show quoted text
> Hello, > > I'm forwarding a bug report > <https://bugzilla.redhat.com/show_bug.cgi?id=1650041> about a > regression in > in-place edits first seen in perl 5.28.0: > > If perl is asked for an in-place edit with an "-i" option and the Perl > code > does not use "while(<>){...}" idiom, the output file is deleted > instead of > renamed back to the input file name: >
[snip] Show quoted text
> > 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 >
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. -- James E Keenan (jkeenan@cpan.org)
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.8k
On Thu, 15 Nov 2018 03:42:26 -0800, ppisar wrote: Show quoted text
> Expected behvior is that the "test" file ends up with "2\n" inside. As > you can > see in ther strace output, the output file was unlinked instead of > renamed > from "XXH6qplJ" to "test". > > I can reproduce it with 5.28.0 as well as with latest blead > v5.29.4-43-ged0ccc61a6. The example works with 5.26.2. > > 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 > rename. I believe this regression comes with the more secure file > replacement > introduced in 5.28.0.
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. Show quoted text
> By the way, perlrun POD setion for "-i" option seems out-dated as it > still > reads: > > [...] It does this by renaming the input file, opening > the output file by the original name, and selecting that output > file as the default for print() statements. > > While the 5.28.0 code first creates a temporary file, write an output > there > and then renames it back to the original name.
Yes, this needs to be updated. Tony
From: Petr Pisar <ppisar [...] redhat.com>
Subject: Re: [perl #133659] 5.28.0 regression: In-place edit without "while(<>)" does not replace files
Date: 16 Nov 2018 09:55:58 -0000
To: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.2k
On 2018-11-15, "James E Keenan via RT" <perlbug-followup@perl.org> wrote: Show quoted text
>> 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 >>
> > 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'. >
I finished bisecting now (using my own scripts) and it converged to this commit (v5.27.3-66-ge0d4aead3c): commit e0d4aead3c87ba953fb1d70678a77a45e0c9f111 (HEAD, refs/bisect/bad) Author: Tony Cook <tony@develop-help.com> Date: Wed Jan 11 14:49:53 2017 +1100 (perl #127663) safer in-place editing Previously in-place editing opened the file then immediately *replaced* the file, so if an error occurs while writing the output, such as running out of space, the content of the original file is lost. This changes in-place editing to write to a work file which is renamed over the original only once the output file is successfully closed. It also fixes an issue with setting setuid/setgid file modes for recursive in-place editing. -- Petr
Date: 16 Nov 2018 10:44:01 -0000
Subject: Re: [perl #133659] 5.28.0 regression: In-place edit without "while(<>)" does not replace files
From: Petr Pisar <ppisar [...] redhat.com>
To: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.7k
On 2018-11-15, "Tony Cook via RT" <perlbug-followup@perl.org> wrote: Show quoted text
> 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? >
In my opinion, the file should be kept intact if the interpreter is going to terminate because of an error (die, exit 1, an I/O failure). That's the point of <https://rt.perl.org/Public/Bug/Display.html?id=57512#txn-673862> (still not fully resolved). However, I can image that a multiple file edit cannot have a correct behavior: $ perl -i -pe 's/FAILED/OK/ or die' somefile anotherfile because if somefile edits and replaces successfully but editing anotherfile fails, perl as a whole command will return an error exit code but somefile will have been already mangled. (I know perl is not a transactional database system.) We would have to postpone the file rename after processing all arguments and that could exhaust open file descriptors and disk space. I don't think it's feasible to take the multiple file usecase seriously. Show quoted text
> 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. >
Can we decide on $@ value? Or better on some flag that instructs perl process to return a non-zero exit code? Show quoted text
> As a workaround you can explicitly close ARGVOUT: > > ./perl -i -e 'local $/; my $s=<>; $s=~s/FAILED/OK/; print $s; close ARGVOUT' >
Yes, the explicit close helps here. -- Petr
CC: Tony Cook <tony [...] develop-help.com>
From: Jeff King <peff [...] peff.net>
Subject: in-place editing no longer works with "last"
Date: Mon, 19 Nov 2018 15:16:34 -0500
To: perlbug [...] perl.org
Download (untitled) / with headers
text/plain 10.5k
This is a bug report for perl from peff@peff.net, generated with the help of perlbug 1.41 running under perl 5.28.0. ----------------------------------------------------------------- [Please describe your issue here] In perl 5.26.0 and earlier, using "-i" would modify the file even if you left a "-p" loop early. E.g.: $ echo foo >file $ perl -i -pe 'last' file $ cat file [no output; we left the loop before printing anything] But in 5.28.0, the file is left untouched: $ cat file foo This bisects in the perl-git mirror to e0d4aead3c ((perl #127663) safer in-place editing, 2017-01-11), and reproduces even on the current tip of that mirror's master branch. The above code is obviously a toy example to reproduce the issue. If you want a more real-world case, the script I noticed this in was printing the first non-comment line in a file: perl -i -ne 'print && exit 0 if /^[^#]/' $file [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=medium --- Site configuration information for perl 5.28.0: Configured by Debian at Wed Oct 31 15:45:10 UTC 2018. Summary of my perl5 (revision 5 version 28 subversion 0) configuration: Platform: osname=linux osvers=4.9.0 archname=x86_64-linux-gnu-thread-multi uname='linux localhost 4.9.0 #1 smp debian 4.9.0 x86_64 gnulinux ' config_args='-Dusethreads -Duselargefiles -Dcc=x86_64-linux-gnu-gcc -Dcpp=x86_64-linux-gnu-cpp -Dld=x86_64-linux-gnu-gcc -Dccflags=-DDEBIAN -Wdate-time -D_FORTIFY_SOURCE=2 -g -O2 -fdebug-prefix-map=/build/perl-wsSTqO/perl-5.28.0=. -fstack-protector-strong -Wformat -Werror=format-security -Dldflags= -Wl,-z,relro -Dlddlflags=-shared -Wl,-z,relro -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.28 -Darchlib=/usr/lib/x86_64-linux-gnu/perl/5.28 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/x86_64-linux-gnu/perl5/5.28 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.28.0 -Dsitearch=/usr/local/lib/x86_64-linux-gnu/perl/5.28.0 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Duse64bitint -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -Ui_libutil -Ui_xlocale -Uversiononly -DDEBUGGING=-g -Doptimize=-O2 -dEs -Duseshrplib -Dlibperl=libperl.so.5.28.0' hint=recommended useposix=true d_sigaction=define useithreads=define usemultiplicity=define use64bitint=define use64bitall=define uselongdouble=undef usemymalloc=n default_inc_excludes_dot=define bincompat5005=undef Compiler: cc='x86_64-linux-gnu-gcc' ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' optimize='-O2 -g' cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include' ccversion='' gccversion='8.2.0' gccosandvers='' intsize=4 longsize=8 ptrsize=8 doublesize=8 byteorder=12345678 doublekind=3 d_longlong=define longlongsize=8 d_longdbl=define longdblsize=16 longdblkind=3 ivtype='long' ivsize=8 nvtype='double' nvsize=8 Off_t='off_t' lseeksize=8 alignbytes=8 prototype=define Linker and Libraries: ld='x86_64-linux-gnu-gcc' ldflags =' -fstack-protector-strong -L/usr/local/lib' libpth=/usr/local/lib /usr/lib/gcc/x86_64-linux-gnu/8/include-fixed /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt perllibs=-ldl -lm -lpthread -lc -lcrypt libc=libc-2.27.so so=so useshrplib=true libperl=libperl.so.5.28 gnulibc_version='2.27' Dynamic Linking: dlsrc=dl_dlopen.xs dlext=so d_dlsymun=undef ccdlflags='-Wl,-E' cccdlflags='-fPIC' lddlflags='-shared -L/usr/local/lib -fstack-protector-strong' Locally applied patches: DEBPKG:debian/cpan_definstalldirs - Provide a sensible INSTALLDIRS default for modules installed from CPAN. DEBPKG:debian/db_file_ver - https://bugs.debian.org/340047 Remove overly restrictive DB_File version check. DEBPKG:debian/doc_info - Replace generic man(1) instructions with Debian-specific information. DEBPKG:debian/enc2xs_inc - https://bugs.debian.org/290336 Tweak enc2xs to follow symlinks and ignore missing @INC directories. DEBPKG:debian/errno_ver - https://bugs.debian.org/343351 Remove Errno version check due to upgrade problems with long-running processes. DEBPKG:debian/libperl_embed_doc - https://bugs.debian.org/186778 Note that libperl-dev package is required for embedded linking DEBPKG:fixes/respect_umask - Respect umask during installation DEBPKG:debian/writable_site_dirs - Set umask approproately for site install directories DEBPKG:debian/extutils_set_libperl_path - EU:MM: set location of libperl.a under /usr/lib DEBPKG:debian/no_packlist_perllocal - Don't install .packlist or perllocal.pod for perl or vendor DEBPKG:debian/fakeroot - Postpone LD_LIBRARY_PATH evaluation to the binary targets. DEBPKG:debian/instmodsh_doc - Debian policy doesn't install .packlist files for core or vendor. DEBPKG:debian/ld_run_path - Remove standard libs from LD_RUN_PATH as per Debian policy. DEBPKG:debian/libnet_config_path - Set location of libnet.cfg to /etc/perl/Net as /usr may not be writable. DEBPKG:debian/perlivp - https://bugs.debian.org/510895 Make perlivp skip include directories in /usr/local DEBPKG:debian/squelch-locale-warnings - https://bugs.debian.org/508764 Squelch locale warnings in Debian package maintainer scripts DEBPKG:debian/patchlevel - https://bugs.debian.org/567489 List packaged patches for 5.28.0-3 in patchlevel.h DEBPKG:fixes/document_makemaker_ccflags - https://bugs.debian.org/628522 [rt.cpan.org #68613] Document that CCFLAGS should include $Config{ccflags} DEBPKG:debian/find_html2text - https://bugs.debian.org/640479 Configure CPAN::Distribution with correct name of html2text DEBPKG:debian/perl5db-x-terminal-emulator.patch - https://bugs.debian.org/668490 Invoke x-terminal-emulator rather than xterm in perl5db.pl DEBPKG:debian/cpan-missing-site-dirs - https://bugs.debian.org/688842 Fix CPAN::FirstTime defaults with nonexisting site dirs if a parent is writable DEBPKG:fixes/memoize_storable_nstore - [rt.cpan.org #77790] https://bugs.debian.org/587650 Memoize::Storable: respect 'nstore' option not respected DEBPKG:debian/makemaker-pasthru - https://bugs.debian.org/758471 Pass LD settings through to subdirectories DEBPKG:debian/makemaker-manext - https://bugs.debian.org/247370 Make EU::MakeMaker honour MANnEXT settings in generated manpage headers DEBPKG:debian/kfreebsd-softupdates - https://bugs.debian.org/796798 Work around Debian Bug#796798 DEBPKG:fixes/autodie-scope - https://bugs.debian.org/798096 Fix a scoping issue with "no autodie" and the "system" sub DEBPKG:fixes/memoize-pod - [rt.cpan.org #89441] Fix POD errors in Memoize DEBPKG:debian/hurd-softupdates - https://bugs.debian.org/822735 Fix t/op/stat.t failures on hurd DEBPKG:fixes/math_complex_doc_great_circle - https://bugs.debian.org/697567 [rt.cpan.org #114104] Math::Trig: clarify definition of great_circle_midpoint DEBPKG:fixes/math_complex_doc_see_also - https://bugs.debian.org/697568 [rt.cpan.org #114105] Math::Trig: add missing SEE ALSO DEBPKG:fixes/math_complex_doc_angle_units - https://bugs.debian.org/731505 [rt.cpan.org #114106] Math::Trig: document angle units DEBPKG:fixes/cpan_web_link - https://bugs.debian.org/367291 CPAN: Add link to main CPAN web site DEBPKG:debian/hppa_op_optimize_workaround - https://bugs.debian.org/838613 Temporarily lower the optimization of op.c on hppa due to gcc-6 problems DEBPKG:debian/installman-utf8 - https://bugs.debian.org/840211 Generate man pages with UTF-8 characters DEBPKG:fixes/getopt-long-4 - https://bugs.debian.org/864544 [rt.cpan.org #122068] Fix issue #122068. DEBPKG:debian/hppa_opmini_optimize_workaround - https://bugs.debian.org/869122 Lower the optimization level of opmini.c on hppa DEBPKG:debian/sh4_op_optimize_workaround - https://bugs.debian.org/869373 Also lower the optimization level of op.c and opmini.c on sh4 DEBPKG:debian/perldoc-pager - https://bugs.debian.org/870340 [rt.cpan.org #120229] Fix perldoc terminal escapes when sensible-pager is less DEBPKG:debian/prune_libs - https://bugs.debian.org/128355 Prune the list of libraries wanted to what we actually need. DEBPKG:debian/mod_paths - Tweak @INC ordering for Debian DEBPKG:debian/configure-regen - https://bugs.debian.org/762638 Regenerate Configure et al. after probe unit changes DEBPKG:debian/deprecate-with-apt - https://bugs.debian.org/747628 Point users to Debian packages of deprecated core modules DEBPKG:debian/disable-stack-check - https://bugs.debian.org/902779 [perl #133327] Disable debugperl stack extension checks for binary compatibility with perl DEBPKG:fixes/in-place-edit-handles - https://bugs.debian.org/902925 [perl #133314] (perl #133314) always close the directory handle on clean up DEBPKG:debian/gdbm-fatal - [perl #133295] https://bugs.debian.org/904005 Temporarily skip GDBM_File fatal.t for gdbm >= 1.15 compatibility --- @INC for perl 5.28.0: /home/peff/local/git/current/share/perl /home/peff/local/share/perl/5.28.0 /home/peff/local/share/perl /home/peff/local/lib/perl5/site_perl /home/peff/local/lib/perl/5.28.0 /home/peff/local/lib/perl /home/peff/local/lib /etc/perl /usr/local/lib/x86_64-linux-gnu/perl/5.28.0 /usr/local/share/perl/5.28.0 /usr/lib/x86_64-linux-gnu/perl5/5.28 /usr/share/perl5 /usr/lib/x86_64-linux-gnu/perl/5.28 /usr/share/perl/5.28 /usr/local/lib/site_perl /usr/lib/x86_64-linux-gnu/perl-base --- Environment for perl 5.28.0: HOME=/home/peff LANG=en_US.UTF-8 LANGUAGE (unset) LC_COLLATE=C LD_LIBRARY_PATH= LOGDIR (unset) PATH=/home/peff/.bin:/home/peff/local/bin:/home/peff/local/git/current/bin:/usr/local/bin:/usr/bin:/bin:/usr/games:/home/peff/compile/node/node-v8.9.3-linux-x64/bin:/usr/local/sbin:/sbin:/usr/sbin:/home/peff/compile/gh/shell/bin:/home/peff/work/mmake/bin:/home/peff/.rvm/bin PERL5LIB=/home/peff/local/git/current/share/perl:/home/peff/local/share/perl:/home/peff/local/lib/perl5/site_perl:/home/peff/local/lib/perl:/home/peff/local/lib PERL_BADLANG (unset) SHELL=/bin/bash
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.2k
On Mon, 19 Nov 2018 20:23:24 GMT, peff@peff.net wrote: Show quoted text
> This is a bug report for perl from peff@peff.net, > generated with the help of perlbug 1.41 running under perl 5.28.0. > > ----------------------------------------------------------------- > [Please describe your issue here] > > In perl 5.26.0 and earlier, using "-i" would modify the file even if > you > left a "-p" loop early. E.g.: > > $ echo foo >file > $ perl -i -pe 'last' file > $ cat file > [no output; we left the loop before printing anything] > > But in 5.28.0, the file is left untouched: > > $ cat file > foo > > This bisects in the perl-git mirror to e0d4aead3c ((perl #127663) > safer > in-place editing, 2017-01-11), and reproduces even on the current tip > of > that mirror's master branch. > > The above code is obviously a toy example to reproduce the issue. If > you > want a more real-world case, the script I noticed this in was printing > the first non-comment line in a file: > > perl -i -ne 'print && exit 0 if /^[^#]/' $file >
This seems very similar to another recent report: https://rt.perl.org/Ticket/Display.html?id=133659 TonyC, p5p list: Could you take a look at both? Thank you very much. -- James E Keenan (jkeenan@cpan.org)
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 831b
On Mon, 19 Nov 2018 12:23:24 -0800, peff@peff.net wrote: Show quoted text
> In perl 5.26.0 and earlier, using "-i" would modify the file even if > you > left a "-p" loop early. E.g.: > > $ echo foo >file > $ perl -i -pe 'last' file > $ cat file > [no output; we left the loop before printing anything] > > But in 5.28.0, the file is left untouched: > > $ cat file > foo > > This bisects in the perl-git mirror to e0d4aead3c ((perl #127663) > safer > in-place editing, 2017-01-11), and reproduces even on the current tip > of > that mirror's master branch. > > The above code is obviously a toy example to reproduce the issue. If > you > want a more real-world case, the script I noticed this in was printing > the first non-comment line in a file: > > perl -i -ne 'print && exit 0 if /^[^#]/' $file
This is the same as 133659, merging. Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 2.4k
On Fri, 16 Nov 2018 02:44:10 -0800, ppisar wrote: Show quoted text
> On 2018-11-15, "Tony Cook via RT" <perlbug-followup@perl.org> 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? > >
> In my opinion, the file should be kept intact if the interpreter is > going to terminate because of an error (die, exit 1, an I/O failure). > That's the point of > <https://rt.perl.org/Public/Bug/Display.html?id=57512#txn-673862> > (still > not fully resolved). > > However, I can image that a multiple file edit cannot have a correct > behavior: > > $ perl -i -pe 's/FAILED/OK/ or die' somefile anotherfile > > because if somefile edits and replaces successfully but editing > anotherfile fails, perl as a whole command will return an error exit > code but somefile will have been already mangled. (I know perl is not > a transactional database system.) We would have to postpone the file > rename after processing all arguments and that could exhaust open file > descriptors and disk space. I don't think it's feasible to take the > multiple file usecase seriously. >
> > 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. > >
> Can we decide on $@ value? Or better on some flag that instructs perl > process to return a non-zero exit code?
$@ 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 perl -i -pe 's/FAILED/OK/ or exit 1' somefile *wouldn't* replace the file, but all of: perl -i -ne 'last' somefile perl -i -ne 'exit' somefile *would* replace the file. Unfortunately non-trivial code that uses in-place editing will still have problems: sub foo { local (*ARGV, *ARGVOUT); @ARGV = @_; my $d = do { local $/; <> }; $d =~ s/FAILED/OK/; print $d; die; } eval { foo("somefile") }; at the point where ARGVOUT is cleaned up we aren't in global destruction, so the file isn't replaced. Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 559b
On Mon, 19 Nov 2018 16:31:12 -0800, tonyc wrote: Show quoted text
> Unfortunately non-trivial code that uses in-place editing will still > have problems: > > sub foo { > local (*ARGV, *ARGVOUT); > @ARGV = @_; > my $d = do { local $/; <> }; > $d =~ s/FAILED/OK/; > print $d; > die; > } > > eval { foo("somefile") }; > > at the point where ARGVOUT is cleaned up we aren't in global > destruction, so the file isn't replaced.
Oops, the input file *is* replaced. The attached does the simple version of the check, but doesn't handle the more complex case. Tony
Subject: 0001-perl-133659-tests-for-global-destruction-handling-of.patch
From 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
Subject: 0002-perl-133659-make-an-in-place-edit-successful-if-the-.patch
From 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
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 373b
On Wed, 21 Nov 2018 19:15:41 -0800, tonyc wrote: Show quoted text
> The attached does the simple version of the check, but doesn't handle > the more complex case.
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
Subject: 0003-DON-T-APPLY-THIS.patch
From 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: Petr Pisar <ppisar [...] redhat.com>
Subject: Re: [perl #133659] 5.28.0 regression: In-place edit without "while(<>)" does not replace files
Date: 22 Nov 2018 08:21:10 -0000
To: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.4k
On 2018-11-22, "Tony Cook via RT" <perlbug-followup@perl.org> wrote: Show quoted text
> The attached does the simple version of the check, but doesn't handle the more complex case. >
[...] Show quoted text
> From 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);
Thank you for the patches, but this code calls argvout_final() that does not exist anywhere in the Perl sources. Maybe you forgot to add the new function to the patch? -- Petr
CC: perl5-porters [...] perl.org
Subject: Re: [perl #133659] 5.28.0 regression: In-place edit without "while(<>)" does not replace files
Date: Thu, 22 Nov 2018 22:06:59 +1100
From: Tony Cook <tony [...] develop-help.com>
To: Petr Pisar <ppisar [...] redhat.com>
Download (untitled) / with headers
text/plain 326b
On Thu, Nov 22, 2018 at 08:21:10AM -0000, Petr Pisar wrote: Show quoted text
> Thank you for the patches, but this code calls argvout_final() that does not > exist anywhere in the Perl sources. Maybe you forgot to add the new function > to the patch?
Oops, no, I missed including a patch. Attached. This belongs before the other two. Tony

Message body is not shown because sender requested not to inline it.

To: perl5-porters [...] perl.org
Subject: Re: [perl #133659] 5.28.0 regression: In-place edit without "while(<>)" does not replace files
Date: 22 Nov 2018 11:25:56 -0000
From: Petr Pisar <ppisar [...] redhat.com>
Download (untitled) / with headers
text/plain 799b
On 2018-11-22, Tony Cook <tony@develop-help.com> wrote: Show quoted text
> --q7ufeuufo5kv7m4x > Content-Type: text/plain; charset=us-ascii > Content-Disposition: inline > > On Thu, Nov 22, 2018 at 08:21:10AM -0000, Petr Pisar wrote:
>> Thank you for the patches, but this code calls argvout_final() that does not >> exist anywhere in the Perl sources. Maybe you forgot to add the new function >> to the patch?
> > Oops, no, I missed including a patch. > > Attached. > > This belongs before the other two. >
That helped. I confirm that the tree patches: (perl #133659) tests for global destruction handling of inplace editing (perl #133659) move argvout cleanup to a new function (perl #133659) make an in-place edit successful if the exit status is zero fix the trivial edit and that all Perl tests pass. -- Petr
From: James E Keenan <jkeenan [...] pobox.com>
Date: Thu, 22 Nov 2018 08:47:01 -0500
Subject: Re: [perl #133671] in-place editing no longer works with "last"
To: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 3.4k
The original poster, Domibay - Hugo <hugo@domibay.org>, posted 3 additional comments which made it to RT but which we're not cc-ed to perl5-porters, so I'm including them here. --jkeenan #1 Hi, Thank you for taking the time to look into this case. I executed your code and it worked fine at first. But then I found that the Method "Family::extendedMethod" was missing a feature where it would execute the "Family::baseMethod" package Family; sub extendedMethod { my $self = $_[0]; $self->baseMethod; print "We extend a hearty greeting\n"; } So the expected output would be: We basically say Hello World We extend a hearty greeting To illustrate the intended functionality of the derived "Family::Child" Package I add this code to "Family::Child::baseMethod" package Family::Child; sub baseMethod { my $self = $_[0]; $self->extendedMethod(); print "and the Child chuckles.\n"; } so the intented functionality should display this output: We basically say Hello World We extend a hearty greeting and the Child chuckles. I found there is no way to achieve this in a streamlined development without changing the Parent "Family" Package or overriding the "Family::extendedMethod" Method with a copy and paste of its code. You can find more information about Object-oriented Design Patterns at https://en.wikipedia.org/wiki/Inheritance_(object-oriented_programming)#Visibility_of_inherited_members https://en.wikipedia.org/wiki/Law_of_Demeter#In_object-oriented_programming Please, have also a look on this Talk about "Upcasting" and "Downcasting" http://www.cs.utexas.edu/~cannata/cs345/Class%20Notes/14%20Java%20Upcasting%20Downcasting.htm As referring to additional Documentation about expected behaviour I point also to "Coercions" https://en.wikipedia.org/wiki/Subtyping#Coercions https://en.wikibooks.org/wiki/Computer_Programming/Type_conversion#Implicit_type_conversion As the author of the Package "Family" would expect that any object passed to a Method of "Family" would be coerced into an object of "Family" to guarantee the coherence of the "Family" Class functionality. # 2 Show quoted text
> package Family; > sub extendedMethod { > my $self = $_[0]; > > $self->baseMethod; > print "We extend a hearty greeting\n"; > }
So after adding the "Family::baseMethod" feature to the Method "Family::extendedMethod" on executing I got the warning: Deep recursion on subroutine "Family::Child::baseMethod" at Family.pm line 18. Deep recursion on subroutine "Family::extendedMethod" at Family.pm line 29. And my computer blocked with high workload until finally I was able to kill the Process. Certainly the Perl Engine found the code in "Family::extendedMethod" $self->baseMethod; and understood "$self" as "Family::Child" and started to execute "Family::Child::baseMethod" without taking into consideration that "$self" in "Family::extendedMethod" stands in the context of "Family" and is expected to execute "Family::baseMethod". # 3 Show quoted text
> As the author of the Package "Family" would expect that any object > passed to a Method of "Family" would be coerced into an object of > "Family" to guarantee the coherence of the "Family" Class > functionality.
This affects especially Packages published for third parties by authors on CPAN perhaps which are meant to be derived. And it limits the Polymorphism Capability of all derived Classes since authors of derived "Family::Child" and "Family::Child::Grandchild" Classes must be aware of the "Family" inner implementation to avoid fatal collisions.
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 128b
Please ignore the previous post in #133659 (5.28.0 regression: In-place edit without .... It was posted to the wrong thread.
RT-Send-CC: perl5-porters [...] perl.org
On Thu, 22 Nov 2018 03:26:07 -0800, ppisar wrote: Show quoted text
> On 2018-11-22, Tony Cook <tony@develop-help.com> wrote:
> > --q7ufeuufo5kv7m4x > > Content-Type: text/plain; charset=us-ascii > > Content-Disposition: inline > > > > On Thu, Nov 22, 2018 at 08:21:10AM -0000, Petr Pisar wrote:
> >> Thank you for the patches, but this code calls argvout_final() that > >> does not > >> exist anywhere in the Perl sources. Maybe you forgot to add the new > >> function > >> to the patch?
> > > > Oops, no, I missed including a patch. > > > > Attached. > > > > This belongs before the other two. > >
> That helped. I confirm that the tree patches: > > (perl #133659) tests for global destruction handling of inplace > editing > (perl #133659) move argvout cleanup to a new function > (perl #133659) make an in-place edit successful if the exit status is > zero > > fix the trivial edit and that all Perl tests pass.
Applied as 404395d24bc87890c7d978622296b9925a347aa0, 640e129d0fc499d24a759cacae9240a32c66fa51 and 85d2f7cacba4b0088ae0c67cc6d4c9b7495355c0. Leaving this open as the more general issue isn't solved. Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.7k
On Sun, 25 Nov 2018 19:23:34 -0800, tonyc wrote: Show quoted text
> On Thu, 22 Nov 2018 03:26:07 -0800, ppisar wrote:
> > On 2018-11-22, Tony Cook <tony@develop-help.com> wrote:
> > > --q7ufeuufo5kv7m4x > > > Content-Type: text/plain; charset=us-ascii > > > Content-Disposition: inline > > > > > > On Thu, Nov 22, 2018 at 08:21:10AM -0000, Petr Pisar wrote:
> > >> Thank you for the patches, but this code calls argvout_final() > > >> that > > >> does not > > >> exist anywhere in the Perl sources. Maybe you forgot to add the > > >> new > > >> function > > >> to the patch?
> > > > > > Oops, no, I missed including a patch. > > > > > > Attached. > > > > > > This belongs before the other two. > > >
> > That helped. I confirm that the tree patches: > > > > (perl #133659) tests for global destruction handling of inplace > > editing > > (perl #133659) move argvout cleanup to a new function > > (perl #133659) make an in-place edit successful if the exit status is > > zero > > > > fix the trivial edit and that all Perl tests pass.
> > Applied as 404395d24bc87890c7d978622296b9925a347aa0, > 640e129d0fc499d24a759cacae9240a32c66fa51 and > 85d2f7cacba4b0088ae0c67cc6d4c9b7495355c0. > > Leaving this open as the more general issue isn't solved. > > Tony
Thanks. FTR, this was also reported in Debian as <https://bugs.debian.org/914651> 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, Dominic.
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 669b
On Mon, 26 Nov 2018 04:54:56 -0800, dom wrote: Show quoted text
> 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?
I've split the unfixed behaviour into https://rt.perl.org/rt3/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
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 909b
On Mon, 03 Dec 2018 15:09:22 -0800, tonyc wrote: Show quoted text
> On Mon, 26 Nov 2018 04:54:56 -0800, dom wrote:
> > 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?
> > I've split the unfixed behaviour into > > https://rt.perl.org/rt3/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
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.
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.1k
On Fri, 07 Dec 2018 04:57:37 -0800, dom wrote: Show quoted text
> On Mon, 03 Dec 2018 15:09:22 -0800, tonyc wrote:
> > On Mon, 26 Nov 2018 04:54:56 -0800, dom wrote:
> > > 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?
> > > > I've split the unfixed behaviour into > > > > https://rt.perl.org/rt3/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
> > > 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.
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.
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.1k
On Wed, 09 Jan 2019 10:09:16 -0800, shay wrote: Show quoted text
> On Fri, 07 Dec 2018 04:57:37 -0800, dom wrote:
> > On Mon, 03 Dec 2018 15:09:22 -0800, tonyc wrote:
> > > On Mon, 26 Nov 2018 04:54:56 -0800, dom wrote:
> > > > 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?
> > > > > > I've split the unfixed behaviour into > > > > > > https://rt.perl.org/rt3/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
> > > > > > 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.
> > > Now cherry-picked into maint-5.28 for 5.28.1. >
Oops! That should have been 5.28.2.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org