From 5b468f54a26b6cc5b994509b89b4ae0df54ab101 Mon Sep 17 00:00:00 2001 From: Abhijit Menon-Sen Date: Sun, 12 Aug 2001 21:38:06 +0530 Subject: [PATCH] Re: Can't localize *FH, then tie it Message-ID: <20010812160806.A28712@lustre.dyn.wiw.org> p4raw-id: //depot/perl@11639 --- pp_hot.c | 15 ++++++----- pp_sys.c | 91 ++++++++++++++++++++++++++++++++++++++++++++-------------------- 2 files changed, 72 insertions(+), 34 deletions(-) diff --git a/pp_hot.c b/pp_hot.c index c801c21..db4c3fb 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -558,7 +558,10 @@ PP(pp_print) gv = (GV*)*++MARK; else gv = PL_defoutgv; - if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { + + if (gv && (io = GvIO(gv)) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) + { had_magic: if (MARK == ORIGMARK) { /* If using default handle then we need to make space to @@ -570,7 +573,7 @@ PP(pp_print) ++SP; } PUSHMARK(MARK - 1); - *MARK = SvTIED_obj((SV*)gv, mg); + *MARK = SvTIED_obj((SV*)io, mg); PUTBACK; ENTER; call_method("PRINT", G_SCALAR); @@ -582,8 +585,8 @@ PP(pp_print) RETURN; } if (!(io = GvIO(gv))) { - if ((GvEGV(gv)) - && (mg = SvTIED_mg((SV*)GvEGV(gv), PERL_MAGIC_tiedscalar))) + if ((GvEGV(gv)) && (io = GvIO(GvEGV(gv))) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) goto had_magic; if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); @@ -1434,9 +1437,9 @@ Perl_do_readline(pTHX) I32 gimme = GIMME_V; MAGIC *mg; - if ((mg = SvTIED_mg((SV*)PL_last_in_gv, PERL_MAGIC_tiedscalar))) { + if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) { PUSHMARK(SP); - XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg)); + XPUSHs(SvTIED_obj((SV*)io, mg)); PUTBACK; ENTER; call_method("READLINE", gimme); diff --git a/pp_sys.c b/pp_sys.c index b1bdde4..cdcbc93 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -492,6 +492,7 @@ PP(pp_open) dTARGET; GV *gv; SV *sv; + IO *io; char *tmps; STRLEN len; MAGIC *mg; @@ -500,13 +501,13 @@ PP(pp_open) gv = (GV *)*++MARK; if (!isGV(gv)) DIE(aTHX_ PL_no_usym, "filehandle"); - if (GvIOp(gv)) + if ((io = GvIOp(gv))) IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; - if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { + if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) { /* Method's args are same as ours ... */ /* ... except handle is replaced by the object */ - *MARK-- = SvTIED_obj((SV*)gv, mg); + *MARK-- = SvTIED_obj((SV*)io, mg); PUSHMARK(MARK); PUTBACK; ENTER; @@ -539,6 +540,7 @@ PP(pp_close) { dSP; GV *gv; + IO *io; MAGIC *mg; if (MAXARG == 0) @@ -546,9 +548,11 @@ PP(pp_close) else gv = (GV*)POPs; - if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { + if (gv && (io = GvIO(gv)) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) + { PUSHMARK(SP); - XPUSHs(SvTIED_obj((SV*)gv, mg)); + XPUSHs(SvTIED_obj((SV*)io, mg)); PUTBACK; ENTER; call_method("CLOSE", G_SCALAR); @@ -628,9 +632,11 @@ PP(pp_fileno) RETPUSHUNDEF; gv = (GV*)POPs; - if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { + if (gv && (io = GvIO(gv)) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) + { PUSHMARK(SP); - XPUSHs(SvTIED_obj((SV*)gv, mg)); + XPUSHs(SvTIED_obj((SV*)io, mg)); PUTBACK; ENTER; call_method("FILENO", G_SCALAR); @@ -694,9 +700,11 @@ PP(pp_binmode) gv = (GV*)POPs; - if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { + if (gv && (io = GvIO(gv)) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) + { PUSHMARK(SP); - XPUSHs(SvTIED_obj((SV*)gv, mg)); + XPUSHs(SvTIED_obj((SV*)io, mg)); if (discp) XPUSHs(discp); PUTBACK; @@ -752,6 +760,11 @@ PP(pp_tie) #endif methname = "TIEHANDLE"; how = PERL_MAGIC_tiedscalar; + /* For tied filehandles, we apply tiedscalar magic to the IO + slot of the GP rather than the GV itself. AMS 20010812 */ + if (!GvIOp(varsv)) + GvIOp(varsv) = newIO(); + varsv = (SV *)GvIOp(varsv); break; default: methname = "TIESCALAR"; @@ -810,12 +823,15 @@ PP(pp_tie) PP(pp_untie) { dSP; + MAGIC *mg; SV *sv = POPs; char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar; - MAGIC * mg ; - if ((mg = SvTIED_mg(sv, how))) { + if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv))) + RETPUSHYES; + + if ((mg = SvTIED_mg(sv, how))) { SV *obj = SvRV(mg->mg_obj); GV *gv; CV *cv = NULL; @@ -836,18 +852,21 @@ PP(pp_untie) "untie attempted while %"UVuf" inner references still exist", (UV)SvREFCNT(obj) - 1 ) ; } + sv_unmagic(sv, how); } - sv_unmagic(sv, how); RETPUSHYES; } PP(pp_tied) { dSP; + MAGIC *mg; SV *sv = POPs; char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar; - MAGIC *mg; + + if (SvTYPE(sv) == SVt_PVGV && !(sv = (SV *)GvIOp(sv))) + RETPUSHUNDEF; if ((mg = SvTIED_mg(sv, how))) { SV *osv = SvTIED_obj(sv, mg); @@ -1110,6 +1129,7 @@ PP(pp_getc) { dSP; dTARGET; GV *gv; + IO *io; MAGIC *mg; if (MAXARG == 0) @@ -1117,10 +1137,12 @@ PP(pp_getc) else gv = (GV*)POPs; - if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { + if (gv && (io = GvIO(gv)) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) + { I32 gimme = GIMME_V; PUSHMARK(SP); - XPUSHs(SvTIED_obj((SV*)gv, mg)); + XPUSHs(SvTIED_obj((SV*)io, mg)); PUTBACK; ENTER; call_method("GETC", gimme); @@ -1374,7 +1396,9 @@ PP(pp_prtf) else gv = PL_defoutgv; - if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { + if (gv && (io = GvIO(gv)) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) + { if (MARK == ORIGMARK) { MEXTEND(SP, 1); ++MARK; @@ -1382,7 +1406,7 @@ PP(pp_prtf) ++SP; } PUSHMARK(MARK - 1); - *MARK = SvTIED_obj((SV*)gv, mg); + *MARK = SvTIED_obj((SV*)io, mg); PUTBACK; ENTER; call_method("PRINTF", G_SCALAR); @@ -1492,13 +1516,14 @@ PP(pp_sysread) Size_t wanted; gv = (GV*)*++MARK; - if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) && - (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) + if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) + && gv && (io = GvIO(gv)) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) { SV *sv; PUSHMARK(MARK-1); - *MARK = SvTIED_obj((SV*)gv, mg); + *MARK = SvTIED_obj((SV*)io, mg); ENTER; call_method("READ", G_SCALAR); LEAVE; @@ -1720,12 +1745,13 @@ PP(pp_send) gv = (GV*)*++MARK; if (PL_op->op_type == OP_SYSWRITE - && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) + && gv && (io = GvIO(gv)) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) { SV *sv; PUSHMARK(MARK-1); - *MARK = SvTIED_obj((SV*)gv, mg); + *MARK = SvTIED_obj((SV*)io, mg); ENTER; call_method("WRITE", G_SCALAR); LEAVE; @@ -1841,6 +1867,7 @@ PP(pp_eof) { dSP; GV *gv; + IO *io; MAGIC *mg; if (MAXARG == 0) { @@ -1866,9 +1893,11 @@ PP(pp_eof) else gv = PL_last_in_gv = (GV*)POPs; /* eof(FH) */ - if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { + if (gv && (io = GvIO(gv)) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) + { PUSHMARK(SP); - XPUSHs(SvTIED_obj((SV*)gv, mg)); + XPUSHs(SvTIED_obj((SV*)io, mg)); PUTBACK; ENTER; call_method("EOF", G_SCALAR); @@ -1885,6 +1914,7 @@ PP(pp_tell) { dSP; dTARGET; GV *gv; + IO *io; MAGIC *mg; if (MAXARG == 0) @@ -1892,9 +1922,11 @@ PP(pp_tell) else gv = PL_last_in_gv = (GV*)POPs; - if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { + if (gv && (io = GvIO(gv)) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) + { PUSHMARK(SP); - XPUSHs(SvTIED_obj((SV*)gv, mg)); + XPUSHs(SvTIED_obj((SV*)io, mg)); PUTBACK; ENTER; call_method("TELL", G_SCALAR); @@ -1920,6 +1952,7 @@ PP(pp_sysseek) { dSP; GV *gv; + IO *io; int whence = POPi; #if LSEEKSIZE > IVSIZE Off_t offset = (Off_t)SvNVx(POPs); @@ -1930,9 +1963,11 @@ PP(pp_sysseek) gv = PL_last_in_gv = (GV*)POPs; - if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { + if (gv && (io = GvIO(gv)) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) + { PUSHMARK(SP); - XPUSHs(SvTIED_obj((SV*)gv, mg)); + XPUSHs(SvTIED_obj((SV*)io, mg)); #if LSEEKSIZE > IVSIZE XPUSHs(sv_2mortal(newSVnv((NV) offset))); #else -- 2.7.4