summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYves Orton <demerphq@gmail.com>2007-06-23 19:04:04 +0000
committerYves Orton <demerphq@gmail.com>2007-06-23 19:04:04 +0000
commita229a030867b4d770c1ba9af02d1f32330221473 (patch)
tree0b65d32ad10f03e0045faa9b7714309fbb4a2572
parent075d4edd61a9648945541c8a76d8c03d4588400b (diff)
downloadperl-a229a030867b4d770c1ba9af02d1f32330221473.tar.gz
Resolve
http://www.nntp.perl.org/group/perl.perl5.porters/2007/06/msg125667.html by reverting part of change #29354. Unfortunately match vars after a /g match in scalar context will be unsafe (again) after this, but such matches on long strings won't be as diabolically slow. Question: why does the new test in t/op/pat.t pass, but the same test in t/op/reg_unsafe.t fail? (Latter is TODO for now) p4raw-link: @29354 on //depot/perl: 58e23c8d7d24dd08c87b5d56819ad45527176c15 p4raw-id: //depot/perl@31451
-rw-r--r--MANIFEST1
-rw-r--r--pp_hot.c9
-rwxr-xr-xt/op/pat.t9
-rw-r--r--t/op/reg_unsafe.t19
4 files changed, 33 insertions, 5 deletions
diff --git a/MANIFEST b/MANIFEST
index dafce23ab7..f922144b9f 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3761,6 +3761,7 @@ t/op/regexp_qr.t See if regular expressions work as qr//
t/op/regexp.t See if regular expressions work
t/op/regexp_trielist.t See if regular expressions work with trie optimisation
t/op/regmesg.t See if one can get regular expression errors
+t/op/reg_unsafe.t Check for unsafe match vars
t/op/repeat.t See if x operator works
t/op/reset.t See if reset operator works
t/op/re_tests Regular expressions for regexp.t
diff --git a/pp_hot.c b/pp_hot.c
index 27e863db9b..1535e4cd8f 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1266,9 +1266,12 @@ PP(pp_match)
}
}
}
- /* remove comment to get faster /g but possibly unsafe $1 vars after a
- match. Test for the unsafe vars will fail as well*/
- if (( /* !global && */ rx->nparens)
+ /* XXX: comment out !global get safe $1 vars after a
+ match, BUT be aware that this leads to drammatic slowdowns on
+ /g matches against large strings. So far a solution to this problem
+ appears to be quite tricky.
+ Test for the unsafe vars are TODO for now. */
+ if (( !global && rx->nparens)
|| SvTEMP(TARG) || PL_sawampersand ||
(rx->extflags & (RXf_EVAL_SEEN|RXf_PMf_KEEPCOPY)))
r_flags |= REXEC_COPY_STR;
diff --git a/t/op/pat.t b/t/op/pat.t
index 856d3ac4c5..f40154e589 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4453,7 +4453,12 @@ sub kt
if 'foo'=~/(?<x>foo)|bar/;
iseq($ok,1,'$+{x} exists after "foo"=~/(?<x>foo)|bar/');
}
-
+{
+ local $_;
+ ($_ = 'abc')=~/(abc)/g;
+ $_ = '123';
+ iseq("$1",'abc',"/g leads to unsafe match vars: $1");
+}
# Test counter is at bottom of file. Put new tests above here.
#-------------------------------------------------------------------
@@ -4504,6 +4509,6 @@ ok($@=~/\QSequence \k... not terminated in regex;\E/);
iseq(0+$::test,$::TestCount,"Got the right number of tests!");
# Don't forget to update this!
BEGIN {
- $::TestCount = 1960;
+ $::TestCount = 1961;
print "1..$::TestCount\n";
}
diff --git a/t/op/reg_unsafe.t b/t/op/reg_unsafe.t
new file mode 100644
index 0000000000..6b19108bdc
--- /dev/null
+++ b/t/op/reg_unsafe.t
@@ -0,0 +1,19 @@
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+
+}
+print "1..1\n";
+
+# there is an equivelent test in t/op/pat.t which does NOT fail
+# its not clear why it doesnt fail, so this todo gets its own test
+# file until we can work it out.
+
+my $x;
+($x='abc')=~/(abc)/g;
+$x='123';
+
+print "not " if $1 ne 'abc';
+print "ok 1 # TODO safe match vars make /g slow\n";