diff options
| -rw-r--r-- | av.c | 126 | ||||
| -rw-r--r-- | embed.h | 1 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | proto.h | 1 | ||||
| -rwxr-xr-x | t/op/avhv.t | 59 |
5 files changed, 118 insertions, 70 deletions
@@ -462,16 +462,36 @@ av_fill(register AV *av, I32 fill) (void)av_store(av,fill,&sv_undef); } + +HV* +avhv_keys(AV *av) +{ + SV **keysp; + HV *keys = Nullhv; + + keysp = av_fetch(av, 0, FALSE); + if (keysp) { + if (SvGMAGICAL(*keysp)) + mg_get(*keysp); + if (SvROK(*keysp)) { + SV *hash = SvRV(*keysp); + if (SvTYPE(hash) == SVt_PVHV) + keys = (HV*)hash; + } + } + if (!keys) + croak("Can't coerce array into hash"); + return keys; +} + SV** avhv_fetch(AV *av, char *key, U32 klen, I32 lval) { - SV **keys, **indsvp; + SV **indsvp; + HV *keys = avhv_keys(av); I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - indsvp = hv_fetch((HV*)SvRV(*keys), key, klen, FALSE); + indsvp = hv_fetch(keys, key, klen, FALSE); if (indsvp) { ind = SvIV(*indsvp); if (ind < 1) @@ -481,7 +501,7 @@ avhv_fetch(AV *av, char *key, U32 klen, I32 lval) return 0; ind = AvFILL(av) + 1; - hv_store((HV*)SvRV(*keys), key, klen, newSViv(ind), 0); + hv_store(keys, key, klen, newSViv(ind), 0); } return av_fetch(av, ind, lval); } @@ -489,14 +509,12 @@ avhv_fetch(AV *av, char *key, U32 klen, I32 lval) SV** avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash) { - SV **keys, **indsvp; + SV **indsvp; + HV *keys = avhv_keys(av); HE *he; I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - he = hv_fetch_ent((HV*)SvRV(*keys), keysv, FALSE, hash); + he = hv_fetch_ent(keys, keysv, FALSE, hash); if (he) { ind = SvIV(HeVAL(he)); if (ind < 1) @@ -506,7 +524,7 @@ avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash) return 0; ind = AvFILL(av) + 1; - hv_store_ent((HV*)SvRV(*keys), keysv, newSViv(ind), 0); + hv_store_ent(keys, keysv, newSViv(ind), 0); } return av_fetch(av, ind, lval); } @@ -514,20 +532,18 @@ avhv_fetch_ent(AV *av, SV *keysv, I32 lval, U32 hash) SV** avhv_store(AV *av, char *key, U32 klen, SV *val, U32 hash) { - SV **keys, **indsvp; + SV **indsvp; + HV *keys = avhv_keys(av); I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - indsvp = hv_fetch((HV*)SvRV(*keys), key, klen, FALSE); + indsvp = hv_fetch(keys, key, klen, FALSE); if (indsvp) { ind = SvIV(*indsvp); if (ind < 1) croak("Bad index while coercing array into hash"); } else { ind = AvFILL(av) + 1; - hv_store((HV*)SvRV(*keys), key, klen, newSViv(ind), hash); + hv_store(keys, key, klen, newSViv(ind), hash); } return av_store(av, ind, val); } @@ -535,21 +551,18 @@ avhv_store(AV *av, char *key, U32 klen, SV *val, U32 hash) SV** avhv_store_ent(AV *av, SV *keysv, SV *val, U32 hash) { - SV **keys; + HV *keys = avhv_keys(av); HE *he; I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - he = hv_fetch_ent((HV*)SvRV(*keys), keysv, FALSE, hash); + he = hv_fetch_ent(keys, keysv, FALSE, hash); if (he) { ind = SvIV(HeVAL(he)); if (ind < 1) croak("Bad index while coercing array into hash"); } else { ind = AvFILL(av) + 1; - hv_store_ent((HV*)SvRV(*keys), keysv, newSViv(ind), hash); + hv_store_ent(keys, keysv, newSViv(ind), hash); } return av_store(av, ind, val); } @@ -557,38 +570,27 @@ avhv_store_ent(AV *av, SV *keysv, SV *val, U32 hash) bool avhv_exists_ent(AV *av, SV *keysv, U32 hash) { - SV **keys; - - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - return hv_exists_ent((HV*)SvRV(*keys), keysv, hash); + HV *keys = avhv_keys(av); + return hv_exists_ent(keys, keysv, hash); } bool avhv_exists(AV *av, char *key, U32 klen) { - SV **keys; - - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - return hv_exists((HV*)SvRV(*keys), key, klen); + HV *keys = avhv_keys(av); + return hv_exists(keys, key, klen); } /* avhv_delete leaks. Caller can re-index and compress if so desired. */ SV * avhv_delete(AV *av, char *key, U32 klen, I32 flags) { - SV **keys; + HV *keys = avhv_keys(av); SV *sv; SV **svp; I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - sv = hv_delete((HV*)SvRV(*keys), key, klen, 0); + sv = hv_delete(keys, key, klen, 0); if (!sv) return Nullsv; ind = SvIV(sv); @@ -611,15 +613,12 @@ avhv_delete(AV *av, char *key, U32 klen, I32 flags) SV * avhv_delete_ent(AV *av, SV *keysv, I32 flags, U32 hash) { - SV **keys; + HV *keys = avhv_keys(av); SV *sv; SV **svp; I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - sv = hv_delete_ent((HV*)SvRV(*keys), keysv, 0, hash); + sv = hv_delete_ent(keys, keysv, 0, hash); if (!sv) return Nullsv; ind = SvIV(sv); @@ -641,36 +640,25 @@ avhv_delete_ent(AV *av, SV *keysv, I32 flags, U32 hash) I32 avhv_iterinit(AV *av) { - SV **keys; - - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - return hv_iterinit((HV*)SvRV(*keys)); + HV *keys = avhv_keys(av); + return hv_iterinit(keys); } HE * avhv_iternext(AV *av) { - SV **keys; - - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - return hv_iternext((HV*)SvRV(*keys)); + HV *keys = avhv_keys(av); + return hv_iternext(keys); } SV * avhv_iterval(AV *av, register HE *entry) { - SV **keys; + HV *keys = avhv_keys(av); SV *sv; I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - sv = hv_iterval((HV*)SvRV(*keys), entry); + sv = hv_iterval(keys, entry); ind = SvIV(sv); if (ind < 1) croak("Bad index while coercing array into hash"); @@ -680,18 +668,16 @@ avhv_iterval(AV *av, register HE *entry) SV * avhv_iternextsv(AV *av, char **key, I32 *retlen) { - SV **keys; + HV *keys = avhv_keys(av); HE *he; SV *sv; I32 ind; - keys = av_fetch(av, 0, FALSE); - if (!keys || !SvROK(*keys) || SvTYPE(SvRV(*keys)) != SVt_PVHV) - croak("Can't coerce array into hash"); - if ( (he = hv_iternext((HV*)SvRV(*keys))) == NULL) - return NULL; + he = hv_iternext(keys); + if (!he) + return Nullsv; *key = hv_iterkey(he, retlen); - sv = hv_iterval((HV*)SvRV(*keys), he); + sv = hv_iterval(keys, he); ind = SvIV(sv); if (ind < 1) croak("Bad index while coercing array into hash"); @@ -61,6 +61,7 @@ #define avhv_iternext Perl_avhv_iternext #define avhv_iternextsv Perl_avhv_iternextsv #define avhv_iterval Perl_avhv_iterval +#define avhv_keys Perl_avhv_keys #define avhv_store Perl_avhv_store #define avhv_store_ent Perl_avhv_store_ent #define band_amg Perl_band_amg diff --git a/global.sym b/global.sym index 2806ac622a..f2352f3469 100644 --- a/global.sym +++ b/global.sym @@ -322,6 +322,7 @@ avhv_iterinit avhv_iternext avhv_iternextsv avhv_iterval +avhv_keys avhv_store avhv_store_ent av_clear @@ -24,6 +24,7 @@ I32 avhv_iterinit _((AV *ar)); HE* avhv_iternext _((AV *ar)); SV * avhv_iternextsv _((AV *ar, char** key, I32* retlen)); SV* avhv_iterval _((AV *ar, HE* entry)); +HV* avhv_keys _((AV *ar)); SV** avhv_store _((AV *ar, char* key, U32 klen, SV* val, U32 hash)); void av_clear _((AV* ar)); void av_extend _((AV* ar, I32 key)); diff --git a/t/op/avhv.t b/t/op/avhv.t new file mode 100755 index 0000000000..0390429d2b --- /dev/null +++ b/t/op/avhv.t @@ -0,0 +1,59 @@ +#!./perl + +package Tie::StdArray; +sub TIEARRAY { bless [], $_[0] } +sub STORE { $_[0]->[$_[1]] = $_[2] } +sub FETCH { $_[0]->[$_[1]] } + +package main; + +print "1..4\n"; + +$sch = { + 'abc' => 1, + 'def' => 2, + 'jkl' => 3, +}; + +# basic normal array +$a = []; +$a->[0] = $sch; + +$a->{'abc'} = 'ABC'; +$a->{'def'} = 'DEF'; +$a->{'jkl'} = 'JKL'; +$a->{'a'} = 'A'; #should extend schema + +@keys = keys %$a; +@values = values %$a; + +if ($#keys == 3 && $#values == 3) {print "ok 1\n";} else {print "not ok 1\n";} + +$i = 0; # stop -w complaints + +while (($key,$value) = each %$a) { + if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) { + $key =~ y/a-z/A-Z/; + $i++ if $key eq $value; + } +} + +if ($i == 4) {print "ok 2\n";} else {print "not ok 2\n";} + +# quick check with tied array +tie @fake, 'Tie::StdArray'; +$a = \@fake; +$a->[0] = $sch; + +$a->{'abc'} = 'ABC'; +if ($a->{'abc'} eq 'ABC') {print "ok 3\n";} else {print "not ok 3\n";} + +# quick check with tied array & tied hash +@INC = ("./lib", "../lib"); +require Tie::Hash; +tie %fake, Tie::StdHash; +%fake = %$sch; +$a->[0] = \%fake; + +$a->{'abc'} = 'ABC'; +if ($a->{'abc'} eq 'ABC') {print "ok 4\n";} else {print "not ok 4\n";} |