s/PATTERN/func()/em leaks /m into func(). #8005
Labels
Comments
From @AbigailCreated by @AbigailThe following subroutine returns its argument with any leading newlines sub xxx { However, if this function is called from the replacement part of I've confirmed the bug to be present in 5.000, 5.004_0[45], 5.005_0x, Full test: #!/usr/bin/perl use strict; use Test::More tests => 1; # my $a = "A\n\nB"; $a =~ s/([\s\w]+)/xxx $1/e; is ($b, $a); __END__ 1..1 Perl Info |
From @ysthOn Wed, Jul 06, 2005 at 10:34:33PM -0000, abigail @ abigail. nl wrote:
I think this was fixed by the removal of the long-deprecated $*. |
|
The RT System itself - Status changed from 'new' to 'open' |
From rick@bort.caOn Thu, Jul 07, 2005 at 03:24:43PM -0700, Yitzchak Scott-Thoennes wrote:
Not exactly. Change 23471 for bug 3038 fixed this by eliminating some -- Inline Patchdiff -ruN perl-5.8.7/pp.c perl-5.8.7.new/pp.c
--- perl-5.8.7/pp.c 2005-05-16 11:30:13.000000000 -0400
+++ perl-5.8.7.new/pp.c 2005-07-07 22:28:44.847094626 -0400
@@ -4544,6 +4544,7 @@
I32 gimme = GIMME_V;
I32 oldsave = PL_savestack_ix;
I32 make_mortal = 1;
+ bool multiline = 0;
MAGIC *mg = (MAGIC *) NULL;
#ifdef DEBUGGING
@@ -4609,9 +4610,8 @@
s++;
}
}
- if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
- SAVEINT(PL_multiline);
- PL_multiline = pm->op_pmflags & PMf_MULTILINE;
+ if (pm->op_pmflags & PMf_MULTILINE) {
+ multiline = 1;
}
if (!limit)
@@ -4690,7 +4690,7 @@
#ifndef lint
while (s < strend && --limit &&
(m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
- csv, PL_multiline ? FBMrf_MULTILINE : 0)) )
+ csv, multiline ? FBMrf_MULTILINE : 0)) )
#endif
{
dstr = newSVpvn(s, m-s);
diff -ruN perl-5.8.7/pp_hot.c perl-5.8.7.new/pp_hot.c
--- perl-5.8.7/pp_hot.c 2005-04-22 10:12:27.000000000 -0400
+++ perl-5.8.7.new/pp_hot.c 2005-07-07 22:25:15.124509234 -0400
@@ -1309,11 +1309,6 @@
if (SvSCREAM(TARG))
r_flags |= REXEC_SCREAM;
- if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
- SAVEINT(PL_multiline);
- PL_multiline = pm->op_pmflags & PMf_MULTILINE;
- }
-
play_it_again:
if (global && rx->startp[0] != -1) {
t = s = rx->endp[0] + truebase;
@@ -2062,10 +2057,6 @@
? REXEC_COPY_STR : 0;
if (SvSCREAM(TARG))
r_flags |= REXEC_SCREAM;
- if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
- SAVEINT(PL_multiline);
- PL_multiline = pm->op_pmflags & PMf_MULTILINE;
- }
orig = m = s;
if (rx->reganch & RE_USE_INTUIT) {
PL_bostr = orig;
diff -ruN perl-5.8.7/regexec.c perl-5.8.7.new/regexec.c
--- perl-5.8.7/regexec.c 2005-04-22 07:10:05.000000000 -0400
+++ perl-5.8.7.new/regexec.c 2005-07-07 21:30:30.322133410 -0400
@@ -408,6 +408,7 @@
I32 ml_anch;
register char *other_last = Nullch; /* other substr checked before this */
char *check_at = Nullch; /* check substr found at this pos */
+ const I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);
#ifdef DEBUGGING
char *i_strpos = strpos;
SV *dsv = PERL_DEBUG_PAD_ZERO(0);
@@ -469,7 +470,7 @@
if (prog->reganch & ROPT_ANCH) { /* Match at beg-of-str or after \n */
ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
|| ( (prog->reganch & ROPT_ANCH_BOL)
- && !PL_multiline ) ); /* Check after \n? */
+ && !multiline ) ); /* Check after \n? */
if (!ml_anch) {
if ( !(prog->reganch & (ROPT_ANCH_GPOS /* Checked by the caller */
@@ -563,11 +564,11 @@
else if (prog->reganch & ROPT_CANY_SEEN)
s = fbm_instr((U8*)(s + start_shift),
(U8*)(strend - end_shift),
- check, PL_multiline ? FBMrf_MULTILINE : 0);
+ check, multiline ? FBMrf_MULTILINE : 0);
else
s = fbm_instr(HOP3(s, start_shift, strend),
HOP3(strend, -end_shift, strbeg),
- check, PL_multiline ? FBMrf_MULTILINE : 0);
+ check, multiline ? FBMrf_MULTILINE : 0);
/* Update the count-of-usability, remove useless subpatterns,
unshift s. */
@@ -636,7 +637,7 @@
HOP3(HOP3(last1, prog->anchored_offset, strend)
+ SvCUR(must), -(SvTAIL(must)!=0), strbeg),
must,
- PL_multiline ? FBMrf_MULTILINE : 0
+ multiline ? FBMrf_MULTILINE : 0
);
DEBUG_r(PerlIO_printf(Perl_debug_log,
"%s anchored substr `%s%.*s%s'%s",
@@ -697,7 +698,7 @@
s = fbm_instr((unsigned char*)s,
(unsigned char*)last + SvCUR(must)
- (SvTAIL(must)!=0),
- must, PL_multiline ? FBMrf_MULTILINE : 0);
+ must, multiline ? FBMrf_MULTILINE : 0);
DEBUG_r(PerlIO_printf(Perl_debug_log, "%s floating substr `%s%.*s%s'%s",
(s ? "Found" : "Contradicts"),
PL_colors[0],
@@ -1633,6 +1634,7 @@
char *scream_olds;
SV* oreplsv = GvSV(PL_replgv);
bool do_utf8 = DO_UTF8(sv);
+ const I32 multiline = PL_multiline | (prog->reganch & PMf_MULTILINE);
#ifdef DEBUGGING
SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
@@ -1749,7 +1751,7 @@
if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
if (s == startpos && regtry(prog, startpos))
goto got_it;
- else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
+ else if (multiline || (prog->reganch & ROPT_IMPLICIT)
|| (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
{
char *end;
@@ -1883,7 +1885,7 @@
end_shift, &scream_pos, 0))
: (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
(unsigned char*)strend, must,
- PL_multiline ? FBMrf_MULTILINE : 0))) ) {
+ multiline ? FBMrf_MULTILINE : 0))) ) {
/* we may be pointing at the wrong string */
if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
s = strbeg + (s - SvPVX(sv));
@@ -1984,7 +1986,7 @@
if (SvTAIL(float_real)) {
if (memEQ(strend - len + 1, little, len - 1))
last = strend - len + 1;
- else if (!PL_multiline)
+ else if (!multiline)
last = memEQ(strend - len, little, len)
? strend - len : Nullch;
else
diff -ruN perl-5.8.7/t/op/regexp.t perl-5.8.7.new/t/op/regexp.t
--- perl-5.8.7/t/op/regexp.t 2001-10-27 14:09:24.000000000 -0400
+++ perl-5.8.7.new/t/op/regexp.t 2005-07-07 22:54:14.199458020 -0400
@@ -49,6 +49,7 @@
$bang = sprintf "\\%03o", ord "!"; # \41 would not be portable.
$ffff = chr(0xff) x 2;
$nulnul = "\0" x 2;
+$OP = $qr ? 'qr' : 'm';
$| = 1;
print "1..$numtests\n# $iters iterations\n";
@@ -73,7 +74,7 @@
$result =~ s/B//i unless $skip;
for $study ('', 'study \$subject') {
$c = $iters;
- eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";";
+ eval "$study; \$match = (\$subject =~ $OP$pat) while \$c--; \$got = \"$repl\";";
chomp( $err = $@ );
if ($result eq 'c') {
if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST }
diff -ruN perl-5.8.7/t/op/regexp_qr.t perl-5.8.7.new/t/op/regexp_qr.t
--- perl-5.8.7/t/op/regexp_qr.t 1969-12-31 19:00:00.000000000 -0500
+++ perl-5.8.7.new/t/op/regexp_qr.t 2005-07-07 21:32:23.810852184 -0400
@@ -0,0 +1,10 @@
+#!./perl
+
+$qr = 1;
+for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
+ if (-r $file) {
+ do $file;
+ exit;
+ }
+}
+die "Cannot find ./op/regexp.t or ./t/op/regexp.t\n"; |
|
p5p@spam.wizbit.be - Status changed from 'open' to 'resolved' |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Migrated from rt.perl.org#36473 (status was 'resolved')
Searchable as RT36473$
The text was updated successfully, but these errors were encountered: