diff options
author | Father Chrysostomos <sprout@cpan.org> | 2012-01-22 22:39:47 -0800 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2012-01-22 22:39:47 -0800 |
commit | 3a482d8d6250628185cb4de79a85f353ba799a58 (patch) | |
tree | 73f23180f51545b880bec52716c162ea7cd9f7c1 | |
parent | 1ef8987b48398aed58d54d2cf83033cbbb7f3d7f (diff) | |
download | perl-3a482d8d6250628185cb4de79a85f353ba799a58.tar.gz |
sv_force_normal: Don’t confuse regexps with cows
Otherwise we get assertion failures and possibly corrupt
string tables.
-rw-r--r-- | sv.c | 2 | ||||
-rw-r--r-- | sv.h | 3 | ||||
-rw-r--r-- | t/lib/universal.t | 14 |
3 files changed, 16 insertions, 3 deletions
@@ -4797,7 +4797,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags) } #else if (SvREADONLY(sv)) { - if (SvFAKE(sv) && !isGV_with_GP(sv)) { + if (SvIsCOW(sv)) { const char * const pvx = SvPVX_const(sv); const STRLEN len = SvCUR(sv); SvFAKE_off(sv); @@ -1745,7 +1745,8 @@ Like sv_utf8_upgrade, but doesn't do magic on C<sv>. #endif /* __GNU__ */ #define SvIsCOW(sv) ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \ - (SVf_FAKE | SVf_READONLY) && !isGV_with_GP(sv)) + (SVf_FAKE | SVf_READONLY) && !isGV_with_GP(sv) \ + && SvTYPE(sv) != SVt_REGEXP) #define SvIsCOW_shared_hash(sv) (SvIsCOW(sv) && SvLEN(sv) == 0) #define SvSHARED_HEK_FROM_PV(pvx) \ diff --git a/t/lib/universal.t b/t/lib/universal.t index 1576470ef8..a52e01972f 100644 --- a/t/lib/universal.t +++ b/t/lib/universal.t @@ -6,7 +6,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; - plan( tests => 10 ); + plan( tests => 13 ); } for my $arg ('', 'q[]', qw( 1 undef )) { @@ -37,6 +37,18 @@ Internals::SvREADONLY($x,0); $x = 42; is $x, 42, 'Internals::SvREADONLY can turn off readonliness on globs'; +# Same thing with regexps +$x = ${qr//}; +Internals::SvREADONLY $x, 1; +ok Internals::SvREADONLY($x), + 'read-only regexps are read-only acc. to Internals::'; +eval { $x = [] }; +like $@, qr/Modification of a read-only value attempted at/, + 'read-only regexps'; +Internals::SvREADONLY($x,0); +$x = 42; +is $x, 42, 'Internals::SvREADONLY can turn off readonliness on regexps'; + $h{a} = __PACKAGE__; Internals::SvREADONLY $h{a}, 1; eval { $h{a} = 3 }; |