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
Comments
From @bulk88Created by @bulk88Want RT #. Perl Info
|
From @bulk88On Mon Feb 29 08:37:36 2016, bulk88 wrote:
patch attached. -- |
From @bulk880001-perl-127635-s-r-with-DPERL_NO_COW-attempts-to-modify.patchFrom 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
|
From @tonycozOn Mon Feb 29 10:33:41 2016, bulk88 wrote:
The nesting on that seems overcomplicated to me, how about the attached? Tony |
From @tonycoz0001-perl-127635-s-r-with-DPERL_NO_COW-attempts-to-modify.patchFrom 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
|
The RT System itself - Status changed from 'new' to 'open' |
From @bulk88On Mon Feb 29 15:43:41 2016, tonyc wrote:
Fine, feel free to push. -- |
From @tonycozOn Mon Feb 29 16:03:14 2016, bulk88 wrote:
Thanks for the feedback. Applied as d13a5d3. Tony |
@tonycoz - Status changed from 'open' to 'pending release' |
From @khwilliamsonThank you for submitting this report. You have helped make Perl better. Perl 5.24.0 may be downloaded via https://metacpan.org/release/RJBS/perl-5.24.0 |
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#127635 (status was 'resolved')
Searchable as RT127635$
The text was updated successfully, but these errors were encountered: