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

diff --git a/av.c b/av.c
index 5242ffc..f3c69e7 100644 (file)
--- 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 7ed895d..c988bff 100644 (file)
--- 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 1840ca4..1ef70eb 100644 (file)
--- 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 ddd989f..1fad0e2 100644 (file)
--- 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 49ad9be..9532b38 100644 (file)
--- 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 16efdb5..702699f 100644 (file)
--- 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 0bd3a23..495b9ea 100644 (file)
--- 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 e59867e..ecd8029 100644 (file)
--- 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 1cd1cda..fe69259 100644 (file)
--- 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 b7a40ca..020713f 100644 (file)
--- 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 f1b12d6..451dee0 100755 (executable)
--- 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