X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=regcomp.c;h=4cfd3dbbdbc752f4f4eb457f972c513eda6affc7;hb=1ed8eac0dfbbdc6acb022ff1733a2473c102328b;hp=cd3857eb2bdddee6c0701987f8a3960f1d934984;hpb=a72c75842468bcd2a7cf17032844c4040a5a31e2;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/regcomp.c b/regcomp.c
index cd3857e..4cfd3db 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -522,11 +522,8 @@ S_scan_commit(pTHX_ RExC_state_t *pRExC_state, scan_data_t *data)
 STATIC void
 S_cl_anything(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl)
 {
-    int value;
-
     ANYOF_CLASS_ZERO(cl);
-    for (value = 0; value < 256; ++value)
-	ANYOF_BITMAP_SET(cl, value);
+    ANYOF_BITMAP_SETALL(cl);
     cl->flags = ANYOF_EOS|ANYOF_UNICODE_ALL;
     if (LOC)
 	cl->flags |= ANYOF_LOCALE;
@@ -543,9 +540,8 @@ S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl)
 	    return 1;
     if (!(cl->flags & ANYOF_UNICODE_ALL))
 	return 0;
-    for (value = 0; value < 256; ++value)
-	if (!ANYOF_BITMAP_TEST(cl, value))
-	    return 0;
+    if (!ANYOF_BITMAP_TESTALLSET(cl))
+	return 0;
     return 1;
 }
 
@@ -662,6 +658,17 @@ S_cl_or(pTHX_ RExC_state_t *pRExC_state, struct regnode_charclass_class *cl, str
     }
 }
 
+/*
+ * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2.
+ * These need to be revisited when a newer toolchain becomes available.
+ */
+#if defined(__sparc64__) && defined(__GNUC__)
+#   if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96)
+#       undef  SPARC64_GCC_WORKAROUND
+#       define SPARC64_GCC_WORKAROUND 1
+#   endif
+#endif
+
 /* REx optimizer.  Converts nodes into quickier variants "in place".
    Finds fixed substrings.  */
 
@@ -1207,11 +1214,28 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg
 		    int counted = mincount != 0;
 
 		    if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */
+#if defined(SPARC64_GCC_WORKAROUND)
+			I32 b = 0;
+			STRLEN l = 0;
+			char *s = NULL;
+			I32 old = 0;
+
+			if (pos_before >= data->last_start_min)
+			    b = pos_before;
+			else
+			    b = data->last_start_min;
+
+			l = 0;
+			s = SvPV(data->last_found, l);
+			old = b - data->last_start_min;
+
+#else
 			I32 b = pos_before >= data->last_start_min
 			    ? pos_before : data->last_start_min;
 			STRLEN l;
 			char *s = SvPV(data->last_found, l);
 			I32 old = b - data->last_start_min;
+#endif
 
 			if (UTF)
 			    old = utf8_hop((U8*)s, old) - (U8*)s;
@@ -1666,17 +1690,15 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     if (exp == NULL)
 	FAIL("NULL regexp argument");
 
-    /* XXXX This looks very suspicious... */
-    if (pm->op_pmdynflags & PMdf_CMP_UTF8)
-        RExC_utf8 = 1;
-    else
-        RExC_utf8 = 0;
+    RExC_utf8 = pm->op_pmdynflags & PMdf_CMP_UTF8;
 
     RExC_precomp = exp;
-    DEBUG_r(if (!PL_colorset) reginitcolors());
-    DEBUG_r(PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n",
-		      PL_colors[4],PL_colors[5],PL_colors[0],
-		      (int)(xend - exp), RExC_precomp, PL_colors[1]));
+    DEBUG_r({
+	 if (!PL_colorset) reginitcolors();
+	 PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n",
+		       PL_colors[4],PL_colors[5],PL_colors[0],
+		       (int)(xend - exp), RExC_precomp, PL_colors[1]);
+    });
     RExC_flags16 = pm->op_pmflags;
     RExC_sawback = 0;
 
@@ -1764,7 +1786,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
     r->reganch = pm->op_pmflags & PMf_COMPILETIME; /* Again? */
     pm->op_pmflags = RExC_flags16;
     if (UTF)
-	r->reganch |= ROPT_UTF8;
+        r->reganch |= ROPT_UTF8;	/* Unicode in it? */
     r->regstclass = NULL;
     if (RExC_naughty >= 10)	/* Probably an expensive pattern. */
 	r->reganch |= ROPT_NAUGHTY;
@@ -2795,6 +2817,7 @@ tryagain:
 	case 'Z':
 	    ret = reg_node(pRExC_state, SEOL);
 	    *flagp |= SIMPLE;
+	    RExC_seen_zerolen++;		/* Do not optimize RE away */
 	    nextchar(pRExC_state);
 	    break;
 	case 'z':
@@ -2963,7 +2986,7 @@ tryagain:
 	    char *oldp, *s;
 	    STRLEN numlen;
 	    STRLEN ulen;
-	    U8 tmpbuf[UTF8_MAXLEN*2+1];
+	    U8 tmpbuf[UTF8_MAXLEN_UCLC+1];
 
             parse_start = RExC_parse - 1;
 
@@ -2994,6 +3017,8 @@ tryagain:
 		case '\\':
 		    switch (*++p) {
 		    case 'A':
+		    case 'C':
+		    case 'X':
 		    case 'G':
 		    case 'Z':
 		    case 'z':
@@ -3162,12 +3187,13 @@ tryagain:
 	 STRLEN newlen = SvCUR(sv);
 	 if (!SIZE_ONLY) {
 	      DEBUG_r(PerlIO_printf(Perl_debug_log, "recode %*s to %*s\n",
-				    oldlen, STRING(ret), newlen, s));
+				    (int)oldlen, STRING(ret), (int)newlen, s));
 	      Copy(s, STRING(ret), newlen, char);
 	      STR_LEN(ret) += newlen - oldlen;
 	      RExC_emit += STR_SZ(newlen) - STR_SZ(oldlen);
 	 } else
 	      RExC_size += STR_SZ(newlen) - STR_SZ(oldlen);
+	 RExC_utf8 = 1;
     }
 
     return(ret);
@@ -3941,10 +3967,10 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state)
 		}
 		else
 #endif
-		    for (i = prevvalue; i <= ceilvalue; i++)
-			ANYOF_BITMAP_SET(ret, i);
+		      for (i = prevvalue; i <= ceilvalue; i++)
+			  ANYOF_BITMAP_SET(ret, i);
 	  }
-	  if (value > 255) {
+	  if (value > 255 || UTF) {
 		ANYOF_FLAGS(ret) |= ANYOF_UNICODE;
 		if (prevvalue < value)
 		    Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\t%04"UVxf"\n",