Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[PATCH] s///r with -DPERL_NO_COW attempts to modify source SV #15206

Closed
p5pRT opened this issue Feb 29, 2016 · 11 comments
Closed

[PATCH] s///r with -DPERL_NO_COW attempts to modify source SV #15206

p5pRT opened this issue Feb 29, 2016 · 11 comments

Comments

@p5pRT
Copy link

p5pRT commented Feb 29, 2016

Migrated from rt.perl.org#127635 (status was 'resolved')

Searchable as RT127635$

@p5pRT
Copy link
Author

p5pRT commented Feb 29, 2016

From @bulk88

Created by @bulk88

Want RT #.

Perl Info

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)







@p5pRT
Copy link
Author

p5pRT commented Feb 29, 2016

From @bulk88

On Mon Feb 29 08​:37​:36 2016, bulk88 wrote​:

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

@p5pRT
Copy link
Author

p5pRT commented Feb 29, 2016

From @bulk88

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

@p5pRT
Copy link
Author

p5pRT commented Feb 29, 2016

From @tonycoz

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

@p5pRT
Copy link
Author

p5pRT commented Feb 29, 2016

From @tonycoz

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

@p5pRT
Copy link
Author

p5pRT commented Feb 29, 2016

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Mar 1, 2016

From @bulk88

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.

--
bulk88 ~ bulk88 at hotmail.com

@p5pRT
Copy link
Author

p5pRT commented Mar 1, 2016

From @tonycoz

On Mon Feb 29 16​:03​:14 2016, bulk88 wrote​:

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 d13a5d3.

Tony

@p5pRT
Copy link
Author

p5pRT commented Mar 1, 2016

@tonycoz - Status changed from 'open' to 'pending release'

@p5pRT
Copy link
Author

p5pRT commented May 13, 2016

From @khwilliamson

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

@p5pRT p5pRT closed this as completed May 13, 2016
@p5pRT
Copy link
Author

p5pRT commented May 13, 2016

@khwilliamson - Status changed from 'pending release' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant