Blob Blame Raw
--- /dev/null	2006-06-01 12:59:27.771303750 -0400
+++ perl-5.8.8/t/op/regexp_qr.t	2006-06-01 19:24:53.000000000 -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";
--- perl-5.8.8/t/op/regexp.t.U27604	2001-10-27 14:09:24.000000000 -0400
+++ perl-5.8.8/t/op/regexp.t	2006-06-01 19:24:53.000000000 -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 }
--- perl-5.8.8/regexec.c.U27604	2006-01-08 15:59:30.000000000 -0500
+++ perl-5.8.8/regexec.c	2006-06-01 19:24:53.000000000 -0400
@@ -412,6 +412,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
     const char * const i_strpos = strpos;
     SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
@@ -473,7 +474,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 */
@@ -568,11 +569,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.  */
@@ -643,7 +644,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",
@@ -704,7 +705,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);
 	    /* FIXME - DEBUG_EXECUTE_r if that is merged to maint  */
 	    DEBUG_r(PerlIO_printf(Perl_debug_log, "%s floating substr \"%s%.*s%s\"%s",
 		    (s ? "Found" : "Contradicts"),
@@ -1639,6 +1640,7 @@
     char *scream_olds;
     SV* oreplsv = GvSV(PL_replgv);
     const 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);
@@ -1756,7 +1758,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;
@@ -1889,7 +1891,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_const(sv));
@@ -1990,7 +1992,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
--- perl-5.8.8/MANIFEST.U27604	2006-01-31 18:27:53.000000000 -0500
+++ perl-5.8.8/MANIFEST	2006-06-01 19:24:52.000000000 -0400
@@ -2802,6 +2802,7 @@
 t/op/ref.t			See if refs and objects work
 t/op/regexp_noamp.t		See if regular expressions work with optimizations
 t/op/regexp.t			See if regular expressions work
+t/op/regexp_qr.t		See if regular expressions work as qr//
 t/op/regmesg.t			See if one can get regular expression errors
 t/op/repeat.t			See if x operator works
 t/op/re_tests			Regular expressions for regexp.t