Front page | perl.perl5.porters |
Postings from February 2003
Re: [perl #20683] [fix] Better Patch
Thread Previous
|
Thread Next
From:
Enache Adrian
Date:
February 23, 2003 10:15
Subject:
Re: [perl #20683] [fix] Better Patch
Message ID:
20030223181639.GA18713@ratsnest.hole
> $ perl -le '$_ ="1234"; $x=1; s/(??{$x})/$x++,z/ge; print $_'
>
> that should print zzzz but prints z234.
...
> 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.
My previous patch has the drawback of dropping the optimization even
in simple cases where $p is a regular variable, and it's just accessed,
not modified.
The modified version works as follows:
- only a magic_setregexp() method is added to 'r'-magical variables,
method which calls sv_unmagic(sv,'r'), forcing recompilation if
the variable is set.
- if the variable has some 'get' magic methods, it isn't made
'r'-magical in the first place (regexec.c ~ 2900)
- if the variable gets some 'get' magic methods since it was cached,
(ex. it is tied) its 'r' magic is dropped (regexec.c ~2876)
I added 2 two tests to op/pat.t, too.
Regards
Adi
--------------------------------------------------------------------
diff -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
Thread Previous
|
Thread Next