Skip Menu |
Report information
Id: 127635
Status: resolved
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: bulk88 <bulk88 [at] hotmail.com>
Cc:
AdminCc:

Operating System: mswin32
PatchStatus: (no value)
Severity: low
Type: core
Perl Version: 5.23.5
Fixed In: (no value)



To: perlbug [...] perl.org
From: bulk88 <bulk88 [...] hotmail.com>
Date: Mon, 29 Feb 2016 11:37:55 -0500
Subject: [PATCH] s///r with -DPERL_NO_COW attempts to modify source SV
Download (untitled) / with headers
text/plain 3.8k
This is a bug report for perl from bulk88@hotmail.com, generated with the help of perlbug 1.40 running under perl 5.23.5. ----------------------------------------------------------------- [Please describe your issue here] Want RT #. [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=low --- Site configuration information for perl 5.23.5: Configured by Owner at Sun Oct 25 19:14:27 2015. Summary of my perl5 (revision 5 version 23 subversion 5) configuration: Derived from: 644207b7a8ff7a2b1661c05a7f9ac2df9a5dad91 Platform: osname=MSWin32, osvers=6.1, archname=MSWin32-x86-multi-thread uname='' config_args='undef' hint=recommended, useposix=true, d_sigaction=undef useithreads=define, usemultiplicity=define use64bitint=undef, use64bitall=undef, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cl', ccflags ='-nologo -GF -W3 -O1 -MD -Zi -DNDEBUG -GL -DWIN32 -D_CONSOLE -DNO_STRICT -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE -DPERL_TEXTMODE_SCRIPTS -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS', optimize='-O1 -MD -Zi -DNDEBUG -GL', cppflags='-DWIN32' ccversion='18.00.31101', gccversion='', gccosandvers='' intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234, doublekind=3 d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=8, longdblkind=0 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', lseeksize=8 alignbytes=8, prototype=define Linker and Libraries: ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf -ltcg -libpath:"c:\p523\lib\CORE" -machine:x86 "/manifestdependency:type='Win32' name='Microsoft.Windows.Common-Controls' version='6.0.0.0' processorArchitecture='*' publicKeyToken='6595b64144ccf1df' language='*'" -subsystem:console,"5.01"' libpth=\lib libs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib perllibs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl523.lib gnulibc_version='' Dynamic Linking: dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' ' cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug -opt:ref,icf -ltcg -libpath:"c:\p523\lib\CORE" -machine:x86 "/manifestdependency:type='Win32' name='Microsoft.Windows.Common-Controls' version='6.0.0.0' processorArchitecture='*' publicKeyToken='6595b64144ccf1df' language='*'" -subsystem:console,"5.01"' Locally applied patches: uncommitted-changes --- @INC for perl 5.23.5: C:/p523/site/lib C:/p523/lib . --- Environment for perl 5.23.5: HOME (unset) LANG (unset) LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=C:\p523\site\bin;C:\p523\bin;C:\Program Files\ActiveState Komodo Edit 9\;C:\Windows\system32;C:\Windows;C:\Windows\System32\Wbem;C:\Windows\System32\WindowsPowerShell\v1.0\;C:\Program Files\TortoiseGit\bin;C:\Program Files\Microsoft Windows Performance Toolkit\;C:\Program Files\Microsoft SQL Server\110\Tools\Binn\;C:\Program Files\Microsoft SDKs\TypeScript\1.0\;C:\Program Files\TortoiseHg\; PERL_BADLANG (unset) SHELL (unset)
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 347b
On Mon Feb 29 08:37:36 2016, bulk88 wrote: Show quoted text
> This is a bug report for perl from bulk88@hotmail.com, > generated with the help of perlbug 1.40 running under perl 5.23.5. > > > ----------------------------------------------------------------- > [Please describe your issue here] > > Want RT #.
patch attached. -- bulk88 ~ bulk88 at hotmail.com
Subject: 0001-perl-127635-s-r-with-DPERL_NO_COW-attempts-to-modify.patch
From b2fda3da771e878d6554b4fb63c5c67436306b53 Mon Sep 17 00:00:00 2001 From: Daniel Dragan <bulk88@hotmail.com> Date: Mon, 29 Feb 2016 13:33:16 -0500 Subject: [PATCH] [perl #127635] s///r with -DPERL_NO_COW attempts to modify source SV I found pp_subst with a -DPERL_NO_COW build on an experimental perl branch would die in ../dist/SelfLoader/t/03taint.t in this line "my $file = __FILE__ =~ s/[\w.]+\z/01SelfLoader.t/r;" with a attempt to modify since sv_force_normal_flags checks for readonlyness. The -DPERL_NO_COW exclusive logic seems faulty, since the COW branch right above stores the cow status and doesn't call sv_force_normal_flags until it actually wants to modify the source SV, and pp_subst wont modify the source SV if PMf_NONDESTRUCT is on. So fix the die by only de-COWing if !PMf_NONDESTRUCT. Do not deCOW the source SV if PMf_NONDESTRUCT. The "my $file = __FILE__ =~ s/[\w.]+\z/01SelfLoader.t/r;" fatal die can not be reproduced in blead perl with -DPERL_NO_COW, only in my experimental branch so I rewrote the test to use a const sub that is folded to a HEK COW RO SV * instead of the __FILE__ token which is not a HEK COW on blead perl. The subst.t test only fails if perl is compiled with -DPERL_NO_COW. To avoid an extra !(rpm->op_pmflags & PMf_NONDESTRUCT) check on a NO_COW build, restructure the logic so !(rpm->op_pmflags & PMf_NONDESTRUCT) is tested only once. Filed as [perl #127635]. --- pp_hot.c | 24 ++++++++++++++++-------- t/re/subst.t | 9 ++++++++- 2 files changed, 24 insertions(+), 9 deletions(-) diff --git a/pp_hot.c b/pp_hot.c index 6a280ab..d1efe74 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -2915,15 +2915,23 @@ PP(pp_subst) because they make integers such as 256 "false". */ is_cow = SvIsCOW(TARG) ? TRUE : FALSE; #else - if (SvIsCOW(TARG)) - sv_force_normal_flags(TARG,0); + if (!(rpm->op_pmflags & PMf_NONDESTRUCT)) { + if (SvIsCOW(TARG)) + sv_force_normal_flags(TARG,0); +#endif +#ifdef PERL_ANY_COW + if (!(rpm->op_pmflags & PMf_NONDESTRUCT) && +#else + if ( +#endif + (SvREADONLY(TARG) + || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG)) + || SvTYPE(TARG) > SVt_PVLV) + && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))) + Perl_croak_no_modify(); +#ifndef PERL_ANY_COW + } #endif - if (!(rpm->op_pmflags & PMf_NONDESTRUCT) - && (SvREADONLY(TARG) - || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG)) - || SvTYPE(TARG) > SVt_PVLV) - && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))) - Perl_croak_no_modify(); PUTBACK; orig = SvPV_nomg(TARG, len); diff --git a/t/re/subst.t b/t/re/subst.t index 7826ecb..26a78c7 100644 --- a/t/re/subst.t +++ b/t/re/subst.t @@ -5,11 +5,13 @@ BEGIN { require './test.pl'; set_up_inc('../lib'); require Config; import Config; + require constant; + constant->import(constcow => *Config::{NAME}); require './charset_tools.pl'; require './loc_tools.pl'; } -plan( tests => 269 ); +plan( tests => 270 ); $_ = 'david'; $a = s/david/rules/r; @@ -18,6 +20,11 @@ ok( $_ eq 'david' && $a eq 'rules', 'non-destructive substitute' ); $a = "david" =~ s/david/rules/r; ok( $a eq 'rules', 's///r with constant' ); +#[perl #127635] failed with -DPERL_NO_COW perl build (George smoker uses flag) +#Modification of a read-only value attempted at ../t/re/subst.t line 23. +$a = constcow =~ s/Config/David/r; +ok( $a eq 'David::', 's///r with COW constant' ); + $a = "david" =~ s/david/"is"."great"/er; ok( $a eq 'isgreat', 's///er' ); -- 1.9.5.msysgit.1
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 140b
On Mon Feb 29 10:33:41 2016, bulk88 wrote: Show quoted text
> patch attached.
The nesting on that seems overcomplicated to me, how about the attached? Tony
Subject: 0001-perl-127635-s-r-with-DPERL_NO_COW-attempts-to-modify.patch
From 824953d6316a58eb5138aa6b1502f9a81ab1ed1d Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Tue, 1 Mar 2016 10:41:46 +1100 Subject: [perl #127635] s///r with -DPERL_NO_COW attempts to modify source SV based on work done by bulk88, per his notes below: I found pp_subst with a -DPERL_NO_COW build on an experimental perl branch would die in ../dist/SelfLoader/t/03taint.t in this line "my $file = __FILE__ =~ s/[\w.]+\z/01SelfLoader.t/r;" with a attempt to modify since sv_force_normal_flags checks for readonlyness. The -DPERL_NO_COW exclusive logic seems faulty, since the COW branch right above stores the cow status and doesn't call sv_force_normal_flags until it actually wants to modify the source SV, and pp_subst wont modify the source SV if PMf_NONDESTRUCT is on. So fix the die by only de-COWing if !PMf_NONDESTRUCT. Do not deCOW the source SV if PMf_NONDESTRUCT. The "my $file = __FILE__ =~ s/[\w.]+\z/01SelfLoader.t/r;" fatal die can not be reproduced in blead perl with -DPERL_NO_COW, only in my experimental branch so I rewrote the test to use a const sub that is folded to a HEK COW RO SV * instead of the __FILE__ token which is not a HEK COW on blead perl. The subst.t test only fails if perl is compiled with -DPERL_NO_COW. To avoid an extra !(rpm->op_pmflags & PMf_NONDESTRUCT) check on a NO_COW build, restructure the logic so !(rpm->op_pmflags & PMf_NONDESTRUCT) is tested only once. Filed as [perl #127635]. --- pp_hot.c | 20 +++++++++++--------- t/re/subst.t | 9 ++++++++- 2 files changed, 19 insertions(+), 10 deletions(-) diff --git a/pp_hot.c b/pp_hot.c index 6a280ab..5a6f95c 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -2914,16 +2914,18 @@ PP(pp_subst) /* Awooga. Awooga. "bool" types that are actually char are dangerous, because they make integers such as 256 "false". */ is_cow = SvIsCOW(TARG) ? TRUE : FALSE; -#else - if (SvIsCOW(TARG)) - sv_force_normal_flags(TARG,0); #endif - if (!(rpm->op_pmflags & PMf_NONDESTRUCT) - && (SvREADONLY(TARG) - || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG)) - || SvTYPE(TARG) > SVt_PVLV) - && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))) - Perl_croak_no_modify(); + if (!(rpm->op_pmflags & PMf_NONDESTRUCT)) { +#ifndef PERL_ANY_COW + if (SvIsCOW(TARG)) + sv_force_normal_flags(TARG,0); +#endif + if ((SvREADONLY(TARG) + || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG)) + || SvTYPE(TARG) > SVt_PVLV) + && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))) + Perl_croak_no_modify(); + } PUTBACK; orig = SvPV_nomg(TARG, len); diff --git a/t/re/subst.t b/t/re/subst.t index 7826ecb..26a78c7 100644 --- a/t/re/subst.t +++ b/t/re/subst.t @@ -5,11 +5,13 @@ BEGIN { require './test.pl'; set_up_inc('../lib'); require Config; import Config; + require constant; + constant->import(constcow => *Config::{NAME}); require './charset_tools.pl'; require './loc_tools.pl'; } -plan( tests => 269 ); +plan( tests => 270 ); $_ = 'david'; $a = s/david/rules/r; @@ -18,6 +20,11 @@ ok( $_ eq 'david' && $a eq 'rules', 'non-destructive substitute' ); $a = "david" =~ s/david/rules/r; ok( $a eq 'rules', 's///r with constant' ); +#[perl #127635] failed with -DPERL_NO_COW perl build (George smoker uses flag) +#Modification of a read-only value attempted at ../t/re/subst.t line 23. +$a = constcow =~ s/Config/David/r; +ok( $a eq 'David::', 's///r with COW constant' ); + $a = "david" =~ s/david/"is"."great"/er; ok( $a eq 'isgreat', 's///er' ); -- 2.1.4
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 256b
On Mon Feb 29 15:43:41 2016, tonyc wrote: Show quoted text
> On Mon Feb 29 10:33:41 2016, bulk88 wrote:
> > patch attached.
> > The nesting on that seems overcomplicated to me, how about the attached? > > Tony
Fine, feel free to push. -- bulk88 ~ bulk88 at hotmail.com
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 369b
On Mon Feb 29 16:03:14 2016, bulk88 wrote: Show quoted text
> On Mon Feb 29 15:43:41 2016, tonyc wrote:
> > On Mon Feb 29 10:33:41 2016, bulk88 wrote:
> > > patch attached.
> > > > The nesting on that seems overcomplicated to me, how about the attached? > > > > Tony
> > Fine, feel free to push.
Thanks for the feedback. Applied as d13a5d3bbfe4fc12e203547788c811cb8320ca43. Tony
Download (untitled) / with headers
text/plain 252b
Thank you for submitting this report. You have helped make Perl better. With the release of Perl 5.24.0 on May 9, 2016, this and 149 other issues have been resolved. Perl 5.24.0 may be downloaded via https://metacpan.org/release/RJBS/perl-5.24.0


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