This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Revert "Make untie check the FAKE flag on globs"
[perl5.git]
/
pp_sys.c
diff --git
a/pp_sys.c
b/pp_sys.c
index
0f5a3fd
..
a69cbcf
100644
(file)
--- a/
pp_sys.c
+++ b/
pp_sys.c
@@
-505,7
+505,7
@@
PP(pp_open)
GV * const gv = MUTABLE_GV(*++MARK);
GV * const gv = MUTABLE_GV(*++MARK);
- if (!isGV(gv))
+ if (!isGV(gv)
&& !(SvTYPE(gv) == SVt_PVLV && isGV_with_GP(gv))
)
DIE(aTHX_ PL_no_usym, "filehandle");
if ((io = GvIOp(gv))) {
DIE(aTHX_ PL_no_usym, "filehandle");
if ((io = GvIOp(gv))) {
@@
-825,7
+825,8
@@
PP(pp_tie)
methname = "TIEARRAY";
break;
case SVt_PVGV:
methname = "TIEARRAY";
break;
case SVt_PVGV:
- if (isGV_with_GP(varsv)) {
+ case SVt_PVLV:
+ if (isGV_with_GP(varsv) && !SvFAKE(varsv)) {
methname = "TIEHANDLE";
how = PERL_MAGIC_tiedscalar;
/* For tied filehandles, we apply tiedscalar magic to the IO
methname = "TIEHANDLE";
how = PERL_MAGIC_tiedscalar;
/* For tied filehandles, we apply tiedscalar magic to the IO
@@
-940,7
+941,7
@@
PP(pp_tied)
const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
- if (isGV_with_GP(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
+ if (isGV_with_GP(sv) && !
SvFAKE(sv) && !
(sv = MUTABLE_SV(GvIOp(sv))))
RETPUSHUNDEF;
if ((mg = SvTIED_mg(sv, how))) {
RETPUSHUNDEF;
if ((mg = SvTIED_mg(sv, how))) {
@@
-1275,6
+1276,9
@@
S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
PERL_ARGS_ASSERT_DOFORM;
PERL_ARGS_ASSERT_DOFORM;
+ if (cv && CvCLONE(cv))
+ cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
+
ENTER;
SAVETMPS;
ENTER;
SAVETMPS;
@@
-1330,9
+1334,6
@@
PP(pp_enterwrite)
not_a_format_reference:
DIE(aTHX_ "Not a format reference");
}
not_a_format_reference:
DIE(aTHX_ "Not a format reference");
}
- if (CvCLONE(cv))
- cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
-
IoFLAGS(io) &= ~IOf_DIDTOP;
return doform(cv,gv,PL_op->op_next);
}
IoFLAGS(io) &= ~IOf_DIDTOP;
return doform(cv,gv,PL_op->op_next);
}
@@
-1347,6
+1348,7
@@
PP(pp_leavewrite)
SV **newsp;
I32 gimme;
register PERL_CONTEXT *cx;
SV **newsp;
I32 gimme;
register PERL_CONTEXT *cx;
+ OP *retop;
if (!io || !(ofp = IoOFP(io)))
goto forget_top;
if (!io || !(ofp = IoOFP(io)))
goto forget_top;
@@
-1421,14
+1423,13
@@
PP(pp_leavewrite)
else
DIE(aTHX_ "Undefined top format called");
}
else
DIE(aTHX_ "Undefined top format called");
}
- if (cv && CvCLONE(cv))
- cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
return doform(cv, gv, PL_op);
}
forget_top:
POPBLOCK(cx,PL_curpm);
POPFORMAT(cx);
return doform(cv, gv, PL_op);
}
forget_top:
POPBLOCK(cx,PL_curpm);
POPFORMAT(cx);
+ retop = cx->blk_sub.retop;
LEAVE;
fp = IoOFP(io);
LEAVE;
fp = IoOFP(io);
@@
-1461,7
+1462,7
@@
PP(pp_leavewrite)
PUTBACK;
PERL_UNUSED_VAR(newsp);
PERL_UNUSED_VAR(gimme);
PUTBACK;
PERL_UNUSED_VAR(newsp);
PERL_UNUSED_VAR(gimme);
- return
cx->blk_sub.
retop;
+ return retop;
}
PP(pp_prtf)
}
PP(pp_prtf)
@@
-1654,6
+1655,9
@@
PP(pp_sysread)
(struct sockaddr *)namebuf, &bufsize);
if (count < 0)
RETPUSHUNDEF;
(struct sockaddr *)namebuf, &bufsize);
if (count < 0)
RETPUSHUNDEF;
+ /* MSG_TRUNC can give oversized count; quietly lose it */
+ if (count > length)
+ count = length;
#ifdef EPOC
/* Bogus return without padding */
bufsize = sizeof (struct sockaddr_in);
#ifdef EPOC
/* Bogus return without padding */
bufsize = sizeof (struct sockaddr_in);
@@
-3338,7
+3342,7
@@
PP(pp_fttty)
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
- else if (isGV(TOPs))
+ else if (isGV
_with_GP
(TOPs))
gv = MUTABLE_GV(POPs);
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = MUTABLE_GV(SvRV(POPs));
gv = MUTABLE_GV(POPs);
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = MUTABLE_GV(SvRV(POPs));
@@
-3391,7
+3395,7
@@
PP(pp_fttext)
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
- else if (isGV(TOPs))
+ else if (isGV
_with_GP
(TOPs))
gv = MUTABLE_GV(POPs);
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = MUTABLE_GV(SvRV(POPs));
gv = MUTABLE_GV(POPs);
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = MUTABLE_GV(SvRV(POPs));
@@
-4453,13
+4457,19
@@
PP(pp_setpgrp)
#endif
}
#endif
}
+#ifdef __GLIBC__
+# define PRIORITY_WHICH_T(which) (__priority_which_t)which
+#else
+# define PRIORITY_WHICH_T(which) which
+#endif
+
PP(pp_getpriority)
{
#ifdef HAS_GETPRIORITY
dVAR; dSP; dTARGET;
const int who = POPi;
const int which = TOPi;
PP(pp_getpriority)
{
#ifdef HAS_GETPRIORITY
dVAR; dSP; dTARGET;
const int who = POPi;
const int which = TOPi;
- SETi( getpriority(
which
, who) );
+ SETi( getpriority(
PRIORITY_WHICH_T(which)
, who) );
RETURN;
#else
DIE(aTHX_ PL_no_func, "getpriority()");
RETURN;
#else
DIE(aTHX_ PL_no_func, "getpriority()");
@@
-4474,13
+4484,15
@@
PP(pp_setpriority)
const int who = POPi;
const int which = TOPi;
TAINT_PROPER("setpriority");
const int who = POPi;
const int which = TOPi;
TAINT_PROPER("setpriority");
- SETi( setpriority(
which
, who, niceval) >= 0 );
+ SETi( setpriority(
PRIORITY_WHICH_T(which)
, who, niceval) >= 0 );
RETURN;
#else
DIE(aTHX_ PL_no_func, "setpriority()");
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_func, "setpriority()");
#endif
}
+#undef PRIORITY_WHICH_T
+
/* Time calls. */
PP(pp_time)
/* Time calls. */
PP(pp_time)
@@
-5510,7
+5522,8
@@
PP(pp_getlogin)
EXTEND(SP, 1);
if (!(tmps = PerlProc_getlogin()))
RETPUSHUNDEF;
EXTEND(SP, 1);
if (!(tmps = PerlProc_getlogin()))
RETPUSHUNDEF;
- PUSHp(tmps, strlen(tmps));
+ sv_setpv_mg(TARG, tmps);
+ PUSHs(TARG);
RETURN;
#else
DIE(aTHX_ PL_no_func, "getlogin");
RETURN;
#else
DIE(aTHX_ PL_no_func, "getlogin");