fixes for bugs in change#4586 and OS/2 pod tweak, from Ilya

p4raw-link: @4586 on //depot/cfgperl: 6eb5f6b9f48454b7ad64225a5bab0de7fdff695c

p4raw-id: //depot/perl@4617

3 files changed, 44 insertions, 16 deletions

diff --git a/os2/OS2/REXX/REXX.pm b/os2/OS2/REXX/REXX.pm
index 5c6dfd226f..144dd379cb 100644
--- a/os2/OS2/REXX/REXX.pm
+++ b/os2/OS2/REXX/REXX.pm
@@ -335,6 +335,11 @@ which access REXX queues or REXX variables in signal handlers.
 
 See C<t/rx*.t> for examples.
 
+=head1 ENVIRONMENT
+
+If C<PERL_REXX_DEBUG> is set, prints trace info on calls to REXX runtime
+environment.
+
 =head1 AUTHOR
 
 Andreas Kaiser ak@ananke.s.bawue.de, with additions by Ilya Zakharevich
diff --git a/regexec.c b/regexec.c
index 9c0ef17bf2..333f84235a 100644
--- a/regexec.c
+++ b/regexec.c
@@ -650,8 +650,10 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 	);
       success_at_start:
 	if (!(prog->reganch & ROPT_NAUGHTY)	/* XXXX If strpos moved? */
+	    && prog->check_substr		/* Could be deleted already */
 	    && --BmUSEFUL(prog->check_substr) < 0
-	    && prog->check_substr == prog->float_substr) { /* boo */
+	    && prog->check_substr == prog->float_substr)
+	{
 	    /* If flags & SOMETHING - do not do it many times on the same match */
 	    SvREFCNT_dec(prog->check_substr);
 	    prog->check_substr = Nullsv;	/* disable */
@@ -677,9 +679,12 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 	   regstclass does not come from lookahead...  */
 	/* If regstclass takes bytelength more than 1: If charlength==1, OK.
 	   This leaves EXACTF only, which is dealt with in find_byclass().  */
+	int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT
+		    ? STR_LEN(prog->regstclass)
+		    : 1);
 	char *endpos = (prog->anchored_substr || ml_anch)
-		? s + (prog->minlen? 1 : 0)
-		: (prog->float_substr ? check_at - start_shift + 1
+		? s + (prog->minlen? cl_l : 0)
+		: (prog->float_substr ? check_at - start_shift + cl_l
 				      : strend) ;
 	char *startpos = sv ? strend - SvCUR(sv) : s;
 
@@ -694,30 +699,43 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 				"Could not match STCLASS...\n") );
 		goto fail;
 	    }
+	    DEBUG_r( PerlIO_printf(Perl_debug_log,
+				   "This position contradicts STCLASS...\n") );
 	    /* Contradict one of substrings */
 	    if (prog->anchored_substr) {
-		DEBUG_r( PerlIO_printf(Perl_debug_log,
-				"This position contradicts STCLASS...\n") );
 		if (prog->anchored_substr == check) {
 		    DEBUG_r( what = "anchored" );
 		  hop_and_restart:
 		    PL_regeol = strend;	/* Used in HOP() */
 		    s = HOPc(t, 1);
+		    if (s + start_shift + end_shift > strend) {
+			/* XXXX Should be taken into account earlier? */
+			DEBUG_r( PerlIO_printf(Perl_debug_log,
+					       "Could not match STCLASS...\n") );
+			goto fail;
+		    }
 		    DEBUG_r( PerlIO_printf(Perl_debug_log,
-				"trying %s substr starting at offset %ld...\n",
+				"Trying %s substr starting at offset %ld...\n",
 				 what, (long)(s + start_shift - i_strpos)) );
 		    goto restart;
 		}
-		/* Have both, check is floating */
+		/* Have both, check_string is floating */
 		if (t + start_shift >= check_at) /* Contradicts floating=check */
 		    goto retry_floating_check;
 		/* Recheck anchored substring, but not floating... */
 		s = check_at; 
 		DEBUG_r( PerlIO_printf(Perl_debug_log,
-			  "trying anchored substr starting at offset %ld...\n",
+			  "Trying anchored substr starting at offset %ld...\n",
 			  (long)(other_last - i_strpos)) );
 		goto do_other_anchored;
 	    }
+	    if (!prog->float_substr) {	/* Could have been deleted */
+		if (ml_anch) {
+		    s = t = t + 1;
+		    goto try_at_offset;
+		}
+		goto fail;
+	    }
 	    /* Check is floating subtring. */
 	  retry_floating_check:
 	    t = check_at - start_shift;
@@ -737,7 +755,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
     return s;
 
   fail_finish:				/* Substring not found */
-    BmUSEFUL(prog->check_substr) += 5;	/* hooray */
+    if (prog->check_substr)		/* could be removed already */
+	BmUSEFUL(prog->check_substr) += 5; /* hooray */
   fail:
     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
 			  PL_colors[4],PL_colors[5]));
@@ -804,9 +823,9 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
 	    if (c1 == c2) {
 		while (s <= e) {
 		    if ( *s == c1
-			 && (ln == 1 || (OP(c) == EXACTF
-					 ? ibcmp(s, m, ln)
-					 : ibcmp_locale(s, m, ln)))
+			 && (ln == 1 || !(OP(c) == EXACTF
+					  ? ibcmp(s, m, ln)
+					  : ibcmp_locale(s, m, ln)))
 			 && (norun || regtry(prog, s)) )
 			goto got_it;
 		    s++;
@@ -814,9 +833,9 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
 	    } else {
 		while (s <= e) {
 		    if ( (*s == c1 || *s == c2)
-			 && (ln == 1 || (OP(c) == EXACTF
-					 ? ibcmp(s, m, ln)
-					 : ibcmp_locale(s, m, ln)))
+			 && (ln == 1 || !(OP(c) == EXACTF
+					  ? ibcmp(s, m, ln)
+					  : ibcmp_locale(s, m, ln)))
 			 && (norun || regtry(prog, s)) )
 			goto got_it;
 		    s++;
@@ -1488,7 +1507,8 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
 	goto phooey;
     }
     else if (c = prog->regstclass) {
-	if (minlen)		/* don't bother with what can't match */
+	if (minlen && PL_regkind[(U8)OP(prog->regstclass)] != EXACT)
+	    /* don't bother with what can't match */
 	    strend = HOPc(strend, -(minlen - 1));
   	if (find_byclass(prog, c, s, strend, startpos, 0))
 	    goto got_it;
diff --git a/t/op/re_tests b/t/op/re_tests
index f866385096..20b2d633d5 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -744,3 +744,6 @@ tt+$	xxxtt	y	-	-
 \GX.*X	aaaXbX	n	-	-
 (\d+\.\d+)	3.1415926	y	$1	3.1415926
 (\ba.{0,10}br)	have a web browser	y	$1	a web br
+'\.c(pp|xx|c)?$'i	Changes	n	-	-
+'\.c(pp|xx|c)?$'i	IO.c	y	-	-
+'(\.c(pp|xx|c)?$)'i	IO.c	y	$1	.c