summaryrefslogtreecommitdiff
path: root/pp_sys.c
diff options
context:
space:
mode:
Diffstat (limited to 'pp_sys.c')
-rw-r--r--pp_sys.c65
1 files changed, 25 insertions, 40 deletions
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;