Variable in postponed regex only really evaluated once #6270
Comments
From perl-5.8.0@ton.iguana.beCreated by perl-5.8.0@ton.iguana.beWhen trying to remove consecutive letters in a string I tried perl -wle '$z="A"; $_="QDADEBCAV"; s/(??{print"z=$z";$z})/$z++;"*"/eg; print' giving: z=A (the prints are added to show the code is executed) So even though $z changes, it still only matches on the A. However, if I do giving: z=A Which is as expected. Perl Info |
From enache@rdslink.ro$ 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 When the value of that variable is changed in any way, constructs like The example could be rewritten: #! /usr/bin/perl this prints 2, not 5. The only solution I found is wiring the get & set methods of 'r' magic This doesn't affect Please try the patch below ( you'll have to run make regen_headers too) Regards Adi Inline Patchdiff -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;
|
From perl5-porters@ton.iguana.beIn article <20030222192221.GA10431@ratsnest.hole>,
This seems a case where the problem can be solved by simply dropping |
From enache@rdslink.roOn Sat, Feb 22, 2003 at 09:22:21PM +0200, Enache Adrian wrote:
Please add this too to the previous patch - I deleted it by error from the Inline Patch--- /arc/perl-current/regexec.c 2003-02-16 16:24:51.000000000 +0200
+++ perl-current/regexec.c 2003-02-23 01:43:04.000000000 +0200
@@ -2863,18 +2863,12 @@ S_regmatch(pTHX_ regnode *prog)
if (logical) {
if (logical == 2) { /* Postponed subexpression. */
regexp *re;
- MAGIC *mg = Null(MAGIC*);
+ MAGIC *mg;
re_cc_state state;
CHECKPOINT cp, lastcp;
int toggleutf;
-
- if(SvROK(ret) || SvRMAGICAL(ret)) {
- SV *sv = SvROK(ret) ? SvRV(ret) : ret;
-
- if(SvMAGICAL(sv))
- mg = mg_find(sv, PERL_MAGIC_qr);
- }
- if (mg) {
+ SV *sv = SvROK(ret) ? SvRV(ret) : ret;
+ if(SvMAGICAL(sv) && (mg = mg_find(sv, PERL_MAGIC_qr))) {
re = (regexp *)mg->mg_obj;
(void)ReREFCNT_inc(re);
}
------------------------------------------------------------------------
Regards
Adi |
From enache@rdslink.roOn Sat, Feb 22, 2003 at 09:11:03PM +0000, Ton Hospel wrote:
IMHO that optimization is worth keeping in. Regards Adi |
From perl5-porters@ton.iguana.beIn article <20030223004840.GA1442@ratsnest.hole>,
I don't get it. |
From enache@rdslink.ro
My previous patch has the drawback of dropping the optimization even The modified version works as follows: I added 2 two tests to op/pat.t, too. Regards Adi Inline Patchdiff -rup /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-23 19:37:55.000000000 +0200
@@ -408,6 +408,7 @@ p |int |magic_setmglob |SV* sv|MAGIC* mg
p |int |magic_setnkeys |SV* sv|MAGIC* mg
p |int |magic_setpack |SV* sv|MAGIC* mg
p |int |magic_setpos |SV* sv|MAGIC* mg
+p |int |magic_setregexp|SV* sv|MAGIC* mg
p |int |magic_setsig |SV* sv|MAGIC* mg
p |int |magic_setsubstr|SV* sv|MAGIC* mg
p |int |magic_settaint |SV* sv|MAGIC* mg
diff -rup /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-23 19:37:55.000000000 +0200
@@ -264,7 +264,7 @@ do_test(15,
RV = $ADDR
SV = PVMG\\($ADDR\\) at $ADDR
REFCNT = 1
- FLAGS = \\(OBJECT,RMG\\)
+ FLAGS = \\(OBJECT,SMG\\)
IV = 0
NV = 0
PV = 0
diff -rup /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-23 19:38:52.000000000 +0200
@@ -1816,6 +1816,13 @@ Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *
}
int
+Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
+{
+ sv_unmagic(sv, PERL_MAGIC_qr);
+ return 0;
+}
+
+int
Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg)
{
regexp *re = (regexp *)mg->mg_obj;
diff -rup /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-23 19:37:55.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 = {0, MEMBER_TO_FPTR(Perl_magic_setregexp),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 -rup /arc/perl-current/regexec.c perl-current/regexec.c
--- /arc/perl-current/regexec.c 2003-02-16 16:24:51.000000000 +0200
+++ perl-current/regexec.c 2003-02-23 19:38:40.000000000 +0200
@@ -2867,13 +2867,17 @@ S_regmatch(pTHX_ regnode *prog)
re_cc_state state;
CHECKPOINT cp, lastcp;
int toggleutf;
+ register SV *sv;
- if(SvROK(ret) || SvRMAGICAL(ret)) {
- SV *sv = SvROK(ret) ? SvRV(ret) : ret;
-
- if(SvMAGICAL(sv))
- mg = mg_find(sv, PERL_MAGIC_qr);
+ if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
+ mg = mg_find(sv, PERL_MAGIC_qr);
+ else if (SvSMAGICAL(ret)) {
+ if (SvGMAGICAL(ret))
+ sv_unmagic(ret, PERL_MAGIC_qr);
+ else
+ mg = mg_find(ret, PERL_MAGIC_qr);
}
+
if (mg) {
re = (regexp *)mg->mg_obj;
(void)ReREFCNT_inc(re);
@@ -2890,7 +2894,8 @@ S_regmatch(pTHX_ regnode *prog)
if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
re = CALLREGCOMP(aTHX_ t, t + len, &pm);
if (!(SvFLAGS(ret)
- & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
+ & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
+ | SVs_GMG)))
sv_magic(ret,(SV*)ReREFCNT_inc(re),
PERL_MAGIC_qr,0,0);
PL_regprecomp = oprecomp;
diff -rup /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-23 19:37:55.000000000 +0200
@@ -2966,7 +2966,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv,
case SVt_PVMG:
if ( ((SvFLAGS(sv) &
(SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
- == (SVs_OBJECT|SVs_RMG))
+ == (SVs_OBJECT|SVs_SMG))
&& (mg = mg_find(sv, PERL_MAGIC_qr))) {
regexp *re = (regexp *)mg->mg_obj;
diff -rup /arc/perl-current/t/op/pat.t perl-current/t/op/pat.t
--- /arc/perl-current/t/op/pat.t 2003-02-05 22:38:19.000000000 +0200
+++ perl-current/t/op/pat.t 2003-02-23 19:58:27.000000000 +0200
@@ -6,7 +6,7 @@
$| = 1;
-print "1..988\n";
+print "1..990\n";
BEGIN {
chdir 't' if -d 't';
@@ -3108,5 +3108,20 @@ ok("bbbbac" =~ /$pattern/ && $1 eq 'a',
ok ( "0" =~ /\p{N}+\z/, "[perl #19767] variant test" );
}
-# last test 988
+{
+
+ $p = 1;
+ foreach (1,2,3,4) {
+ $p++ if /(??{ $p })/
+ }
+ ok ($p == 5, "[perl #20683] (??{ }) returns stale values");
+ { package P; $a=1; sub TIESCALAR { bless[] } sub FETCH { $a++ } }
+ tie $p, P;
+ foreach (1,2,3,4) {
+ /(??{ $p })/
+ }
+ ok ( $p == 5, "(??{ }) returns stale values");
+}
+
+# last test 990
|
From enache@rdslink.roOn Sun, Feb 23, 2003 at 03:31:38AM +0000, Ton Hospel wrote:
Please do something like I get: real 0m54.794s ratsnest# time perl /tmp/x /tmp/k # with the optimization in real 0m4.332s Notice that instead of the silly quotes there the user may want to put
That's just what my patch try to do: invalidate the r-magic when ( I admit the test is silly - I suspect however that a more serious Regards /tmp/x $entremets = " $entremets = "a"; $/=\4096; while(<>) { |
From enache@rdslink.roOn Sun, Feb 23, 2003 at 09:02:01PM +0200, Enache Adrian wrote:
That's with whe simple ..="a", ..="b". Removing these produces: $ time perl /tmp/x /tmp/k real 1m40.802s $ time perl /tmp/x /tmp/k real 0m5.881s Regards Adi. |
From @hvdsEnache Adrian <enache@rdslink.ro> wrote: For what it's worth, I've written code very like this to add $true = qr/(?=)/; The main reason for doing that was to get around reentrancy problems Precompiling the returned patterns bypasses the (obviously buggy) Hugo |
From enache@rdslink.roOn Mon, Feb 24, 2003 at 02:06:38AM +0000, hv@crypt.org wrote:
The optimization seems to be valuable even in simple, un-branched $ dd if=/dev/zero count=4096 | time perl -ne '$a=1; m/(??{ $a })/' 3.96user 0.00system 0:03.98elapsed 99%CPU (0avgtext+0avgdata 0maxresident)k Notice that my patch ( the second variant ) doesn't affect the rest Of course, it's always better to precompile its regexp's and to But why forcing a speed regression, even for weird cases ? Regards Adi |
From @hvdsEnache Adrian <enache@rdslink.ro> wrote: Thanks, applied as #18782. Hugo |
From @hvdsEnache Adrian <enache@rdslink.ro> wrote: Well, the more types of magic we apply unasked to random SVs, the That was my original thinking. But looking over the patch again, :Of course, it's always better to precompile its regexp's and to Not precompiling regexps is a quite distinct thing from using Hugo |
From @hvds"perl-5.8.0@ton.iguana.be (via RT)" <perlbug-followup@perl.org> wrote: This appears to be fixed by change #18805. Hugo |
From @hvdshv@crypt.org wrote: Sorry, ignore that: it had already been fixed before this change. Hugo |
|
@rspier - Status changed from 'new' to 'resolved' |
Migrated from rt.perl.org#20683 (status was 'resolved')
Searchable as RT20683$
The text was updated successfully, but these errors were encountered: