From: Ilya Zakharevich Date: Tue, 21 Jul 1998 23:00:35 +0000 (-0400) Subject: support match indices via special variables @- and @+ X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6cef1e77274f883a8b06f0546efeff6e6b8660d8;p=p5sagit%2Fp5-mst-13.2.git support match indices via special variables @- and @+ Message-Id: <199807220300.XAA16081@monk.mps.ohio-state.edu> Subject: [PATCH 5.004_76] @- and @+ p4raw-id: //depot/perl@1800 --- diff --git a/av.c b/av.c index b5c9bc2..af463cb 100644 --- a/av.c +++ b/av.c @@ -162,7 +162,7 @@ av_fetch(register AV *av, I32 key, I32 lval) } if (SvRMAGICAL(av)) { - if (mg_find((SV*)av,'P')) { + if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) { dTHR; sv = sv_newmortal(); mg_copy((SV*)av, sv, 0, key); diff --git a/embed.h b/embed.h index 48c4289..c5338d3 100644 --- a/embed.h +++ b/embed.h @@ -319,6 +319,8 @@ #define magic_len Perl_magic_len #define magic_mutexfree Perl_magic_mutexfree #define magic_nextpack Perl_magic_nextpack +#define magic_regdata_cnt Perl_magic_regdata_cnt +#define magic_regdatum_get Perl_magic_regdatum_get #define magic_set Perl_magic_set #define magic_set_all_env Perl_magic_set_all_env #define magic_setamagic Perl_magic_setamagic diff --git a/global.sym b/global.sym index 09667da..c4f2229 100644 --- a/global.sym +++ b/global.sym @@ -417,6 +417,8 @@ magic_getvec magic_len magic_mutexfree magic_nextpack +magic_regdata_cnt +magic_regdatum_get magic_set magic_set_all_env magic_setamagic diff --git a/gv.c b/gv.c index 03b90c0..a7e2b80 100644 --- a/gv.c +++ b/gv.c @@ -729,6 +729,14 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type) } } goto magicalize; + case '-': + if (len > 1) + break; + else { + AV* av = GvAVn(gv); + sv_magic((SV*)av, Nullsv, 'D', Nullch, 0); + } + goto magicalize; case '#': case '*': if (ckWARN(WARN_DEPRECATED) && len == 1 && sv_type == SVt_PV) @@ -738,7 +746,6 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type) case '^': case '~': case '=': - case '-': case '%': case '.': case '(': @@ -763,8 +770,19 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type) if (len > 1) break; goto magicalize; + case '\023': + if (len > 1) + break; + goto ro_magicalize; case '+': + if (len > 1) + break; + else { + AV* av = GvAVn(gv); + sv_magic((SV*)av, (SV*)av, 'D', Nullch, 0); + } + /* FALL THROUGH */ case '1': case '2': case '3': @@ -774,7 +792,6 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type) case '7': case '8': case '9': - case '\023': ro_magicalize: SvREADONLY_on(GvSV(gv)); magicalize: diff --git a/mg.c b/mg.c index f003905..185b4f5 100644 --- a/mg.c +++ b/mg.c @@ -282,6 +282,48 @@ mg_free(SV *sv) #include #endif +int +magic_regdata_cnt(SV *sv, MAGIC *mg) +{ + dTHR; + register char *s; + register I32 i; + register REGEXP *rx; + char *t; + + if (PL_curpm && (rx = PL_curpm->op_pmregexp)) + return rx->lastparen; + return -1; +} + +int +magic_regdatum_get(SV *sv, MAGIC *mg) +{ + dTHR; + register I32 paren; + register char *s; + register I32 i; + register REGEXP *rx; + char *t; + + if (PL_curpm && (rx = PL_curpm->op_pmregexp)) { + paren = mg->mg_len; + if (paren < 0) + return 0; + if (paren <= rx->nparens && + (s = rx->startp[paren]) && + (t = rx->endp[paren])) + { + if (mg->mg_obj) /* @+ */ + i = t - rx->subbase; + else /* @- */ + i = s - rx->subbase; + sv_setiv(sv,i); + } + } + return 0; +} + U32 magic_len(SV *sv, MAGIC *mg) { diff --git a/objXSUB.h b/objXSUB.h index a3ddde7..eee1178 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -1198,6 +1198,10 @@ #define magic_mutexfree pPerl->Perl_magic_mutexfree #undef magic_nextpack #define magic_nextpack pPerl->Perl_magic_nextpack +#undef magic_regdata_cnt +#define magic_regdata_cnt pPerl->Perl_magic_regdata_cnt +#undef magic_regdatum_get +#define magic_regdatum_get pPerl->Perl_magic_regdatum_get #undef magic_set #define magic_set pPerl->Perl_magic_set #undef magic_set_all_env diff --git a/objpp.h b/objpp.h index d10bfe7..ea4ab7a 100644 --- a/objpp.h +++ b/objpp.h @@ -640,6 +640,10 @@ #define magic_methpack CPerlObj::magic_methpack #undef magic_nextpack #define magic_nextpack CPerlObj::Perl_magic_nextpack +#undef magic_regdata_cnt +#define magic_regdata_cnt CPerlObj::Perl_magic_regdata_cnt +#undef magic_regdatum_get +#define magic_regdatum_get CPerlObj::Perl_magic_regdatum_get #undef magic_set #define magic_set CPerlObj::Perl_magic_set #undef magic_set_all_env diff --git a/perl.h b/perl.h index 547dc87..0f7fe6d 100644 --- a/perl.h +++ b/perl.h @@ -2179,6 +2179,8 @@ EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem, 0, 0, 0}; EXT MGVTBL vtbl_regexp = {0,0,0,0, magic_freeregexp}; +EXT MGVTBL vtbl_regdata = {0, 0, magic_regdata_cnt, 0, 0}; +EXT MGVTBL vtbl_regdatum = {magic_regdatum_get, 0, 0, 0, 0}; #ifdef USE_LOCALE_COLLATE EXT MGVTBL vtbl_collxfrm = {0, @@ -2223,6 +2225,8 @@ EXT MGVTBL vtbl_mutex; EXT MGVTBL vtbl_defelem; EXT MGVTBL vtbl_regexp; +EXT MGVTBL vtbl_regdata; +EXT MGVTBL vtbl_regdatum; #ifdef USE_LOCALE_COLLATE EXT MGVTBL vtbl_collxfrm; diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 2ed3e97..739dd55 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -164,6 +164,18 @@ example: (Mnemonic: be positive and forward looking.) This variable is read-only. +=item @+ + +$+[0] is the offset of the end of the last successfull match. +C<$+[>IC<]> is the offset of the end of the substring matched by +I-th subpattern. + +Thus after a match against $_, $& coincides with C. Similarly, C<$>I coincides with CIC<], +$+[>I<0>C<]> if C<$-[>IC<]> is defined, and $+ conincides with +C. One can use C<$#+> to find the last +matched subgroup in the last successful match. Compare with L<"@-">. + =item $MULTILINE_MATCHING =item $* @@ -373,6 +385,18 @@ output channel. Default is 60. (Mnemonic: = has horizontal lines.) The number of lines left on the page of the currently selected output channel. (Mnemonic: lines_on_page - lines_printed.) +=item @- + +$-[0] is the offset of the start of the last successfull match. +C<$-[>IC<]> is the offset of the start of the substring matched by +I-th subpattern. + +Thus after a match against $_, $& coincides with C. Similarly, C<$>I coincides with CIC<], +$+[>I<0>C<]> if C<$-[>IC<]> is defined, and $+ conincides with +C. One can use C<$#-> to find the last +matched subgroup in the last successful match. Compare with L<"@+">. + =item format_name HANDLE EXPR =item $FORMAT_NAME diff --git a/proto.h b/proto.h index 96bb15c..02d7a7e 100644 --- a/proto.h +++ b/proto.h @@ -267,6 +267,8 @@ VIRTUAL U32 magic_len _((SV* sv, MAGIC* mg)); VIRTUAL int magic_mutexfree _((SV* sv, MAGIC* mg)); #endif /* USE_THREADS */ VIRTUAL int magic_nextpack _((SV* sv, MAGIC* mg, SV* key)); +VIRTUAL int magic_regdata_cnt _((SV* sv, MAGIC* mg)); +VIRTUAL int magic_regdatum_get _((SV* sv, MAGIC* mg)); VIRTUAL int magic_set _((SV* sv, MAGIC* mg)); #ifdef OVERLOAD VIRTUAL int magic_setamagic _((SV* sv, MAGIC* mg)); diff --git a/sv.c b/sv.c index c87189c..c2e5fa7 100644 --- a/sv.c +++ b/sv.c @@ -2605,6 +2605,12 @@ sv_magic(register SV *sv, SV *obj, int how, char *name, I32 namlen) case 'B': mg->mg_virtual = &vtbl_bm; break; + case 'D': + mg->mg_virtual = &vtbl_regdata; + break; + case 'd': + mg->mg_virtual = &vtbl_regdatum; + break; case 'E': mg->mg_virtual = &vtbl_env; break; diff --git a/t/op/pat.t b/t/op/pat.t index 7d4278f..aec5f31 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -4,7 +4,7 @@ # the format supported by op/regexp.t. If you want to add a test # that does fit that format, add it to op/re_tests, not here. -print "1..141\n"; +print "1..158\n"; BEGIN { chdir 't' if -d 't'; @@ -595,3 +595,79 @@ print "not " if @_; print "ok $test\n"; $test++; +/a(?=.$)/; +print "not " if $#+ != 0 or $#- != 0; +print "ok $test\n"; +$test++; + +print "not " if $+[0] != 2 or $-[0] != 1; +print "ok $test\n"; +$test++; + +print "not " + if defined $+[1] or defined $-[1] or defined $+[2] or defined $-[2]; +print "ok $test\n"; +$test++; + +/a(a)(a)/; +print "not " if $#+ != 2 or $#- != 2; +print "ok $test\n"; +$test++; + +print "not " if $+[0] != 3 or $-[0] != 0; +print "ok $test\n"; +$test++; + +print "not " if $+[1] != 2 or $-[1] != 1; +print "ok $test\n"; +$test++; + +print "not " if $+[2] != 3 or $-[2] != 2; +print "ok $test\n"; +$test++; + +print "not " + if defined $+[3] or defined $-[3] or defined $+[4] or defined $-[4]; +print "ok $test\n"; +$test++; + +/.(a)(b)?(a)/; +print "not " if $#+ != 3 or $#- != 3; +print "ok $test\n"; +$test++; + +print "not " if $+[0] != 3 or $-[0] != 0; +print "ok $test\n"; +$test++; + +print "not " if $+[1] != 2 or $-[1] != 1; +print "ok $test\n"; +$test++; + +print "not " if $+[3] != 3 or $-[3] != 2; +print "ok $test\n"; +$test++; + +print "not " + if defined $+[2] or defined $-[2] or defined $+[4] or defined $-[4]; +print "ok $test\n"; +$test++; + +/.(a)/; +print "not " if $#+ != 1 or $#- != 1; +print "ok $test\n"; +$test++; + +print "not " if $+[0] != 2 or $-[0] != 0; +print "ok $test\n"; +$test++; + +print "not " if $+[1] != 2 or $-[1] != 1; +print "ok $test\n"; +$test++; + +print "not " + if defined $+[2] or defined $-[2] or defined $+[3] or defined $-[3]; +print "ok $test\n"; +$test++; + diff --git a/toke.c b/toke.c index 62d54c6..2381be3 100644 --- a/toke.c +++ b/toke.c @@ -2612,7 +2612,7 @@ yylex(void) } } - if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$:", s[2]))) { + if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$:+-", s[2]))) { if (PL_expect == XOPERATOR) no_op("Array length", PL_bufptr); PL_tokenbuf[0] = '@';