From: Gurusamy Sarathy Date: Sun, 25 Oct 1998 06:33:43 +0000 (+0000) Subject: integrate changes#1982,2014,2021 (from maint-5.005) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=33c2748902d07b7ec367f87ad66e61e89f2aa994;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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