Add support for named arrays.
authorPeter Martini <PeterCMartini@GMail.com>
Mon, 8 Oct 2012 06:07:57 +0000 (02:07 -0400)
committerPeter Martini <PeterCMartini@GMail.com>
Wed, 17 Oct 2012 20:36:13 +0000 (16:36 -0400)
Remove the TODO from the tests.
This still doesn't enforce the restriction that it must be last.

pp_hot.c
t/comp/namedproto.t
toke.c

index 45e155c..d7aed31 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2721,14 +2721,42 @@ try_autoload:
 
            /* If we're using subroutine signatures, and there's something to copy, do it */
            if (namecnt) {
-               I32 max = items < namecnt ? items : namecnt;
+               const bool greedy = SvTYPE(PAD_SVl(namecnt)) >= SVt_PVAV ? TRUE: FALSE;
+               I32 max = items < namecnt ? items : greedy ? namecnt - 1 : namecnt;
                SV ** source = AvARRAY(av);
                UV saveclearval = SAVEt_CLEARSV;
+               SSCHECK(max + (I32)greedy);
+               if (items >= namecnt) {
+                   if (SvTYPE(PAD_SVl(namecnt)) < SVt_PVAV) {
+                       sv_setsv(PAD_SVl(namecnt), source[namecnt-1]);
+                       --max;
+                   }
+                   else if (SvTYPE(PAD_SVl(namecnt)) == SVt_PVAV) {
+                       SV ** ary;
+                       AV * const av = (AV *)PAD_SVl(namecnt);
+                       SvPADSTALE_off(av);
+                       av_extend(av, items - namecnt);
+                       AvMAX(av) = items - namecnt;
+                       AvFILLp(av) = items - namecnt;
+                       ary = AvARRAY(av);
+                       while (items-- > max) {
+                           ary[items-max] = newSVsv(source[items]);
+                           if (*MARK)
+                               SvTEMP_off(*MARK);
+                           MARK++;
+                       }
+                   }
+                   SSPUSHUV(saveclearval + (namecnt-- * (1 << SAVE_TIGHT_SHIFT)));
+                   /* XXX TODO: Refactor, this is for the while(items) check */
+                   if (items < 0)
+                       items = 0;
+               }
+               else if (greedy)
+                   SSPUSHUV(saveclearval + (namecnt-- * (1 << SAVE_TIGHT_SHIFT)));
                while (namecnt > max) {
                    sv_setsv(PAD_SVl(namecnt), &PL_sv_undef);
                    --namecnt;
                }
-               SSCHECK(max);
                while (max) {
                    sv_setsv(PAD_SVl(max), source[max-1]);
                    SvPADSTALE_off(PAD_SVl(max));
index 097a7dc..524f409 100644 (file)
@@ -115,11 +115,10 @@ use feature 'experimental::sub_signature';
 # Arrays (@array = ()) silences the used only once warning)
 sub greedyarray(@array){return $#array; @array = ();}
 BEGIN {
-    local $TODO = "Named arrays not yet implemented";
     no_warnings("named arrays");
     my @array = qw(1 2 3);
-    is(greedyarray(@array),2);
-    is(greedyarray(1,2,3),2);
+    is(greedyarray(@array),2,"Named array using a literal array");
+    is(greedyarray(1,2,3),2,"Named array using a list of args");
 }
 
 # Hashes (%hash = ()) silences the used only once warning)
diff --git a/toke.c b/toke.c
index 12dbffd..0a73a2c 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -8952,7 +8952,7 @@ S_scan_named_proto (pTHX_ SV *sv, bool * bad)
     proto = SvPV(sv, protolen);
     while (*proto) {
        while (isSPACE(*proto)) proto++;
-       if (strchr("$", *proto)) {
+       if (strchr("$@", *proto)) {
            token[0] = *proto++;
            proto = scan_word(proto, token+1, sizeof(token) - 1, FALSE, &len);
            if (len) {
@@ -8988,6 +8988,7 @@ S_scan_named_proto (pTHX_ SV *sv, bool * bad)
     for (index = 0; index < argcount; index++) {
        SV * pad_name;
        SV * proto_name = AvARRAY(protolist)[index];
+       const char proto_type = SvPVX(proto_name)[0];
        const int pad_ix = pad_add_name_pv(SvPV_nolen(proto_name), 0, NULL, NULL);
        /* The named parameters must be the first entries in the pad */
        assert(pad_ix == index + 1);
@@ -8995,6 +8996,10 @@ S_scan_named_proto (pTHX_ SV *sv, bool * bad)
        /* Mark the entries as in scope */
        ((XPVNV*)SvANY(pad_name))->xnv_u.xpad_cop_seq.xlow = PL_cop_seqmax;
        ((XPVNV*)SvANY(pad_name))->xnv_u.xpad_cop_seq.xhigh = PERL_PADSEQ_INTRO;
+       /* Upgrade to an array if needed */
+       if (proto_type == '@') {
+           sv_upgrade(PAD_SVl(pad_ix), SVt_PVAV);
+       }
     }
     sv_free(MUTABLE_SV(protolist));
     PL_cop_seqmax++;