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

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

From:
Jarkko Hietaniemi
Date:
June 30, 2001 10:09
Subject:
Re: [ID 20010626.005] regex (?<name>...) capture-to-var paren, new $^N magic variable
Message ID:
20010630120848.E19034@chaos.wustl.edu
On Fri, Jun 29, 2001 at 11:14:40PM -0700, Jeffrey Friedl wrote:
> 
> |> I created a new magic variable $^N, similar to $+.
> 
> Well, since there has been no objection, here is the patch.
> 	Jeffrey

Thanks, applied.  (base/lex.t need tweaking, too, since it assumed
$^N is an unused variable...)

> -----------------------------------------------------------------
> 
> 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 */

-- 
$jhi++; # http://www.iki.fi/jhi/
        # There is this special biologist word we use for 'stable'.
        # It is 'dead'. -- Jack Cohen



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