Front page | perl.perl5.porters |
Postings from February 2003
[perl #20683] [fix] /(??{$x})/ ignore any changes made to $x
Thread Next
From:
Enache Adrian
Date:
February 22, 2003 11:26
Subject:
[perl #20683] [fix] /(??{$x})/ ignore any changes made to $x
Message ID:
20030222192221.GA10431@ratsnest.hole
$ perl -le '$_ ="1234"; $x=1; s/(??{$x})/$x++,z/ge; print $_'
that should print zzzz but prints z234.
The return value of a (??{ .. }) construct is compiled to a regexp before
being matched. In order to avoid re-compiling it every time, it is
cached by assigning 'r' magic to the variable which holds the return value
- with the mg_obj field pointing to the compiled regular expression.
(see regexec.c:2864)
When the value of that variable is changed in any way, constructs like
(??{ ..;$var}) will still use the stale regular expression.
The example could be rewritten:
#! /usr/bin/perl
$p=1;
foreach (1,2,3,4) {
$p++ if /(??{ $p })/;
}
print $p;
__END__
this prints 2, not 5.
The only solution I found is wiring the get & set methods of 'r' magic
variables to a Perl_getsetregexp() function : that simply calls sv_unmagic(),
forcing recompilation of the regexp if the variable is assigned or its
value is fetched ( notice that $p may be tied or have other kind of magic
which change SvPVX, etc ).
This doesn't affect
$p = qr/.../
... =~ $p
since $p isn't a 'r' magic variable, but a reference.
Please try the patch below ( you'll have to run make regen_headers too)
Regards
Adi
--------------------------------------------------------------------------
diff -rupb /arc/perl-current/embed.fnc perl-current/embed.fnc
--- /arc/perl-current/embed.fnc 2003-02-16 16:24:51.000000000 +0200
+++ perl-current/embed.fnc 2003-02-22 19:20:36.000000000 +0200
@@ -381,6 +381,7 @@ p |int |magic_getglob |SV* sv|MAGIC* mg
p |int |magic_getnkeys |SV* sv|MAGIC* mg
p |int |magic_getpack |SV* sv|MAGIC* mg
p |int |magic_getpos |SV* sv|MAGIC* mg
+p |int |magic_getsetregexp|SV* sv|MAGIC* mg
p |int |magic_getsig |SV* sv|MAGIC* mg
p |int |magic_getsubstr|SV* sv|MAGIC* mg
p |int |magic_gettaint |SV* sv|MAGIC* mg
diff -rupb /arc/perl-current/ext/Devel/Peek/Peek.t perl-current/ext/Devel/Peek/Peek.t
--- /arc/perl-current/ext/Devel/Peek/Peek.t 2003-02-20 20:42:20.000000000 +0200
+++ perl-current/ext/Devel/Peek/Peek.t 2003-02-22 19:45:19.000000000 +0200
@@ -264,7 +264,7 @@ do_test(15,
RV = $ADDR
SV = PVMG\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(OBJECT,RMG\\)
+ FLAGS = \\(OBJECT,GMG,SMG\\)
IV = 0
NV = 0
PV = 0
diff -rupb /arc/perl-current/mg.c perl-current/mg.c
--- /arc/perl-current/mg.c 2003-02-16 00:33:27.000000000 +0200
+++ perl-current/mg.c 2003-02-22 19:20:50.000000000 +0200
@@ -1823,6 +1823,14 @@ Perl_magic_freeregexp(pTHX_ SV *sv, MAGI
return 0;
}
+int
+Perl_magic_getsetregexp(pTHX_ SV *sv, MAGIC *mg)
+{
+ sv_unmagic(sv, PERL_MAGIC_qr);
+ return 0;
+}
+
#ifdef USE_LOCALE_COLLATE
int
Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
diff -rupb /arc/perl-current/perl.h perl-current/perl.h
--- /arc/perl-current/perl.h 2003-02-16 17:05:00.000000000 +0200
+++ perl-current/perl.h 2003-02-22 19:21:43.000000000 +0200
@@ -3485,7 +3485,7 @@ EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_
MEMBER_TO_FPTR(Perl_magic_setdefelem),
0, 0, 0};
-EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)};
+EXT MGVTBL PL_vtbl_regexp = {MEMBER_TO_FPTR(Perl_magic_getsetregexp),MEMBER_TO_FPTR(Perl_magic_getsetregexp),0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)};
EXT MGVTBL PL_vtbl_regdata = {0, 0, MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 0, 0};
EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get),
MEMBER_TO_FPTR(Perl_magic_regdatum_set), 0, 0, 0};
diff -rupb /arc/perl-current/sv.c perl-current/sv.c
--- /arc/perl-current/sv.c 2003-02-18 04:01:51.000000000 +0200
+++ perl-current/sv.c 2003-02-22 19:29:45.000000000 +0200
@@ -2964,9 +2964,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv,
switch (SvTYPE(sv)) {
case SVt_PVMG:
- if ( ((SvFLAGS(sv) &
- (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
- == (SVs_OBJECT|SVs_RMG))
+ if (SvFLAGS(sv) & SVs_OBJECT
&& (mg = mg_find(sv, PERL_MAGIC_qr))) {
regexp *re = (regexp *)mg->mg_obj;
Thread Next
-
[perl #20683] [fix] /(??{$x})/ ignore any changes made to $x
by Enache Adrian