In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3a482d8d6250628185cb4de79a85f353ba799a58?hp=9a8aa25b28a859846cf1458bfe11f17ad258e982>
- Log ----------------------------------------------------------------- commit 3a482d8d6250628185cb4de79a85f353ba799a58 Author: Father Chrysostomos <[email protected]> Date: Sun Jan 22 22:39:47 2012 -0800 sv_force_normal: Donât confuse regexps with cows Otherwise we get assertion failures and possibly corrupt string tables. M sv.c M sv.h M t/lib/universal.t commit 1ef8987b48398aed58d54d2cf83033cbbb7f3d7f Author: Father Chrysostomos <[email protected]> Date: Sun Jan 22 22:20:36 2012 -0800 English.pm: Remove fallacious comment M lib/English.pm commit 0552980ae2ce1142bf3b76d2eb9a04172fad97f1 Author: Father Chrysostomos <[email protected]> Date: Sun Jan 22 22:20:00 2012 -0800 Increase $English::VERSION to 1.05 M lib/English.pm ----------------------------------------------------------------------- Summary of changes: lib/English.pm | 4 ++-- sv.c | 2 +- sv.h | 3 ++- t/lib/universal.t | 14 +++++++++++++- 4 files changed, 18 insertions(+), 5 deletions(-) diff --git a/lib/English.pm b/lib/English.pm index c11fbed..1f1e85d 100644 --- a/lib/English.pm +++ b/lib/English.pm @@ -1,6 +1,6 @@ package English; -our $VERSION = '1.04'; +our $VERSION = '1.05'; require Exporter; @ISA = qw(Exporter); @@ -139,7 +139,7 @@ sub import { @COMPLETE_EXPORT = ( @MINIMAL_EXPORT, @MATCH_EXPORT ) ; -# The ground of all being. @ARG is deprecated (5.005 makes @_ lexical) +# The ground of all being. *ARG = *_ ; diff --git a/sv.c b/sv.c index 6e8ed66..3736e27 100644 --- a/sv.c +++ b/sv.c @@ -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); diff --git a/sv.h b/sv.h index 48b05ec..935f4ff 100644 --- a/sv.h +++ b/sv.h @@ -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 1576470..a52e019 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 }; -- Perl5 Master Repository
