diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2011-10-21 05:58:40 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2011-10-21 22:12:59 -0700 |
| commit | b82b06b8ca329f89b70366e25afb8e2be30b446e (patch) | |
| tree | 2048b9c510b101230175661356eae7ca5d1f4ba6 /gv.c | |
| parent | 0be9b861b326969b378910bfcdea3f19d0d42992 (diff) | |
| download | perl-b82b06b8ca329f89b70366e25afb8e2be30b446e.tar.gz | |
Reimplement $[ as a module
This commit reimplements $[ using PL_check hooks, custom pp func-
tions and ties.
Outside of its compile-time use, $[ is now parsed as a simple varia-
ble, so function calls like foo($[) are permitted, which was not the
case with the former implementation removed by e1dccc0. I consider
that a bug fix.
The ‘That use of $[ is unsupported’ errors are out of necessity
deferred to run-time and implemented by a tied $[.
Indices between 0 and the array base are now treated consistently, as
are indices between a negative array base and zero. That, too, is
a bug fix.
Diffstat (limited to 'gv.c')
| -rw-r--r-- | gv.c | 24 |
1 files changed, 17 insertions, 7 deletions
@@ -1278,6 +1278,7 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methp char varname = *varpv; /* varpv might be clobbered by load_module, so save it. For the moment it's always a single char. */ + const char type = varname == '[' ? '$' : '%'; dSP; ENTER; if ( flags & 1 ) @@ -1289,11 +1290,11 @@ S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methp SPAGAIN; stash = gv_stashsv(namesv, 0); if (!stash) - Perl_croak(aTHX_ "panic: Can't use %%%c because %"SVf" is not available", - varname, SVfARG(namesv)); + Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" is not available", + type, varname, SVfARG(namesv)); else if (!gv_fetchmethod(stash, methpv)) - Perl_croak(aTHX_ "panic: Can't use %%%c because %"SVf" does not support method %s", - varname, SVfARG(namesv), methpv); + Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" does not support method %s", + type, varname, SVfARG(namesv), methpv); } SvREFCNT_dec(namesv); return stash; @@ -1659,12 +1660,15 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, if (add) { GvMULTI_on(gv); gv_init_svtype(gv, sv_type); - if (len == 1 && stash == PL_defstash - && (sv_type == SVt_PVHV || sv_type == SVt_PVGV)) { + if (len == 1 && stash == PL_defstash) { + if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) { if (*name == '!') require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1); else if (*name == '-' || *name == '+') require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0); + } + if ((sv_type==SVt_PV || sv_type==SVt_PVGV) && *name == '[') + require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0); } else if (len == 3 && sv_type == SVt_PVAV && strnEQ(name, "ISA", 3) @@ -1940,6 +1944,13 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, hv_magic(hv, NULL, PERL_MAGIC_hints); } goto magicalize; + case '[': /* $[ */ + if (sv_type == SVt_PV || sv_type == SVt_PVGV) { + if (addmg) (void)hv_store(stash,name,len,(SV *)gv,0); + require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0); + addmg = 0; + } + break; case '\023': /* $^S */ ro_magicalize: SvREADONLY_on(GvSVn(gv)); @@ -1954,7 +1965,6 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, case '7': /* $7 */ case '8': /* $8 */ case '9': /* $9 */ - case '[': /* $[ */ case '^': /* $^ */ case '~': /* $~ */ case '=': /* $= */ |