From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sun, 3 Dec 2000 22:12:58 +0000 (+0000)
Subject: On DEBUGGING make ANYOFUTF8 nodes store away also the SV
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fde631edcda1e6cf071a0596a8e3c07734ab8307;p=p5sagit%2Fp5-mst-13.2.git

On DEBUGGING make ANYOFUTF8 nodes store away also the SV
used to swash_init(), makes regprop() dumps more informative
(+utf8::IsAlpha, -utf8::IsDigit, for example).

p4raw-id: //depot/perl@7969
---

diff --git a/regcomp.c b/regcomp.c
index 2cd0016..64a83cd 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -3933,7 +3933,14 @@ S_regclassutf8(pTHX_ RExC_state_t *pRExC_state)
 
     if (!SIZE_ONLY) {
 	SV *rv = swash_init("utf8", "", listsv, 1, 0);
+#ifdef DEBUGGING
+	AV *av = newAV();
+	av_push(av, rv);
+	av_push(av, listsv);
+	rv = newRV_inc((SV*)av);
+#else
 	SvREFCNT_dec(listsv);
+#endif
 	n = add_data(pRExC_state, 1, "s");
 	RExC_rx->data->data[n] = (void*)rv;
 	ARG1_SET(ret, flags);
@@ -4392,12 +4399,15 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
 			sv_catpv(sv, anyofs[i]);
 	}
 	else {
-	    SV *swash = (SV*)PL_regdata->data[ARG2(o)];
+	    SV *rv = (SV*)PL_regdata->data[ARG2(o)];
+	    AV *av = (AV*)SvRV((SV*)rv);
+	    SV *sw = *av_fetch(av, 0, FALSE);
+	    SV *lv = *av_fetch(av, 1, FALSE);
 	    UV i;
 	    U8 s[UTF8_MAXLEN+1];
 	    for (i = 0; i <= 256; i++) { /* just the first 256 */
 		U8 *e = uv_to_utf8(s, i);
-		if (i < 256 && swash_fetch(swash, s)) {
+		if (i < 256 && swash_fetch(sw, s)) {
 		    if (rangestart == -1)
 			rangestart = i;
 		} else if (rangestart != -1) {
@@ -4419,6 +4429,24 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
 		}
 	    }
 	    sv_catpv(sv, "...");
+	    {
+		char *s = savepv(SvPVX(lv));
+
+		while(*s && *s != '\n') s++;
+		if (*s == '\n') {
+		    char *t = ++s;
+
+		    while (*s) {
+			if (*s == '\n')
+			    *s = ' ';
+			s++;
+		    }
+		    if (s[-1] == ' ')
+			s[-1] = 0;
+
+		    sv_catpv(sv, t);
+		}
+	    }
 	}
 	Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]);
     }
@@ -4481,6 +4509,16 @@ Perl_pregfree(pTHX_ struct regexp *r)
 	while (--n >= 0) {
 	    switch (r->data->what[n]) {
 	    case 's':
+#ifdef DEBUGGING
+	        {
+		    SV *rv = (SV*)r->data->data[n];
+		    AV *av = (AV*)SvRV((SV*)rv);
+		    SV *sw = *av_fetch(av, 0, FALSE);
+		    SV *lv = *av_fetch(av, 1, FALSE);
+		    SvREFCNT_dec(sw);
+		    SvREFCNT_dec(lv);
+		}
+#endif
 		SvREFCNT_dec((SV*)r->data->data[n]);
 		break;
 	    case 'f':
diff --git a/regexec.c b/regexec.c
index 1f79f30..6a06910 100644
--- a/regexec.c
+++ b/regexec.c
@@ -106,7 +106,11 @@
  */
 
 #define REGINCLASS(p,c)  (ANYOF_FLAGS(p) ? reginclass(p,c) : ANYOF_BITMAP_TEST(p,c))
-#define REGINCLASSUTF8(f,p)  (ARG1(f) ? reginclassutf8(f,p) : swash_fetch((SV*)PL_regdata->data[ARG2(f)],p))
+#ifdef DEBUGGING
+#   define REGINCLASSUTF8(f,p)  (ARG1(f) ? reginclassutf8(f,p) : swash_fetch(*av_fetch((AV*)SvRV((SV*)PL_regdata->data[ARG2(f)]),0,FALSE),p))
+#else
+#   define REGINCLASSUTF8(f,p)  (ARG1(f) ? reginclassutf8(f,p) : swash_fetch((SV*)PL_regdata->data[ARG2(f)],p))
+#endif
 
 #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv))
 #define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b)
@@ -3790,9 +3794,16 @@ S_reginclassutf8(pTHX_ regnode *f, U8 *p)
     dTHR;
     char flags = ARG1(f);
     bool match = FALSE;
-    SV *sv = (SV*)PL_regdata->data[ARG2(f)];
+#ifdef DEBUGGING
+    SV *rv = (SV*)PL_regdata->data[ARG2(f)];
+    AV *av = (AV*)SvRV((SV*)rv);
+    SV *sw = *av_fetch(av, 0, FALSE);
+    SV *lv = *av_fetch(av, 1, FALSE);
+#else
+    SV *sw = (SV*)PL_regdata->data[ARG2(f)];
+#endif
 
-    if (swash_fetch(sv, p))
+    if (swash_fetch(sw, p))
 	match = TRUE;
     else if (flags & ANYOF_FOLD) {
 	U8 tmpbuf[UTF8_MAXLEN+1];
@@ -3802,7 +3813,7 @@ S_reginclassutf8(pTHX_ regnode *f, U8 *p)
 	}
 	else
 	    uv_to_utf8(tmpbuf, toLOWER_utf8(p));
-	if (swash_fetch(sv, tmpbuf))
+	if (swash_fetch(sw, tmpbuf))
 	    match = TRUE;
     }