X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Upper.xs;h=b2344b9804c0be57573c894ad2080a60e9981cb3;hb=a545c82bdedb5a73447abc668f30e73367711a99;hp=dd43b202233ce180ecd5cc901553858c32de3df7;hpb=44bf1ddcf3a97b602ae2c3ff267375989e5a4dfd;p=perl%2Fmodules%2FScope-Upper.git diff --git a/Upper.xs b/Upper.xs index dd43b20..b2344b9 100644 --- a/Upper.xs +++ b/Upper.xs @@ -71,18 +71,6 @@ /* ... Saving array elements ............................................... */ -STATIC I32 su_av_preeminent(pTHX_ AV *av, I32 key) { -#define su_av_preeminent(A, K) su_av_preeminent(aTHX_ (A), (K)) - MAGIC *mg; - HV *stash; - - if (!av) return 0; - if (SvCANEXISTDELETE(av)) - return av_exists(av, key); - - return 1; -} - #ifndef SAVEADELETE typedef struct { @@ -115,34 +103,54 @@ STATIC void su_save_adelete(pTHX_ AV *av, I32 key) { #endif /* SAVEADELETE */ -STATIC void su_save_aelem(pTHX_ AV *av, I32 key, SV **svp, I32 preeminent) { -#define su_save_aelem(A, K, S, P) su_save_aelem(aTHX_ (A), (K), (S), (P)) +STATIC void su_save_aelem(pTHX_ AV *av, SV *key, SV *val) { +#define su_save_aelem(A, K, V) su_save_aelem(aTHX_ (A), (K), (V)) + I32 idx = SvIV(key); + I32 preeminent = 1; + SV **svp; + HV *stash; + MAGIC *mg; + + if (SvCANEXISTDELETE(av)) + preeminent = av_exists(av, idx); + + svp = av_fetch(av, idx, 1); + if (!*svp || *svp == &PL_sv_undef) croak(PL_no_aelem, idx); + if (preeminent) - save_aelem(av, key, svp); + save_aelem(av, idx, svp); else - SAVEADELETE(av, key); + SAVEADELETE(av, idx); + + if (val) { /* local $x[$idx] = $val; */ + SvSetMagicSV(*svp, val); + } else { /* local $x[$idx]; delete $x[$idx]; */ + av_delete(av, idx, G_DISCARD); + } } /* ... Saving hash elements ................................................ */ -STATIC I32 su_hv_preeminent(pTHX_ HV *hv, SV *keysv) { -#define su_hv_preeminent(H, K) su_hv_preeminent(aTHX_ (H), (K)) - MAGIC *mg; +STATIC void su_save_helem(pTHX_ HV *hv, SV *keysv, SV *val) { +#define su_save_helem(H, K, V) su_save_helem(aTHX_ (H), (K), (V)) + I32 preeminent = 1; + HE *he; + SV **svp; HV *stash; + MAGIC *mg; - if (!hv) return 0; if (SvCANEXISTDELETE(hv) || mg_find((SV *) hv, PERL_MAGIC_env)) - return hv_exists_ent(hv, keysv, 0); + preeminent = hv_exists_ent(hv, keysv, 0); - return 1; -} + he = hv_fetch_ent(hv, keysv, 1, 0); + svp = he ? &HeVAL(he) : NULL; + if (!svp || *svp == &PL_sv_undef) croak("Modification of non-creatable hash value attempted, subscript \"%s\"", SvPV_nolen_const(*svp)); -STATIC void su_save_helem(pTHX_ HV *hv, SV *keysv, SV **svp, I32 preeminent) { -#define su_save_helem(H, K, S, P) su_save_helem(aTHX_ (H), (K), (S), (P)) if (HvNAME_get(hv) && isGV(*svp)) { save_gp((GV *) *svp, 0); return; } + if (preeminent) save_helem(hv, keysv, svp); else { @@ -151,6 +159,12 @@ STATIC void su_save_helem(pTHX_ HV *hv, SV *keysv, SV **svp, I32 preeminent) { SAVEDELETE(hv, savepvn(key, keylen), SvUTF8(keysv) ? -(I32)keylen : (I32)keylen); } + + if (val) { /* local $x{$keysv} = $val; */ + SvSetMagicSV(*svp, val); + } else { /* local $x{$keysv}; delete $x{$keysv}; */ + hv_delete_ent(hv, keysv, G_DISCARD, HeHASH(he)); + } } /* --- Actions ------------------------------------------------------------- */ @@ -301,37 +315,15 @@ STATIC void su_localize(pTHX_ void *ud_) { switch (t) { case SVt_PVAV: if (elem) { - I32 idx = SvIV(elem); - AV *av = GvAV(gv); - I32 preeminent = su_av_preeminent(av, idx); - SV **svp = av_fetch(av, idx, 1); - if (!*svp || *svp == &PL_sv_undef) croak(PL_no_aelem, idx); - su_save_aelem(av, idx, svp, preeminent); - gv = (GV *) *svp; - if (val) { /* local $x[$idx] = $val; */ - goto maybe_deref; - } else { /* local $x[$idx]; delete $x[$idx]; */ - av_delete(av, idx, G_DISCARD); - goto done; - } + su_save_aelem(GvAV(gv), elem, val); + goto done; } else save_ary(gv); break; case SVt_PVHV: if (elem) { - HV *hv = GvHV(gv); - I32 preeminent = su_hv_preeminent(hv, elem); - HE *he = hv_fetch_ent(hv, elem, 1, 0); - SV **svp = he ? &HeVAL(he) : NULL; - if (!svp || *svp == &PL_sv_undef) croak("Modification of non-creatable hash value attempted, subscript \"%s\"", SvPV_nolen_const(*svp)); - su_save_helem(hv, elem, svp, preeminent); - gv = (GV *) *svp; - if (val) { /* local $x{$key} = $val; */ - goto maybe_deref; - } else { /* local $x{$key}; delete $x{$key}; */ - hv_delete_ent(hv, elem, G_DISCARD, HeHASH(he)); - goto done; - } + su_save_helem(GvHV(gv), elem, val); + goto done; } else save_hash(gv); break;