Fix up integration 5.003->5.004.

p4raw-id: //depot/perl@19

9 files changed, 147 insertions, 20 deletions

diff --git a/av.c b/av.c
index ca6f00a695..e3d341c361 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 b76c53e8a5..8d01d91642 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 0000000000..4b23e7d731
--- /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 0000000000..d18242c13a
--- /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 b3afec7ac0..fd99e75040 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 6e8e4c1dcd..af615c3385 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 faa66b42e4..e9fad16e57 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 06ba5dfe36..a20ce43a74 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 d72b937415..18f72668b2 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];