From: Malcolm Beattie Date: Sun, 25 May 1997 21:19:38 +0000 (+0000) Subject: Fix up integration 5.003->5.004. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=97fcbf9696d4cdc3d47f383b99d9840ccb39c616;p=p5sagit%2Fp5-mst-13.2.git Fix up integration 5.003->5.004. p4raw-id: //depot/perl@19 --- diff --git a/av.c b/av.c index ca6f00a..e3d341c 100644 --- a/av.c +++ b/av.c @@ -507,6 +507,35 @@ I32 lval; } SV** +avhv_fetch_ent(av, keysv, lval, hash) +AV *av; +SV *keysv; +I32 lval; +U32 hash; +{ + SV **keys, **indsvp; + 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); + if (he) { + ind = SvIV(HeVAL(he)); + if (ind < 1) + croak("Bad index while coercing array into hash"); + } else { + if (!lval) + return 0; + + ind = AvFILL(av) + 1; + hv_store_ent((HV*)SvRV(*keys), keysv, newSViv(ind), 0); + } + return av_fetch(av, ind, lval); +} + +SV** avhv_store(av, key, klen, val, hash) AV *av; char *key; @@ -533,6 +562,20 @@ U32 hash; } bool +avhv_exists_ent(av, keysv, hash) +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); +} + +bool avhv_exists(av, key, klen) AV *av; char *key; @@ -581,6 +624,41 @@ I32 flags; return sv; } +/* avhv_delete_ent leaks. Caller can re-index and compress if so desired. */ +SV * +avhv_delete_ent(av, keysv, flags, hash) +AV *av; +SV *keysv; +I32 flags; +U32 hash; +{ + SV **keys; + 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); + if (!sv) + return Nullsv; + ind = SvIV(sv); + if (ind < 1) + croak("Bad index while coercing array into hash"); + svp = av_fetch(av, ind, FALSE); + if (!svp) + return Nullsv; + if (flags & G_DISCARD) { + sv = Nullsv; + SvREFCNT_dec(*svp); + } else { + sv = sv_2mortal(*svp); + } + *svp = &sv_undef; + return sv; +} + I32 avhv_iterinit(av) AV *av; diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index b76c53e..8d01d91 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -816,16 +816,6 @@ db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_H OUTPUT: RETVAL ->>>> ORIGINAL VERSION -BOOT: - newXS("DB_File::TIEARRAY", XS_DB_File_db_TIEHASH, file); - -==== THEIR VERSION -==== YOUR VERSION -BOOT: - newXS("DB_File::TIEARRAY", XS_DB_File_TIEHASH, file); - -<<<< int db_DESTROY(db) DB_File db diff --git a/lib/Class/Fields.pm b/lib/Class/Fields.pm new file mode 100644 index 0000000..4b23e7d --- /dev/null +++ b/lib/Class/Fields.pm @@ -0,0 +1,33 @@ +package Class::Fields; +use Carp; + +sub import { + my $class = shift; + my ($package) = caller; + my $fields = \%{"$package\::FIELDS"}; + my $i = $fields->{__MAX__}; + foreach my $f (@_) { + if (defined($fields->{$f})) { + croak "Field name $f already used by a base class" + } + $fields->{$f} = ++$i; + } + $fields->{__MAX__} = $i; + push(@{"$package\::ISA"}, "Class::Fields"); +} + +sub new { + my $class = shift; + bless [\%{"$class\::FIELDS"}, @_], $class; +} + +sub ISA { + my ($class, $package) = @_; + my $from_fields = \%{"$class\::FIELDS"}; + my $to_fields = \%{"$package\::FIELDS"}; + return unless defined %$from_fields; + croak "Ambiguous inheritance for %FIELDS" if defined %$to_fields; + %$to_fields = %$from_fields; +} + +1; diff --git a/lib/ISA.pm b/lib/ISA.pm new file mode 100644 index 0000000..d18242c --- /dev/null +++ b/lib/ISA.pm @@ -0,0 +1,20 @@ +package ISA; +use Carp; + +sub import { + my $class = shift; + my ($package) = caller; + foreach my $base (@_) { + croak qq(No such class "$base") unless defined %{"$base\::"}; + eval { + $base->ISA($package); + }; + if ($@ && $@ !~ /^Can't locate object method/) { + $@ =~ s/ at .*? line \d+\n$//; + croak $@; + } + } + push(@{"$package\::ISA"}, @_); +} + +1; diff --git a/perl.c b/perl.c index b3afec7..fd99e75 100644 --- a/perl.c +++ b/perl.c @@ -886,7 +886,7 @@ PerlInterpreter *sv_interp; if (perldb && DBsingle) sv_setiv(DBsingle, 1); if (restartav) - calllist(restartav); + call_list(oldscope, restartav); } /* do it */ diff --git a/pp.c b/pp.c index 6e8e4c1..af615c3 100644 --- a/pp.c +++ b/pp.c @@ -2131,8 +2131,9 @@ PP(pp_delete) if (op->op_private & OPpSLICE) { dMARK; dORIGMARK; + U32 hvtype; hv = (HV*)POPs; - U32 hvtype = SvTYPE(hv); + hvtype = SvTYPE(hv); while (++MARK <= SP) { if (hvtype == SVt_PVHV) sv = hv_delete_ent(hv, *MARK, discard, 0); @@ -2153,9 +2154,12 @@ PP(pp_delete) else { SV *keysv = POPs; hv = (HV*)POPs; - if (SvTYPE(hv) != SVt_PVHV) + if (SvTYPE(hv) == SVt_PVHV) + sv = hv_delete_ent(hv, keysv, discard, 0); + else if (SvTYPE(hv) == SVt_PVAV) + sv = avhv_delete_ent((AV*)hv, keysv, discard, 0); + else DIE("Not a HASH reference"); - sv = hv_delete_ent(hv, keysv, discard, 0); if (!sv) sv = &sv_undef; if (!discard) @@ -2197,7 +2201,7 @@ PP(pp_hslice) he = hv_fetch_ent(hv, keysv, lval, 0); svp = he ? &HeVAL(he) : 0; } else { - svp = avhv_fetch_ent((AV*)hv, keysv, lval); + svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0); } if (lval) { if (!he || HeVAL(he) == &sv_undef) diff --git a/pp_hot.c b/pp_hot.c index faa66b4..e9fad16 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1271,17 +1271,16 @@ PP(pp_helem) if (SvTYPE(hv) == SVt_PVHV) { he = hv_fetch_ent(hv, keysv, lval && !defer, 0); - svp = he ? &Heval(he) : 0; + svp = he ? &HeVAL(he) : 0; } else if (SvTYPE(hv) == SVt_PVAV) { - svp = avhv_fetch_ent((AV*)hv, keysv, lval); + svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, 0); } else { RETPUSHUNDEF; } -<<<< if (lval) { - if (svp || *svp == &sv_undef) { + if (!svp || *svp == &sv_undef) { SV* lv; SV* key2; if (!defer) diff --git a/proto.h b/proto.h index 06ba5df..a20ce43 100644 --- a/proto.h +++ b/proto.h @@ -15,8 +15,11 @@ OP* append_list _((I32 optype, LISTOP* first, LISTOP* last)); I32 apply _((I32 type, SV** mark, SV** sp)); void assertref _((OP* op)); SV* avhv_delete _((AV *ar, char* key, U32 klen, I32 flags)); +SV* avhv_delete_ent _((AV *ar, SV* keysv, I32 flags, U32 hash)); bool avhv_exists _((AV *ar, char* key, U32 klen)); +bool avhv_exists_ent _((AV *ar, SV* keysv, U32 hash)); SV** avhv_fetch _((AV *ar, char* key, U32 klen, I32 lval)); +SV** avhv_fetch_ent _((AV *ar, SV* keysv, I32 lval, U32 hash)); I32 avhv_iterinit _((AV *ar)); HE* avhv_iternext _((AV *ar)); SV * avhv_iternextsv _((AV *ar, char** key, I32* retlen)); diff --git a/toke.c b/toke.c index d72b937..18f7266 100644 --- a/toke.c +++ b/toke.c @@ -3123,7 +3123,7 @@ yylex() in_my = TRUE; s = skipspace(s); if (isIDFIRST(*s)) { - s = scan_word(s, tokenbuf, TRUE, &len); + s = scan_word(s, tokenbuf, sizeof tokenbuf, TRUE, &len); in_my_stash = gv_stashpv(tokenbuf, FALSE); if (!in_my_stash) { char tmpbuf[1024];