support for list assignment to pseudohashes (from John Tobey

<jtobey@john-edwin-tobey.org>)

p4raw-id: //depot/perl@5492

diff --git a/av.c b/av.c
index c7ccfae..1253c12 100644 (file)
--- a/av.c
+++ b/av.c
@@ -805,6 +805,20 @@ S_avhv_index_sv(pTHX_ SV* sv)
     return index;    
 }
 
+STATIC I32
+S_avhv_index(pTHX_ AV *av, SV *keysv, U32 hash)
+{
+    HV *keys;
+    HE *he;
+    STRLEN n_a;
+
+    keys = avhv_keys(av);
+    he = hv_fetch_ent(keys, keysv, FALSE, hash);
+    if (!he)
+        Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
+    return avhv_index_sv(HeVAL(he));
+}
+
 HV*
 Perl_avhv_keys(pTHX_ AV *av)
 {
@@ -824,17 +838,15 @@ Perl_avhv_keys(pTHX_ AV *av)
 }
 
 SV**
+Perl_avhv_store_ent(pTHX_ AV *av, SV *keysv, SV *val, U32 hash)
+{
+    return av_store(av, avhv_index(av, keysv, hash), val);
+}
+
+SV**
 Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash)
 {
-    SV **indsvp;
-    HV *keys = avhv_keys(av);
-    HE *he;
-    STRLEN n_a;
-   
-    he = hv_fetch_ent(keys, keysv, FALSE, hash);
-    if (!he)
-        Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a));
-    return av_fetch(av, avhv_index_sv(HeVAL(he)), lval);
+    return av_fetch(av, avhv_index(av, keysv, hash), lval);
 }
 
 SV *

diff --git a/dump.c b/dump.c
index 3dd9b0e..189d672 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -433,6 +433,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
        if (o->op_type == OP_AASSIGN) {
            if (o->op_private & OPpASSIGN_COMMON)
                sv_catpv(tmpsv, ",COMMON");
+           if (o->op_private & OPpASSIGN_HASH)
+               sv_catpv(tmpsv, ",HASH");
        }
        else if (o->op_type == OP_SASSIGN) {
            if (o->op_private & OPpASSIGN_BACKWARDS)

diff --git a/embed.h b/embed.h
index 21a812d..e6bafff 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -71,6 +71,7 @@
 #define avhv_delete_ent                Perl_avhv_delete_ent
 #define avhv_exists_ent                Perl_avhv_exists_ent
 #define avhv_fetch_ent         Perl_avhv_fetch_ent
+#define avhv_store_ent         Perl_avhv_store_ent
 #define avhv_iternext          Perl_avhv_iternext
 #define avhv_iterval           Perl_avhv_iterval
 #define avhv_keys              Perl_avhv_keys
@@ -825,6 +826,7 @@
 #endif
 #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
 #define avhv_index_sv          S_avhv_index_sv
+#define avhv_index             S_avhv_index
 #endif
 #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
 #define do_trans_CC_simple     S_do_trans_CC_simple
@@ -945,6 +947,8 @@
 #define qsortsv                        S_qsortsv
 #endif
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
+#define do_maybe_phash         S_do_maybe_phash
+#define do_oddball             S_do_oddball
 #define get_db_sub             S_get_db_sub
 #define method_common          S_method_common
 #endif
@@ -1522,6 +1526,7 @@
 #define avhv_delete_ent(a,b,c,d)       Perl_avhv_delete_ent(aTHX_ a,b,c,d)
 #define avhv_exists_ent(a,b,c) Perl_avhv_exists_ent(aTHX_ a,b,c)
 #define avhv_fetch_ent(a,b,c,d)        Perl_avhv_fetch_ent(aTHX_ a,b,c,d)
+#define avhv_store_ent(a,b,c,d)        Perl_avhv_store_ent(aTHX_ a,b,c,d)
 #define avhv_iternext(a)       Perl_avhv_iternext(aTHX_ a)
 #define avhv_iterval(a,b)      Perl_avhv_iterval(aTHX_ a,b)
 #define avhv_keys(a)           Perl_avhv_keys(aTHX_ a)
@@ -2249,6 +2254,7 @@
 #endif
 #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
 #define avhv_index_sv(a)       S_avhv_index_sv(aTHX_ a)
+#define avhv_index(a,b,c)      S_avhv_index(aTHX_ a,b,c)
 #endif
 #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
 #define do_trans_CC_simple(a)  S_do_trans_CC_simple(aTHX_ a)
@@ -2369,6 +2375,8 @@
 #define qsortsv(a,b,c)         S_qsortsv(aTHX_ a,b,c)
 #endif
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
+#define do_maybe_phash(a,b,c,d,e)      S_do_maybe_phash(aTHX_ a,b,c,d,e)
+#define do_oddball(a,b,c)      S_do_oddball(aTHX_ a,b,c)
 #define get_db_sub(a,b)                S_get_db_sub(aTHX_ a,b)
 #define method_common(a,b)     S_method_common(aTHX_ a,b)
 #endif
@@ -2958,6 +2966,8 @@
 #define avhv_exists_ent                Perl_avhv_exists_ent
 #define Perl_avhv_fetch_ent    CPerlObj::Perl_avhv_fetch_ent
 #define avhv_fetch_ent         Perl_avhv_fetch_ent
+#define Perl_avhv_store_ent    CPerlObj::Perl_avhv_store_ent
+#define avhv_store_ent         Perl_avhv_store_ent
 #define Perl_avhv_iternext     CPerlObj::Perl_avhv_iternext
 #define avhv_iternext          Perl_avhv_iternext
 #define Perl_avhv_iterval      CPerlObj::Perl_avhv_iterval
@@ -4404,6 +4414,8 @@
 #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
 #define S_avhv_index_sv                CPerlObj::S_avhv_index_sv
 #define avhv_index_sv          S_avhv_index_sv
+#define S_avhv_index           CPerlObj::S_avhv_index
+#define avhv_index             S_avhv_index
 #endif
 #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
 #define S_do_trans_CC_simple   CPerlObj::S_do_trans_CC_simple
@@ -4616,6 +4628,10 @@
 #define qsortsv                        S_qsortsv
 #endif
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
+#define S_do_maybe_phash       CPerlObj::S_do_maybe_phash
+#define do_maybe_phash         S_do_maybe_phash
+#define S_do_oddball           CPerlObj::S_do_oddball
+#define do_oddball             S_do_oddball
 #define S_get_db_sub           CPerlObj::S_get_db_sub
 #define get_db_sub             S_get_db_sub
 #define S_method_common                CPerlObj::S_method_common

diff --git a/embed.pl b/embed.pl
index bf0b29c..0c568e3 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1354,6 +1354,7 @@ p |I32    |apply          |I32 type|SV** mark|SV** sp
 Ap     |SV*    |avhv_delete_ent|AV *ar|SV* keysv|I32 flags|U32 hash
 Ap     |bool   |avhv_exists_ent|AV *ar|SV* keysv|U32 hash
 Ap     |SV**   |avhv_fetch_ent |AV *ar|SV* keysv|I32 lval|U32 hash
+Ap     |SV**   |avhv_store_ent |AV *ar|SV* keysv|SV* val|U32 hash
 Ap     |HE*    |avhv_iternext  |AV *ar
 Ap     |SV*    |avhv_iterval   |AV *ar|HE* entry
 Ap     |HV*    |avhv_keys      |AV *ar
@@ -2156,6 +2157,7 @@ END_EXTERN_C
 
 #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
 s      |I32    |avhv_index_sv  |SV* sv
+s      |I32    |avhv_index     |AV* av|SV* sv|U32 hash
 #endif
 
 #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
@@ -2287,6 +2289,9 @@ s |void   |qsortsv        |SV ** array|size_t num_elts|SVCOMPARE_t f
 #endif
 
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
+s      |int    |do_maybe_phash |AV *ary|SV **lelem|SV **firstlelem \
+                               |SV **relem|SV **lastrelem
+s      |void   |do_oddball     |HV *hash|SV **relem|SV **firstrelem
 s      |CV*    |get_db_sub     |SV **svp|CV *cv
 s      |SV*    |method_common  |SV* meth|U32* hashp
 #endif

diff --git a/global.sym b/global.sym
index e69747a..e34d5c0 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -24,6 +24,7 @@ Perl_Gv_AMupdate
 Perl_avhv_delete_ent
 Perl_avhv_exists_ent
 Perl_avhv_fetch_ent
+Perl_avhv_store_ent
 Perl_avhv_iternext
 Perl_avhv_iterval
 Perl_avhv_keys

diff --git a/objXSUB.h b/objXSUB.h
index 86200bc..bbe9f7d 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -47,6 +47,10 @@
 #define Perl_avhv_fetch_ent    pPerl->Perl_avhv_fetch_ent
 #undef  avhv_fetch_ent
 #define avhv_fetch_ent         Perl_avhv_fetch_ent
+#undef  Perl_avhv_store_ent
+#define Perl_avhv_store_ent    pPerl->Perl_avhv_store_ent
+#undef  avhv_store_ent
+#define avhv_store_ent         Perl_avhv_store_ent
 #undef  Perl_avhv_iternext
 #define Perl_avhv_iternext     pPerl->Perl_avhv_iternext
 #undef  avhv_iternext

diff --git a/op.c b/op.c
index 9a3a187..adf6aee 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3273,6 +3273,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 
     if (list_assignment(left)) {
        dTHR;
+       OP *curop;
+
        PL_modcount = 0;
        PL_eval_start = right;  /* Grandfathering $[ assignment here.  Bletch.*/
        left = mod(left, OP_AASSIGN);
@@ -3283,12 +3285,19 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
            op_free(right);
            return Nullop;
        }
-       o = newBINOP(OP_AASSIGN, flags,
-               list(force_list(right)),
-               list(force_list(left)) );
+       curop = list(force_list(left));
+       o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
        o->op_private = 0 | (flags >> 8);
+       for (curop = ((LISTOP*)curop)->op_first;
+            curop; curop = curop->op_sibling)
+       {
+           if (curop->op_type == OP_RV2HV &&
+               ((UNOP*)curop)->op_first->op_type != OP_GV) {
+               o->op_private |= OPpASSIGN_HASH;
+               break;
+           }
+       }
        if (!(left->op_private & OPpLVAL_INTRO)) {
-           OP *curop;
            OP *lastop = o;
            PL_generation++;
            for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
@@ -3332,7 +3341,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                lastop = curop;
            }
            if (curop != o)
-               o->op_private = OPpASSIGN_COMMON;
+               o->op_private |= OPpASSIGN_COMMON;
        }
        if (right && right->op_type == OP_SPLIT) {
            OP* tmpop;

diff --git a/op.h b/op.h
index 52b68cb..c9ec2df 100644 (file)
--- a/op.h
+++ b/op.h
@@ -118,6 +118,7 @@ Deprecated.  Use C<GIMME_V> instead.
 
 /* Private for OP_AASSIGN */
 #define OPpASSIGN_COMMON       64      /* Left & right have syms in common. */
+#define OPpASSIGN_HASH         32      /* Assigning to possible pseudohash. */
 
 /* Private for OP_SASSIGN */
 #define OPpASSIGN_BACKWARDS    64      /* Left & right switched. */

diff --git a/perlapi.c b/perlapi.c
index e26f9f1..7c19c22 100644 (file)
--- a/perlapi.c
+++ b/perlapi.c
@@ -103,6 +103,13 @@ Perl_avhv_fetch_ent(pTHXo_ AV *ar, SV* keysv, I32 lval, U32 hash)
     return ((CPerlObj*)pPerl)->Perl_avhv_fetch_ent(ar, keysv, lval, hash);
 }
 
+#undef  Perl_avhv_store_ent
+SV**
+Perl_avhv_store_ent(pTHXo_ AV *ar, SV* keysv, SV* val, U32 hash)
+{
+    return ((CPerlObj*)pPerl)->Perl_avhv_store_ent(ar, keysv, val, hash);
+}
+
 #undef  Perl_avhv_iternext
 HE*
 Perl_avhv_iternext(pTHXo_ AV *ar)

diff --git a/pp_hot.c b/pp_hot.c
index b1bbbc7..d2eef9b 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -621,6 +621,93 @@ PP(pp_rv2hv)
     }
 }
 
+STATIC int
+S_do_maybe_phash(pTHX_ AV *ary, SV **lelem, SV **firstlelem, SV **relem,
+                SV **lastrelem)
+{
+    OP *leftop;
+    SV *tmpstr;
+    I32 i;
+
+    leftop = ((BINOP*)PL_op)->op_last;
+    assert(leftop);
+    assert(leftop->op_type == OP_NULL && leftop->op_targ == OP_LIST);
+    leftop = ((LISTOP*)leftop)->op_first;
+    assert(leftop);
+    /* Skip PUSHMARK and each element already assigned to. */
+    for (i = lelem - firstlelem; i > 0; i--) {
+       leftop = leftop->op_sibling;
+       assert(leftop);
+    }
+    if (leftop->op_type != OP_RV2HV)
+       return 0;
+
+    /* pseudohash */
+    if (av_len(ary) > 0)
+       av_fill(ary, 0);                /* clear all but the fields hash */
+    if (lastrelem >= relem) {
+       while (relem < lastrelem) {     /* gobble up all the rest */
+           SV *tmpstr;
+           assert(relem[0]);
+           assert(relem[1]);
+           /* Avoid a memory leak when avhv_store_ent dies. */
+           tmpstr = sv_newmortal();
+           sv_setsv(tmpstr,relem[1]);  /* value */
+           relem[1] = tmpstr;
+           if (avhv_store_ent(ary,relem[0],tmpstr,0))
+               SvREFCNT_inc(tmpstr);
+           if (SvMAGICAL(ary) != 0 && SvSMAGICAL(tmpstr))
+               mg_set(tmpstr);
+           relem += 2;
+           TAINT_NOT;
+       }
+    }
+    if (relem == lastrelem)
+       return 1;
+    return 2;
+}
+
+STATIC void
+S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
+{
+    if (*relem) {
+       SV *tmpstr;
+       if (ckWARN(WARN_MISC)) {
+           if (relem == firstrelem &&
+               SvROK(*relem) &&
+               (SvTYPE(SvRV(*relem)) == SVt_PVAV ||
+                SvTYPE(SvRV(*relem)) == SVt_PVHV))
+           {
+               Perl_warner(aTHX_ WARN_MISC,
+                           "Reference found where even-sized list expected");
+           }
+           else
+               Perl_warner(aTHX_ WARN_MISC,
+                           "Odd number of elements in hash assignment");
+       }
+       if (SvTYPE(hash) == SVt_PVAV) {
+           /* pseudohash */
+           tmpstr = sv_newmortal();
+           if (avhv_store_ent((AV*)hash,*relem,tmpstr,0))
+               SvREFCNT_inc(tmpstr);
+           if (SvMAGICAL(hash) && SvSMAGICAL(tmpstr))
+               mg_set(tmpstr);
+       }
+       else {
+           HE *didstore;
+           tmpstr = NEWSV(29,0);
+           didstore = hv_store_ent(hash,*relem,tmpstr,0);
+           if (SvMAGICAL(hash)) {
+               if (SvSMAGICAL(tmpstr))
+                   mg_set(tmpstr);
+               if (!didstore)
+                   sv_2mortal(tmpstr);
+           }
+       }
+       TAINT_NOT;
+    }
+}
+
 PP(pp_aassign)
 {
     djSP;
@@ -646,21 +733,22 @@ PP(pp_aassign)
      * special care that assigning the identifier on the left doesn't
      * clobber a value on the right that's used later in the list.
      */
-    if (PL_op->op_private & OPpASSIGN_COMMON) {
+    if (PL_op->op_private & (OPpASSIGN_COMMON)) {
        EXTEND_MORTAL(lastrelem - firstrelem + 1);
-        for (relem = firstrelem; relem <= lastrelem; relem++) {
-            /*SUPPRESS 560*/
-            if (sv = *relem) {
+       for (relem = firstrelem; relem <= lastrelem; relem++) {
+           /*SUPPRESS 560*/
+           if (sv = *relem) {
                TAINT_NOT;      /* Each item is independent */
-                *relem = sv_mortalcopy(sv);
+               *relem = sv_mortalcopy(sv);
            }
-        }
+       }
     }
 
     relem = firstrelem;
     lelem = firstlelem;
     ary = Null(AV*);
     hash = Null(HV*);
+
     while (lelem <= lastlelem) {
        TAINT_NOT;              /* Each item stands on its own, taintwise. */
        sv = *lelem++;
@@ -668,7 +756,19 @@ PP(pp_aassign)
        case SVt_PVAV:
            ary = (AV*)sv;
            magic = SvMAGICAL(ary) != 0;
-           
+           if (PL_op->op_private & OPpASSIGN_HASH) {
+               switch (do_maybe_phash(ary, lelem, firstlelem, relem,
+                                      lastrelem))
+               {
+               case 0:
+                   goto normal_array;
+               case 1:
+                   do_oddball((HV*)ary, relem, firstrelem);
+               }
+               relem = lastrelem + 1;
+               break;
+           }
+       normal_array:
            av_clear(ary);
            av_extend(ary, lastrelem - relem);
            i = 0;
@@ -688,7 +788,7 @@ PP(pp_aassign)
                TAINT_NOT;
            }
            break;
-       case SVt_PVHV: {
+       case SVt_PVHV: {                                /* normal hash */
                SV *tmpstr;
 
                hash = (HV*)sv;
@@ -715,27 +815,7 @@ PP(pp_aassign)
                    TAINT_NOT;
                }
                if (relem == lastrelem) {
-                   if (*relem) {
-                       HE *didstore;
-                       if (ckWARN(WARN_MISC)) {
-                           if (relem == firstrelem &&
-                               SvROK(*relem) &&
-                               ( SvTYPE(SvRV(*relem)) == SVt_PVAV ||
-                                 SvTYPE(SvRV(*relem)) == SVt_PVHV ) )
-                               Perl_warner(aTHX_ WARN_MISC, "Reference found where even-sized list expected");
-                           else
-                               Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
-                       }
-                       tmpstr = NEWSV(29,0);
-                       didstore = hv_store_ent(hash,*relem,tmpstr,0);
-                       if (magic) {
-                           if (SvSMAGICAL(tmpstr))
-                               mg_set(tmpstr);
-                           if (!didstore)
-                               sv_2mortal(tmpstr);
-                       }
-                       TAINT_NOT;
-                   }
+                   do_oddball(hash, relem, firstrelem);
                    relem++;
                }
            }

diff --git a/proto.h b/proto.h
index ae352c7..4ea8472 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -64,6 +64,7 @@ PERL_CALLCONV I32     Perl_apply(pTHX_ I32 type, SV** mark, SV** sp);
 PERL_CALLCONV SV*      Perl_avhv_delete_ent(pTHX_ AV *ar, SV* keysv, I32 flags, U32 hash);
 PERL_CALLCONV bool     Perl_avhv_exists_ent(pTHX_ AV *ar, SV* keysv, U32 hash);
 PERL_CALLCONV SV**     Perl_avhv_fetch_ent(pTHX_ AV *ar, SV* keysv, I32 lval, U32 hash);
+PERL_CALLCONV SV**     Perl_avhv_store_ent(pTHX_ AV *ar, SV* keysv, SV* val, U32 hash);
 PERL_CALLCONV HE*      Perl_avhv_iternext(pTHX_ AV *ar);
 PERL_CALLCONV SV*      Perl_avhv_iterval(pTHX_ AV *ar, HE* entry);
 PERL_CALLCONV HV*      Perl_avhv_keys(pTHX_ AV *ar);
@@ -932,6 +933,7 @@ END_EXTERN_C
 
 #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT)
 STATIC I32     S_avhv_index_sv(pTHX_ SV* sv);
+STATIC I32     S_avhv_index(pTHX_ AV* av, SV* sv, U32 hash);
 #endif
 
 #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT)
@@ -1061,6 +1063,8 @@ STATIC void       S_qsortsv(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t f);
 #endif
 
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
+STATIC int     S_do_maybe_phash(pTHX_ AV *ary, SV **lelem, SV **firstlelem, SV **relem, SV **lastrelem);
+STATIC void    S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem);
 STATIC CV*     S_get_db_sub(pTHX_ SV **svp, CV *cv);
 STATIC SV*     S_method_common(pTHX_ SV* meth, U32* hashp);
 #endif

diff --git a/t/op/avhv.t b/t/op/avhv.t
index 23f9c69..cd7c957 100755 (executable)
--- a/t/op/avhv.t
+++ b/t/op/avhv.t
@@ -1,5 +1,5 @@
 #!./perl
-      
+
 BEGIN {
     chdir 't' if -d 't';
     unshift @INC, '../lib';
@@ -17,7 +17,7 @@ sub STORESIZE { $#{$_[0]} = $_[1]+1 }
 
 package main;
 
-print "1..20\n";
+print "1..28\n";
 
 $sch = {
     'abc' => 1,
@@ -139,3 +139,40 @@ print "ok 19\n";
 
 print "not " unless "$avhv->{bar}" eq "yyy";
 print "ok 20\n";
+
+# hash assignment
+%$avhv = ();
+print "not " unless ref($avhv->[0]) eq 'HASH';
+print "ok 21\n";
+
+%hv = %$avhv;
+print "not " if grep defined, values %hv;
+print "ok 22\n";
+print "not " if grep ref, keys %hv;
+print "ok 23\n";
+
+%$avhv = (foo => 29, pants => 2, bar => 0);
+print "not " unless "@$avhv[1..3]" eq '29 0 2';
+print "ok 24\n";
+
+my $extra;
+my @extra;
+($extra, %$avhv) = ("moo", foo => 42, pants => 53, bar => "HIKE!");
+print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and $extra eq 'moo';
+print "ok 25\n";
+
+%$avhv = ();
+(%$avhv, $extra) = (foo => 42, pants => 53, bar => "HIKE!");
+print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and !defined $extra;
+print "ok 26\n";
+
+@extra = qw(whatever and stuff);
+%$avhv = ();
+(%$avhv, @extra) = (foo => 42, pants => 53, bar => "HIKE!");
+print "not " unless "@$avhv[1..3]" eq '42 HIKE! 53' and @extra == 0;
+print "ok 27\n";
+
+%$avhv = ();
+(@extra, %$avhv) = (foo => 42, pants => 53, bar => "HIKE!");
+print "not " unless ref $avhv->[0] eq 'HASH' and @extra == 6;
+print "ok 28\n";

diff --git a/t/op/hashwarn.t b/t/op/hashwarn.t
index 634e7e1..0b6f10f 100755 (executable)
--- a/t/op/hashwarn.t
+++ b/t/op/hashwarn.t
@@ -14,7 +14,7 @@ BEGIN {
     # ...and save 'em as we go
     $SIG{'__WARN__'} = sub { push @warnings, @_ };
     $| = 1;
-    print "1..7\n";
+    print "1..9\n";
 }
 
 END { print "not ok\n# Uncaught warnings:\n@warnings\n" if @warnings }
@@ -66,6 +66,13 @@ my $ref_msg = '/^Reference found where even-sized list expected/';
     %hash = sub { print "ok" };
     test_warning 6, shift @warnings, $odd_msg;
 
+    my $avhv = [{x=>1,y=>2}];
+    %$avhv = (x=>13,'y');
+    test_warning 7, shift @warnings, $odd_msg;
+
+    %$avhv = 'x';
+    test_warning 8, shift @warnings, $odd_msg;
+
     $_ = { 1..10 };
-    test 7, ! @warnings, "Unexpected warning";
+    test 9, ! @warnings, "Unexpected warning";
 }