develooper Front page | perl.perl5.porters | Postings from September 2023

[RFC PATCH] introduce the RXapif_NPAR flag

Thread Next
From:
Oleg Nesterov
Date:
September 21, 2023 11:33
Subject:
[RFC PATCH] introduce the RXapif_NPAR flag
Message ID:
20230921113218.GA20453@redhat.com
Hello,

Alexey is trying to rewrite some code from Go to Perl and he ran
into a problem: it is not possible to know the start/end offsets
of the named captures.

This change makes it possible to find out the logical number(s)
of the named capture buffer which in turn allows to use @- / @+.

Example:

	# like %- but reports the paren numbers
	tie my %h, "Tie::Hash::NamedCapture", all=>1, npar=>1;

	#01234567
	'12ab45xy' =~ /^(\d+)(?<N>[a-z]+)(\d+)(?<N>[a-z]+)$/ or die;

	$pn = $h{N};

	print "pn=@$pn\n";

	print "start=@-[@$pn] end=@+[@$pn]\n";

output:

	pn=2 4
	start=2 6 end=4 8

Do you think something like the patch below makes sense?

Perhaps it would be better if RXapif_NPAR will make "ret" dualvar
in Perl_reg_named_buff_fetch?

Thanks,

Oleg.
---
 regexec.c   | 8 ++++++--
 regexp.h    | 2 ++
 universal.c | 8 +++++---
 3 files changed, 13 insertions(+), 5 deletions(-)

diff --git a/regexec.c b/regexec.c
index de0b7c4619..acf2a116d6 100644
--- a/regexec.c
+++ b/regexec.c
@@ -11978,8 +11978,12 @@ Perl_reg_named_buff_fetch(pTHX_ REGEXP * const r, SV * const namesv,
                 if ((I32)(rx->nparens) >= nums[i]
                     && RXp_OFFS_VALID(rx,nums[i]))
                 {
-                    ret = newSVpvs("");
-                    Perl_reg_numbered_buff_fetch_flags(aTHX_ r, nums[i], ret, REG_FETCH_ABSOLUTE);
+                    if (flags & RXapif_NPAR) {
+                        ret = newSViv(nums[i]);
+                    } else {
+                        ret = newSVpvs("");
+                        Perl_reg_numbered_buff_fetch_flags(aTHX_ r, nums[i], ret, REG_FETCH_ABSOLUTE);
+                    }
                     if (!retarray)
                         return ret;
                 } else {
diff --git a/regexp.h b/regexp.h
index 8272487212..94389a7aab 100644
--- a/regexp.h
+++ b/regexp.h
@@ -351,6 +351,8 @@ typedef struct regexp_engine {
 #  define RXapif_REGNAMES        0x0800
 #  define RXapif_REGNAMES_COUNT  0x1000
 
+#  define RXapif_NPAR      0x02000 /* %- %+ */
+
 /*
 =for apidoc Am|REGEXP *|SvRX|SV *sv
 
diff --git a/universal.c b/universal.c
index 1e039d1936..75838d4846 100644
--- a/universal.c
+++ b/universal.c
@@ -1195,17 +1195,19 @@ XS(XS_NamedCapture_TIEHASH)
        croak_xs_usage(cv,  "package, ...");
     {
         const char *	package = (const char *)SvPV_nolen(ST(0));
-        UV flag = RXapif_ONE;
+        UV all = RXapif_ONE, npar = 0;
         mark += 2;
         while(mark < sp) {
             STRLEN len;
             const char *p = SvPV_const(*mark, len);
             if(memEQs(p, len, "all"))
-                flag = SvTRUE(mark[1]) ? RXapif_ALL : RXapif_ONE;
+                all = SvTRUE(mark[1]) ? RXapif_ALL : RXapif_ONE;
+            else if(memEQs(p, len, "npar"))
+                npar = SvTRUE(mark[1]) ? RXapif_NPAR : 0;
             mark += 2;
         }
         ST(0) = newSV_type_mortal(SVt_IV);
-        sv_setuv(newSVrv(ST(0), package), flag);
+        sv_setuv(newSVrv(ST(0), package), all | npar);
     }
     XSRETURN(1);
 }
-- 
2.25.1.362.g51ebf55



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