develooper Front page | perl.perl5.porters | Postings from June 2001

Re: [ID 20010626.005] regex (?<name>...) capture-to-var paren, new $^N magic variable

Thread Previous | Thread Next
From:
Jeffrey Friedl
Date:
June 29, 2001 23:14
Subject:
Re: [ID 20010626.005] regex (?<name>...) capture-to-var paren, new $^N magic variable
Message ID:
200106300614.XAA07830@ventrue.corp.yahoo.com

|> I created a new magic variable $^N, similar to $+.

Well, since there has been no objection, here is the patch.
	Jeffrey

-----------------------------------------------------------------

diff -u -r .orig/embedvar.h ./embedvar.h
--- .orig/embedvar.h	Wed Jun 20 11:35:50 2001
+++ ./embedvar.h	Tue Jun 26 12:16:35 2001
@@ -113,6 +113,7 @@
 #define PL_regint_start		(vTHX->Tregint_start)
 #define PL_regint_string	(vTHX->Tregint_string)
 #define PL_reginterp_cnt	(vTHX->Treginterp_cnt)
+#define PL_reglastcloseparen	(vTHX->Treglastcloseparen)
 #define PL_reglastparen		(vTHX->Treglastparen)
 #define PL_regnarrate		(vTHX->Tregnarrate)
 #define PL_regnaughty		(vTHX->Tregnaughty)
@@ -821,6 +822,7 @@
 #define PL_regint_start		(aTHXo->interp.Tregint_start)
 #define PL_regint_string	(aTHXo->interp.Tregint_string)
 #define PL_reginterp_cnt	(aTHXo->interp.Treginterp_cnt)
+#define PL_reglastcloseparen	(aTHXo->interp.Treglastcloseparen)
 #define PL_reglastparen		(aTHXo->interp.Treglastparen)
 #define PL_regnarrate		(aTHXo->interp.Tregnarrate)
 #define PL_regnaughty		(aTHXo->interp.Tregnaughty)
@@ -1518,6 +1520,7 @@
 #define PL_regint_start		(aTHX->Tregint_start)
 #define PL_regint_string	(aTHX->Tregint_string)
 #define PL_reginterp_cnt	(aTHX->Treginterp_cnt)
+#define PL_reglastcloseparen	(aTHX->Treglastcloseparen)
 #define PL_reglastparen		(aTHX->Treglastparen)
 #define PL_regnarrate		(aTHX->Tregnarrate)
 #define PL_regnaughty		(aTHX->Tregnaughty)
@@ -1654,6 +1657,7 @@
 #define PL_Tregint_start	PL_regint_start
 #define PL_Tregint_string	PL_regint_string
 #define PL_Treginterp_cnt	PL_reginterp_cnt
+#define PL_Treglastcloseparen	PL_reglastcloseparen
 #define PL_Treglastparen	PL_reglastparen
 #define PL_Tregnarrate		PL_regnarrate
 #define PL_Tregnaughty		PL_regnaughty
diff -u -r .orig/gv.c ./gv.c
--- .orig/gv.c	Mon Jun 25 08:08:15 2001
+++ ./gv.c	Tue Jun 26 12:35:10 2001
@@ -895,6 +895,7 @@
     case '\006':	/* $^F */
     case '\010':	/* $^H */
     case '\011':	/* $^I, NOT \t in EBCDIC */
+    case '\016':        /* $^N */
     case '\020':	/* $^P */
     case '\024':	/* $^T */
 	if (len > 1)
@@ -1764,6 +1765,7 @@
     case '\010':   /* $^H */
     case '\011':   /* $^I, NOT \t in EBCDIC */
     case '\014':   /* $^L */
+    case '\016':   /* $^N */
     case '\020':   /* $^P */
     case '\023':   /* $^S */
     case '\024':   /* $^T */
diff -u -r .orig/mg.c ./mg.c
--- .orig/mg.c	Mon Jun 25 07:48:03 2001
+++ ./mg.c	Tue Jun 26 12:36:16 2001
@@ -435,6 +435,13 @@
 		goto getparen;
 	}
 	return 0;
+    case '\016': /* ^N */
+	if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
+	    paren = rx->lastcloseparen;
+	    if (paren)
+		goto getparen;
+	}
+	return 0;
     case '`':
 	if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
 	    if (rx->startp[0] != -1) {
@@ -655,6 +662,14 @@
     case '+':
 	if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
 	    paren = rx->lastparen;
+	    if (paren)
+		goto getparen;
+	}
+	sv_setsv(sv,&PL_sv_undef);
+	break;
+    case '\016':		/* ^N */
+	if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
+	    paren = rx->lastcloseparen;
 	    if (paren)
 		goto getparen;
 	}
diff -u -r .orig/perlapi.h ./perlapi.h
--- .orig/perlapi.h	Wed Jun 20 11:35:50 2001
+++ ./perlapi.h	Tue Jun 26 12:16:35 2001
@@ -802,6 +802,8 @@
 #define PL_regint_string	(*Perl_Tregint_string_ptr(aTHXo))
 #undef  PL_reginterp_cnt
 #define PL_reginterp_cnt	(*Perl_Treginterp_cnt_ptr(aTHXo))
+#undef  PL_reglastcloseparen
+#define PL_reglastcloseparen	(*Perl_Treglastcloseparen_ptr(aTHXo))
 #undef  PL_reglastparen
 #define PL_reglastparen		(*Perl_Treglastparen_ptr(aTHXo))
 #undef  PL_regnarrate
diff -u -r .orig/regexec.c ./regexec.c
--- .orig/regexec.c	Thu Jun 21 07:16:49 2001
+++ ./regexec.c	Tue Jun 26 12:28:14 2001
@@ -147,7 +147,7 @@
     if (paren_elems_to_push < 0)
 	Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
 
-#define REGCP_OTHER_ELEMS 5
+#define REGCP_OTHER_ELEMS 6
     SSCHECK(paren_elems_to_push + REGCP_OTHER_ELEMS);
     for (p = PL_regsize; p > parenfloor; p--) {
 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
@@ -159,6 +159,7 @@
 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
     SSPUSHINT(PL_regsize);
     SSPUSHINT(*PL_reglastparen);
+    SSPUSHINT(*PL_reglastcloseparen);
     SSPUSHPTR(PL_reginput);
 #define REGCP_FRAME_ELEMS 2
 /* REGCP_FRAME_ELEMS are part of the REGCP_OTHER_ELEMS and
@@ -192,6 +193,7 @@
     assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
     i = SSPOPINT; /* Parentheses elements to pop. */
     input = (char *) SSPOPPTR;
+    *PL_reglastcloseparen = SSPOPINT;
     *PL_reglastparen = SSPOPINT;
     PL_regsize = SSPOPINT;
 
@@ -1871,6 +1873,7 @@
     PL_regstartp = prog->startp;
     PL_regendp = prog->endp;
     PL_reglastparen = &prog->lastparen;
+    PL_reglastcloseparen = &prog->lastcloseparen;
     prog->lastparen = 0;
     PL_regsize = 0;
     DEBUG_r(PL_reg_starttry = startpos);
@@ -2562,6 +2565,7 @@
 		    cache_re(re);
 		    state.ss = PL_savestack_ix;
 		    *PL_reglastparen = 0;
+		    *PL_reglastcloseparen = 0;
 		    PL_reg_call_cc = &state;
 		    PL_reginput = locinput;
 
@@ -2619,6 +2623,7 @@
 	    PL_regendp[n] = locinput - PL_bostr;
 	    if (n > *PL_reglastparen)
 		*PL_reglastparen = n;
+	    *PL_reglastcloseparen = n;
 	    break;
 	case GROUPP:
 	    n = ARG(scan);  /* which paren pair */
diff -u -r .orig/regexp.h ./regexp.h
--- .orig/regexp.h	Sun Apr 22 09:12:37 2001
+++ ./regexp.h	Tue Jun 26 12:10:53 2001
@@ -37,6 +37,7 @@
 	I32 prelen;		/* length of precomp */
 	U32 nparens;		/* number of parentheses */
 	U32 lastparen;		/* last paren matched */
+	U32 lastcloseparen;	/* last paren matched */
 	U32 reganch;		/* Internal use only +
 				   Tainted information used by regexec? */
 	regnode program[1];	/* Unwarranted chumminess with compiler. */
diff -u -r .orig/thrdvar.h ./thrdvar.h
--- .orig/thrdvar.h	Mon Apr 30 05:29:37 2001
+++ ./thrdvar.h	Tue Jun 26 12:12:52 2001
@@ -182,6 +182,7 @@
 PERLVAR(Tregstartp,	I32 *)		/* Pointer to startp array. */
 PERLVAR(Tregendp,	I32 *)		/* Ditto for endp. */
 PERLVAR(Treglastparen,	U32 *)		/* Similarly for lastparen. */
+PERLVAR(Treglastcloseparen, U32 *)	/* Similarly for lastcloseparen. */
 PERLVAR(Tregtill,	char *)		/* How far we are required to go. */
 PERLVAR(Tregcompat1,	char)		/* used to be regprev1 */
 PERLVAR(Treg_start_tmp,	char **)	/* from regexec.c */

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About