From: Vincent Pit <vince@profvince.com>
Date: Tue, 30 Dec 2008 18:31:51 +0000 (+0100)
Subject: Add slice syntax to localize_{elem,delete}
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=commitdiff_plain;h=refs%2Fheads%2Fslice

Add slice syntax to localize_{elem,delete}
---

diff --git a/Upper.xs b/Upper.xs
index e54e42c..5c3dec6 100644
--- a/Upper.xs
+++ b/Upper.xs
@@ -115,8 +115,9 @@ STATIC void su_save_adelete(pTHX_ AV *av, I32 key) {
 
 #endif /* SAVEADELETE */
 
-STATIC void su_save_aelem(pTHX_ AV *av, SV *key, SV *val) {
+STATIC void su_save_aelem(pTHX_ void *av_, SV *key, SV *val) {
 #define su_save_aelem(A, K, V) su_save_aelem(aTHX_ (A), (K), (V))
+ AV *av = av_;
  I32 idx;
  I32 preeminent;
  SV **svp;
@@ -152,8 +153,9 @@ STATIC I32 su_hv_preeminent(pTHX_ HV *hv, SV *keysv) {
  return 1;
 }
 
-STATIC void su_save_helem(pTHX_ HV *hv, SV *keysv, SV *val) {
+STATIC void su_save_helem(pTHX_ void *hv_, SV *keysv, SV *val) {
 #define su_save_helem(H, K, V) su_save_helem(aTHX_ (H), (K), (V))
+ HV *hv = hv_;
  I32 preeminent;
  HE *he;
  SV **svp;
@@ -271,6 +273,32 @@ typedef struct {
  SV *elem;
 } su_ud_localize;
 
+STATIC void su_localize_elem(pTHX_ void *obj, SV *elem, SV *val, void (*do_elem)(pTHX_ void *, SV *, SV *)) {
+#define su_localize_elem(O, E, V, D) su_localize_elem(aTHX_ (O), (E), (V), (D))
+ AV *aelem, *aval;
+ if (SvROK(elem) && (aelem = (AV *) SvRV(elem), SvTYPE(aelem) == SVt_PVAV)) {
+  I32 i, last = av_len(aelem);
+  SV **svpe, **svpv;
+  if (!val) {
+   for (i = 0; i <= last; ++i) {
+    svpe = av_fetch(aelem, i, 0);
+    if (!svpe) continue;
+    do_elem(aTHX_ obj, *svpe, NULL);
+   }
+  } else if (SvROK(val) && (aval = (AV *) SvRV(val), SvTYPE(aval) == SVt_PVAV)){
+   for (i = 0; i <= last; ++i) {
+    svpe = av_fetch(aelem, i, 0);
+    if (!svpe) continue;
+    svpv = av_fetch(aval,  i, 0);
+    if (!svpv) continue;
+    do_elem(aTHX_ obj, *svpe, *svpv);
+   }
+  }
+ } else {
+  do_elem(aTHX_ obj, elem, val);
+ }
+}
+
 STATIC void su_localize(pTHX_ void *ud_) {
 #define su_localize(U) su_localize(aTHX_ (U))
  su_ud_localize *ud = (su_ud_localize *) ud_;
@@ -332,16 +360,14 @@ STATIC void su_localize(pTHX_ void *ud_) {
  switch (t) {
   case SVt_PVAV:
    if (elem) {
-    AV *av = GvAV(gv);
-    su_save_aelem(av, elem, val);
+    su_localize_elem(GvAV(gv), elem, val, su_save_aelem);
     goto done;
    } else
     save_ary(gv);
    break;
   case SVt_PVHV:
    if (elem) {
-    HV *hv = GvHV(gv);
-    su_save_helem(hv, elem, val);
+    su_localize_elem(GvHV(gv), elem, val, su_save_helem);
     goto done;
    } else
     save_hash(gv);
@@ -553,7 +579,7 @@ void
 localize_elem(SV *sv, SV *elem, SV *val, ...)
 PROTOTYPE: $$$;$
 PREINIT:
- I32 level = 0;
+ I32 level = 0, slots = 1;
  su_ud_localize *ud;
 CODE:
  SU_GET_LEVEL(3);
@@ -565,13 +591,15 @@ CODE:
  ud->val  = newSVsv(val);
  SvREFCNT_inc(elem);
  ud->elem = elem;
- su_init(level, ud, 4);
+ if (SvROK(elem) && (elem = SvRV(elem), SvTYPE(elem) == SVt_PVAV))
+  slots = 1 + av_len((AV *) elem);
+ su_init(level, ud, slots * 4);
 
 void
 localize_delete(SV *sv, SV *elem, ...)
 PROTOTYPE: $$;$
 PREINIT:
- I32 level = 0;
+ I32 level = 0, slots = 1;
  su_ud_localize *ud;
 CODE:
  SU_GET_LEVEL(2);
@@ -583,4 +611,6 @@ CODE:
  ud->val  = NULL;
  SvREFCNT_inc(elem);
  ud->elem = elem;
- su_init(level, ud, 4);
+ if (SvROK(elem) && (elem = SvRV(elem), SvTYPE(elem) == SVt_PVAV))
+  slots = 1 + av_len((AV *) elem);
+ su_init(level, ud, slots * 3);
diff --git a/t/39-localize_elem-target.t b/t/39-localize_elem-target.t
index ecff42b..9afafbe 100644
--- a/t/39-localize_elem-target.t
+++ b/t/39-localize_elem-target.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 17;
+use Test::More tests => 22;
 
 use Scope::Upper qw/localize_elem/;
 
@@ -29,6 +29,15 @@ our @a;
  is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", 4, 8, 0 [end]';
 }
 
+{
+ local @a = (4 .. 6);
+ {
+  localize_elem '@main::a', [ 2, 4 ], [ 7, 8 ], 0;
+  is_deeply \@a, [ 4, 5, 7, undef, 8 ], 'localize_elem "@a", [ 2, 4 ], [ 7, 8 ], 0 [ok]';
+ }
+ is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", [ 2, 4], [ 7, 8 ], 0 [end]';
+}
+
 {
  local @a = (4 .. 6);
  {
@@ -55,6 +64,19 @@ our @a;
  is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", 4, 12, 1 [end]';
 }
 
+{
+ local @a = (4 .. 6);
+ {
+  local @a = (5 .. 7);
+  {
+   localize_elem '@main::a', [ 3, 4 ], [ 11, 12 ], 1;
+   is_deeply \@a, [ 5 .. 7 ], 'localize_elem "@a", [ 2, 4 ], [ 11, 12 ], 1 [not yet]';
+  }
+  is_deeply \@a, [ 5, 6, 7, 11, 12 ], 'localize_elem "@a", [ 2, 4 ], [ 11, 12 ], 1 [ok]';
+ }
+ is_deeply \@a, [ 4 .. 6 ], 'localize_elem "@a", [ 2, 4 ], [ 11, 12 ], 1 [end]';
+}
+
 # Hashes
 
 our %h;