integrate changes#1982,2014,2021 (from maint-5.005)

p4raw-link: @2021 on //depot/maint-5.005/perl: ece095e7b265a16d4ec3543b1418100f9c635a87
p4raw-link: @2014 on //depot/maint-5.005/perl: cca0b9804acab4b7678c0f185888d57497a5c2a9
p4raw-link: @1982 on //depot/maint-5.005/perl: fe676099d996f70caaedeb6ae85adc3ee59d2240

p4raw-id: //depot/perl@2059

11 files changed, 99 insertions, 81 deletions

diff --git a/av.c b/av.c
index 5242ffc887..f3c69e76ce 100644
--- a/av.c
+++ b/av.c
@@ -24,7 +24,7 @@ av_reify(AV *av)
     if (AvREAL(av))
 	return;
 #ifdef DEBUGGING
-    if (SvRMAGICAL(av) && mg_find((SV*)av,'P'))
+    if (SvTIED_mg((SV*)av, 'P'))
 	warn("av_reify called on tied array");
 #endif
     key = AvMAX(av) + 1;
@@ -50,14 +50,14 @@ av_extend(AV *av, I32 key)
 {
     dTHR;			/* only necessary if we have to extend stack */
     MAGIC *mg;
-    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+    if (mg = SvTIED_mg((SV*)av, 'P')) {
 	dSP;
 	ENTER;
 	SAVETMPS;
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
 	EXTEND(SP,2);
-	PUSHs(mg->mg_obj);
+	PUSHs(SvTIED_obj((SV*)av, mg));
 	PUSHs(sv_2mortal(newSViv(key+1)));
         PUTBACK;
 	perl_call_method("EXTEND", G_SCALAR|G_DISCARD);
@@ -371,7 +371,7 @@ av_undef(register AV *av)
     /*SUPPRESS 560*/
 
     /* Give any tie a chance to cleanup first */
-    if (SvRMAGICAL(av) && mg_find((SV*)av,'P')) 
+    if (SvTIED_mg((SV*)av, 'P')) 
 	av_fill(av, -1);   /* mg_clear() ? */
 
     if (AvREAL(av)) {
@@ -398,12 +398,12 @@ av_push(register AV *av, SV *val)
     if (SvREADONLY(av))
 	croak(no_modify);
 
-    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+    if (mg = SvTIED_mg((SV*)av, 'P')) {
 	dSP;
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
 	EXTEND(SP,2);
-	PUSHs(mg->mg_obj);
+	PUSHs(SvTIED_obj((SV*)av, mg));
 	PUSHs(val);
 	PUTBACK;
 	ENTER;
@@ -425,11 +425,11 @@ av_pop(register AV *av)
 	return &PL_sv_undef;
     if (SvREADONLY(av))
 	croak(no_modify);
-    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+    if (mg = SvTIED_mg((SV*)av, 'P')) {
 	dSP;    
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
-	XPUSHs(mg->mg_obj);
+	XPUSHs(SvTIED_obj((SV*)av, mg));
 	PUTBACK;
 	ENTER;
 	if (perl_call_method("POP", G_SCALAR)) {
@@ -460,12 +460,12 @@ av_unshift(register AV *av, register I32 num)
     if (SvREADONLY(av))
 	croak(no_modify);
 
-    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+    if (mg = SvTIED_mg((SV*)av, 'P')) {
 	dSP;
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
 	EXTEND(SP,1+num);
-	PUSHs(mg->mg_obj);
+	PUSHs(SvTIED_obj((SV*)av, mg));
 	while (num-- > 0) {
 	    PUSHs(&PL_sv_undef);
 	}
@@ -511,11 +511,11 @@ av_shift(register AV *av)
 	return &PL_sv_undef;
     if (SvREADONLY(av))
 	croak(no_modify);
-    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+    if (mg = SvTIED_mg((SV*)av, 'P')) {
 	dSP;
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
-	XPUSHs(mg->mg_obj);
+	XPUSHs(SvTIED_obj((SV*)av, mg));
 	PUTBACK;
 	ENTER;
 	if (perl_call_method("SHIFT", G_SCALAR)) {
@@ -552,14 +552,14 @@ av_fill(register AV *av, I32 fill)
 	croak("panic: null array");
     if (fill < 0)
 	fill = -1;
-    if (SvRMAGICAL(av) && (mg = mg_find((SV*)av,'P'))) {
+    if (mg = SvTIED_mg((SV*)av, 'P')) {
 	dSP;            
 	ENTER;
 	SAVETMPS;
 	PUSHSTACKi(PERLSI_MAGIC);
 	PUSHMARK(SP);
 	EXTEND(SP,2);
-	PUSHs(mg->mg_obj);
+	PUSHs(SvTIED_obj((SV*)av, mg));
 	PUSHs(sv_2mortal(newSViv(fill+1)));
 	PUTBACK;
 	perl_call_method("STORESIZE", G_SCALAR|G_DISCARD);
diff --git a/doop.c b/doop.c
index 7ed895d2a9..c988bff2aa 100644
--- a/doop.c
+++ b/doop.c
@@ -1061,7 +1061,7 @@ do_kv(ARGSproto)
 	    RETURN;
 	}
 
-	if (!SvRMAGICAL(keys) || !mg_find((SV*)keys,'P'))
+	if (! SvTIED_mg((SV*)keys, 'P'))
 	    i = HvKEYS(keys);
 	else {
 	    i = 0;
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index 1840ca4034..1ef70eb8f2 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -3256,7 +3256,20 @@ SysRet
 sigprocmask(how, sigset, oldsigset = 0)
 	int			how
 	POSIX::SigSet		sigset
-	POSIX::SigSet		oldsigset
+	POSIX::SigSet		oldsigset = NO_INIT
+INIT:
+	if ( items < 3 ) {
+	    oldsigset = 0;
+	}
+	else if (sv_derived_from(ST(2), "POSIX::SigSet")) {
+	    IV tmp = SvIV((SV*)SvRV(ST(2)));
+	    oldsigset = (POSIX__SigSet) tmp;
+	}
+	else {
+	    oldsigset = (sigset_t*)safemalloc(sizeof(sigset_t));
+	    sigemptyset(oldsigset);
+	    sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset);
+	}
 
 SysRet
 sigsuspend(signal_mask)
diff --git a/hv.c b/hv.c
index ddd989fa23..1fad0e2d0e 100644
--- a/hv.c
+++ b/hv.c
@@ -844,7 +844,7 @@ newHVhv(HV *ohv)
 	return hv;
 
 #if 0
-    if (!SvRMAGICAL(ohv) || !mg_find((SV*)ohv,'P')) {
+    if (! SvTIED_mg((SV*)ohv, 'P')) {
 	/* Quick way ???*/
     } 
     else 
@@ -1016,7 +1016,7 @@ hv_iternext(HV *hv)
     xhv = (XPVHV*)SvANY(hv);
     oldentry = entry = xhv->xhv_eiter;
 
-    if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
+    if (mg = SvTIED_mg((SV*)hv, 'P')) {
 	SV *key = sv_newmortal();
 	if (entry) {
 	    sv_setsv(key, HeSVKEY_force(entry));
diff --git a/mg.c b/mg.c
index 49ad9beea9..9532b38742 100644
--- a/mg.c
+++ b/mg.c
@@ -280,7 +280,9 @@ mg_copy(SV *sv, SV *nsv, char *key, I32 klen)
     MAGIC* mg;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
 	if (isUPPER(mg->mg_type)) {
-	    sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen);
+	    sv_magic(nsv,
+		     mg->mg_type == 'P' ? SvTIED_obj(sv, mg) : mg->mg_obj,
+		     toLOWER(mg->mg_type), key, klen);
 	    count++;
 	}
     }
@@ -1039,7 +1041,7 @@ magic_getnkeys(SV *sv, MAGIC *mg)
 
     if (hv) {
 	(void) hv_iterinit(hv);
-	if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
+	if (! SvTIED_mg((SV*)hv, 'P'))
 	    i = HvKEYS(hv);
 	else {
 	    /*SUPPRESS 560*/
@@ -1064,13 +1066,13 @@ magic_setnkeys(SV *sv, MAGIC *mg)
 
 /* caller is responsible for stack switching/cleanup */
 STATIC int
-magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val)
+magic_methcall(SV *sv, MAGIC *mg, char *meth, I32 flags, int n, SV *val)
 {
     dSP;
 
     PUSHMARK(SP);
     EXTEND(SP, n);
-    PUSHs(mg->mg_obj);
+    PUSHs(SvTIED_obj(sv, mg));
     if (n > 1) { 
 	if (mg->mg_ptr) {
 	    if (mg->mg_len >= 0)
@@ -1099,7 +1101,7 @@ magic_methpack(SV *sv, MAGIC *mg, char *meth)
     SAVETMPS;
     PUSHSTACKi(PERLSI_MAGIC);
 
-    if (magic_methcall(mg, meth, G_SCALAR, 2, NULL)) {
+    if (magic_methcall(sv, mg, meth, G_SCALAR, 2, NULL)) {
 	sv_setsv(sv, *PL_stack_sp--);
     }
 
@@ -1124,7 +1126,7 @@ magic_setpack(SV *sv, MAGIC *mg)
     dSP;
     ENTER;
     PUSHSTACKi(PERLSI_MAGIC);
-    magic_methcall(mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
+    magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
     POPSTACK;
     LEAVE;
     return 0;
@@ -1146,7 +1148,7 @@ magic_sizepack(SV *sv, MAGIC *mg)
     ENTER;
     SAVETMPS;
     PUSHSTACKi(PERLSI_MAGIC);
-    if (magic_methcall(mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
+    if (magic_methcall(sv, mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
 	sv = *PL_stack_sp--;
 	retval = (U32) SvIV(sv)-1;
     }
@@ -1163,7 +1165,7 @@ int magic_wipepack(SV *sv, MAGIC *mg)
     ENTER;
     PUSHSTACKi(PERLSI_MAGIC);
     PUSHMARK(SP);
-    XPUSHs(mg->mg_obj);
+    XPUSHs(SvTIED_obj(sv, mg));
     PUTBACK;
     perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
     POPSTACK;
@@ -1182,7 +1184,7 @@ magic_nextpack(SV *sv, MAGIC *mg, SV *key)
     PUSHSTACKi(PERLSI_MAGIC);
     PUSHMARK(SP);
     EXTEND(SP, 2);
-    PUSHs(mg->mg_obj);
+    PUSHs(SvTIED_obj(sv, mg));
     if (SvOK(key))
 	PUSHs(key);
     PUTBACK;
diff --git a/mg.h b/mg.h
index 16efdb5d7a..702699fa71 100644
--- a/mg.h
+++ b/mg.h
@@ -43,3 +43,8 @@ struct magic {
 #define MgPV(mg,lp)		(((lp = (mg)->mg_len) == HEf_SVKEY) ?   \
 				 SvPV((SV*)((mg)->mg_ptr),lp) :		\
 				 (mg)->mg_ptr)
+
+#define SvTIED_mg(sv,how) \
+    (SvRMAGICAL(sv) ? mg_find((sv),(how)) : Null(MAGIC*))
+#define SvTIED_obj(sv,mg) \
+    ((mg)->mg_obj ? (mg)->mg_obj : sv_2mortal(newRV(sv)))
diff --git a/pp.c b/pp.c
index 0bd3a23f48..495b9ea061 100644
--- a/pp.c
+++ b/pp.c
@@ -2761,8 +2761,8 @@ PP(pp_splice)
     SV **tmparyval = 0;
     MAGIC *mg;
 
-    if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
-	*MARK-- = mg->mg_obj;
+    if (mg = SvTIED_mg((SV*)ary, 'P')) {
+	*MARK-- = SvTIED_obj((SV*)ary, mg);
 	PUSHMARK(MARK);
 	PUTBACK;
 	ENTER;
@@ -2959,8 +2959,8 @@ PP(pp_push)
     register SV *sv = &PL_sv_undef;
     MAGIC *mg;
 
-    if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
-	*MARK-- = mg->mg_obj;
+    if (mg = SvTIED_mg((SV*)ary, 'P')) {
+	*MARK-- = SvTIED_obj((SV*)ary, mg);
 	PUSHMARK(MARK);
 	PUTBACK;
 	ENTER;
@@ -3015,8 +3015,8 @@ PP(pp_unshift)
     register I32 i = 0;
     MAGIC *mg;
 
-    if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) {
-	*MARK-- = mg->mg_obj;
+    if (mg = SvTIED_mg((SV*)ary, 'P')) {
+	*MARK-- = SvTIED_obj((SV*)ary, mg);
 	PUSHMARK(MARK);
 	PUTBACK;
 	ENTER;
@@ -4532,9 +4532,9 @@ PP(pp_split)
 	av_extend(ary,0);
 	av_clear(ary);
 	SPAGAIN;
-	if (SvRMAGICAL(ary) && (mg = mg_find((SV *) ary, 'P'))) {
+	if (mg = SvTIED_mg((SV*)ary, 'P')) {
 	    PUSHMARK(SP);
-	    XPUSHs(mg->mg_obj);
+	    XPUSHs(SvTIED_obj((SV*)ary, mg));
 	}
 	else {
 	    if (!AvREAL(ary)) {
diff --git a/pp_hot.c b/pp_hot.c
index e59867ed58..ecd80296d7 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -311,7 +311,7 @@ PP(pp_print)
 	gv = (GV*)*++MARK;
     else
 	gv = PL_defoutgv;
-    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
 	if (MARK == ORIGMARK) {
 	    /* If using default handle then we need to make space to 
 	     * pass object as 1st arg, so move other args up ...
@@ -322,7 +322,7 @@ PP(pp_print)
 	    ++SP;
 	}
 	PUSHMARK(MARK - 1);
-	*MARK = mg->mg_obj;
+	*MARK = SvTIED_obj((SV*)gv, mg);
 	PUTBACK;
 	ENTER;
 	perl_call_method("PRINT", G_SCALAR);
@@ -1055,9 +1055,9 @@ do_readline(void)
     I32 gimme = GIMME_V;
     MAGIC *mg;
 
-    if (SvRMAGICAL(PL_last_in_gv) && (mg = mg_find((SV*)PL_last_in_gv, 'q'))) {
+    if (mg = SvTIED_mg((SV*)PL_last_in_gv, 'q')) {
 	PUSHMARK(SP);
-	XPUSHs(mg->mg_obj);
+	XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
 	PUTBACK;
 	ENTER;
 	perl_call_method("READLINE", gimme);
diff --git a/pp_sys.c b/pp_sys.c
index 1cd1cdae01..fe6925901f 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -513,9 +513,9 @@ PP(pp_close)
     else
 	gv = (GV*)POPs;
 
-    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
 	PUSHMARK(SP);
-	XPUSHs(mg->mg_obj);
+	XPUSHs(SvTIED_obj((SV*)gv, mg));
 	PUTBACK;
 	ENTER;
 	perl_call_method("CLOSE", G_SCALAR);
@@ -707,8 +707,8 @@ PP(pp_tie)
     sv = TOPs;
     POPSTACK;
     if (sv_isobject(sv)) {
-	sv_unmagic(varsv, how);            
-	sv_magic(varsv, sv, how, Nullch, 0);
+	sv_unmagic(varsv, how);
+	sv_magic(varsv, (SvRV(sv) == varsv ? Nullsv : sv), how, Nullch, 0);
     }
     LEAVE;
     SP = PL_stack_base + markoff;
@@ -719,18 +719,12 @@ PP(pp_tie)
 PP(pp_untie)
 {
     djSP;
-    SV * sv ;
-
-    sv = POPs;
+    SV *sv = POPs;
+    char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
 
     if (ckWARN(WARN_UNTIE)) {
         MAGIC * mg ;
-        if (SvMAGICAL(sv)) {
-            if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
-                mg = mg_find(sv, 'P') ;
-            else
-                mg = mg_find(sv, 'q') ;
-    
+        if (mg = SvTIED_mg(sv, how)) {
             if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)  
 		warner(WARN_UNTIE,
 		    "untie attempted while %lu inner references still exist",
@@ -738,30 +732,23 @@ PP(pp_untie)
         }
     }
  
-    if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
-	sv_unmagic(sv, 'P');
-    else
-	sv_unmagic(sv, 'q');
+    sv_unmagic(sv, how);
     RETPUSHYES;
 }
 
 PP(pp_tied)
 {
     djSP;
-    SV * sv ;
-    MAGIC * mg ;
+    SV *sv = POPs;
+    char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
+    MAGIC *mg;
 
-    sv = POPs;
-    if (SvMAGICAL(sv)) {
-        if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
-            mg = mg_find(sv, 'P') ;
-        else
-            mg = mg_find(sv, 'q') ;
-
-        if (mg)  {
-            PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ; 
-            RETURN ;
-	}
+    if (mg = SvTIED_mg(sv, how)) {
+	SV *osv = SvTIED_obj(sv, mg);
+	if (osv == mg->mg_obj)
+	    osv = sv_mortalcopy(osv);
+	PUSHs(osv);
+	RETURN;
     }
     RETPUSHUNDEF;
 }
@@ -1026,10 +1013,10 @@ PP(pp_getc)
     if (!gv)
 	gv = PL_argvgv;
 
-    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
 	I32 gimme = GIMME_V;
 	PUSHMARK(SP);
-	XPUSHs(mg->mg_obj);
+	XPUSHs(SvTIED_obj((SV*)gv, mg));
 	PUTBACK;
 	ENTER;
 	perl_call_method("GETC", gimme);
@@ -1244,7 +1231,7 @@ PP(pp_prtf)
     else
 	gv = PL_defoutgv;
 
-    if (SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
 	if (MARK == ORIGMARK) {
 	    MEXTEND(SP, 1);
 	    ++MARK;
@@ -1252,7 +1239,7 @@ PP(pp_prtf)
 	    ++SP;
 	}
 	PUSHMARK(MARK - 1);
-	*MARK = mg->mg_obj;
+	*MARK = SvTIED_obj((SV*)gv, mg);
 	PUTBACK;
 	ENTER;
 	perl_call_method("PRINTF", G_SCALAR);
@@ -1356,12 +1343,12 @@ PP(pp_sysread)
 
     gv = (GV*)*++MARK;
     if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) &&
-	SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
+	(mg = SvTIED_mg((SV*)gv, 'q')))
     {
 	SV *sv;
 	
 	PUSHMARK(MARK-1);
-	*MARK = mg->mg_obj;
+	*MARK = SvTIED_obj((SV*)gv, mg);
 	ENTER;
 	perl_call_method("READ", G_SCALAR);
 	LEAVE;
@@ -1495,13 +1482,11 @@ PP(pp_send)
     MAGIC *mg;
 
     gv = (GV*)*++MARK;
-    if (PL_op->op_type == OP_SYSWRITE &&
-	SvRMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q')))
-    {
+    if (PL_op->op_type == OP_SYSWRITE && (mg = SvTIED_mg((SV*)gv, 'q'))) {
 	SV *sv;
 	
 	PUSHMARK(MARK-1);
-	*MARK = mg->mg_obj;
+	*MARK = SvTIED_obj((SV*)gv, mg);
 	ENTER;
 	perl_call_method("WRITE", G_SCALAR);
 	LEAVE;
diff --git a/scope.c b/scope.c
index b7a40ca0b1..020713f285 100644
--- a/scope.c
+++ b/scope.c
@@ -813,7 +813,7 @@ leave_scope(I32 base)
 	    if (ptr) {
 		sv = *(SV**)ptr;
 		if (sv && sv != &PL_sv_undef) {
-		    if (SvRMAGICAL(av) && mg_find((SV*)av, 'P'))
+		    if (SvTIED_mg((SV*)av, 'P'))
 			(void)SvREFCNT_inc(sv);
 		    SvREFCNT_dec(av);
 		    goto restore_sv;
@@ -831,7 +831,7 @@ leave_scope(I32 base)
 		SV *oval = HeVAL((HE*)ptr);
 		if (oval && oval != &PL_sv_undef) {
 		    ptr = &HeVAL((HE*)ptr);
-		    if (SvRMAGICAL(hv) && mg_find((SV*)hv, 'P'))
+		    if (SvTIED_mg((SV*)hv, 'P'))
 			(void)SvREFCNT_inc(*(SV**)ptr);
 		    SvREFCNT_dec(hv);
 		    SvREFCNT_dec(sv);
diff --git a/t/op/tie.t b/t/op/tie.t
index f1b12d6d81..451dee07b3 100755
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -153,3 +153,16 @@ $C = $B = tied %H ;
 }
 untie %H;
 EXPECT
+########
+
+# verify no leak when underlying object is selfsame tied variable
+my ($a, $b);
+sub Self::TIEHASH { bless $_[1], $_[0] }
+sub Self::DESTROY { $b = $_[0] + 0; }
+{
+    my %b5;
+    $a = \%b5 + 0;
+    tie %b5, 'Self', \%b5;
+}
+die unless $a == $b;
+EXPECT