SV *exsv;
STRLEN len;
#ifdef VMS
- VMSISH_HUSHED = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
+ VMSISH_HUSHED =
+ VMSISH_HUSHED || (PL_curcop->op_private & OPpHUSH_VMSISH);
#endif
if (SP - MARK != 1) {
dTARGET;
GV * const wgv = MUTABLE_GV(POPs);
GV * const rgv = MUTABLE_GV(POPs);
- if (!rgv || !wgv)
- goto badexit;
-
- if (!isGV_with_GP(rgv) || !isGV_with_GP(wgv))
- DIE(aTHX_ PL_no_usym, "filehandle");
+ assert (isGV_with_GP(rgv));
+ assert (isGV_with_GP(wgv));
rstio = GvIOn(rgv);
- wstio = GvIOn(wgv);
-
if (IoIFP(rstio))
do_close(rgv, FALSE);
+
+ wstio = GvIOn(wgv);
if (IoIFP(wstio))
do_close(wgv, FALSE);
varsv = MUTABLE_SV(GvIOp(varsv));
break;
}
+ if (SvTYPE(varsv) == SVt_PVLV && LvTYPE(varsv) == 'y') {
+ vivify_defelem(varsv);
+ varsv = LvTARG(varsv);
+ }
/* FALL THROUGH */
default:
methname = "TIESCALAR";
if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
RETPUSHYES;
+ if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y' &&
+ !(sv = defelem_target(sv, NULL))) RETPUSHUNDEF;
+
if ((mg = SvTIED_mg(sv, how))) {
SV * const obj = SvRV(SvTIED_obj(sv, mg));
if (obj) {
if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
RETPUSHUNDEF;
+ if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y' &&
+ !(sv = defelem_target(sv, NULL))) RETPUSHUNDEF;
+
if ((mg = SvTIED_mg(sv, how))) {
PUSHs(SvTIED_obj(sv, mg));
RETURN;
SvGETMAGIC(sv);
if (!SvOK(sv))
continue;
- if (SvIsCOW(sv))
- sv_force_normal_flags(sv, 0);
- if (SvREADONLY(sv) && !(SvPOK(sv) && SvCUR(sv) == 0))
+ if (SvREADONLY(sv)) {
+ if (!(SvPOK(sv) && SvCUR(sv) == 0))
Perl_croak_no_modify();
+ }
+ else if (SvIsCOW(sv)) sv_force_normal_flags(sv, 0);
if (!SvPOK(sv)) {
if (!SvPOKp(sv))
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
# endif
sv = SP[4];
+ SvGETMAGIC(sv);
if (SvOK(sv)) {
- value = SvNV(sv);
+ value = SvNV_nomg(sv);
if (value < 0.0)
value = 0.0;
timebuf.tv_sec = (long)value;
=for apidoc setdefout
Sets PL_defoutgv, the default file handle for output, to the passed in
-typeglob. As PL_defoutgv "owns" a reference on its typeglob, the reference
+typeglob. As PL_defoutgv "owns" a reference on its typeglob, the reference
count of the passed in typeglob is increased by one, and the reference count
of the typeglob that PL_defoutgv points to is decreased by one.
SV *tmpsv = NULL;
if (MAXARG == 0) {
- gv = PL_defoutgv;
EXTEND(SP, 1);
+ gv = PL_defoutgv;
}
else {
gv = MUTABLE_GV(POPs);
forget_top:
POPBLOCK(cx,PL_curpm);
- POPFORMAT(cx);
retop = cx->blk_sub.retop;
+ POPFORMAT(cx);
SP = newsp; /* ignore retval of formline */
LEAVE;
}
}
else
-#ifdef HAS_SOCKET__bad_code_maybe
- if (IoTYPE(io) == IoTYPE_SOCKET) {
- Sock_size_t bufsize;
- char namebuf[MAXPATHLEN];
-#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)
- bufsize = sizeof (struct sockaddr_in);
-#else
- bufsize = sizeof namebuf;
-#endif
- count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, 0,
- (struct sockaddr *)namebuf, &bufsize);
- }
- else
-#endif
{
count = PerlIO_read(IoIFP(io), buffer, length);
/* PerlIO_read() - like fread() returns 0 on both error and EOF */
dVAR; dSP; dTARGET;
SV * const argsv = POPs;
const unsigned int func = POPu;
- const int optype = PL_op->op_type;
+ int optype;
GV * const gv = MUTABLE_GV(POPs);
- IO * const io = gv ? GvIOn(gv) : NULL;
+ IO * const io = GvIOn(gv);
char *s;
IV retval;
- if (!io || !argsv || !IoIFP(io)) {
+ if (!IoIFP(io)) {
report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI); /* well, sort of... */
RETPUSHUNDEF;
s = INT2PTR(char*,retval); /* ouch */
}
+ optype = PL_op->op_type;
TAINT_PROPER(PL_op_desc[optype]);
if (optype == OP_IOCTL)
const int type = POPi;
const int domain = POPi;
GV * const gv = MUTABLE_GV(POPs);
- IO * const io = gv ? GvIOn(gv) : NULL;
+ IO * const io = GvIOn(gv);
int fd;
- if (!io) {
- report_evil_fh(gv);
- if (io && IoIFP(io))
- do_close(gv, FALSE);
- SETERRNO(EBADF,LIB_INVARG);
- RETPUSHUNDEF;
- }
-
if (IoIFP(io))
do_close(gv, FALSE);
{
#if defined (HAS_SOCKETPAIR) || (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && defined(AF_INET) && defined(PF_INET))
dVAR; dSP;
+ int fd[2];
const int protocol = POPi;
const int type = POPi;
const int domain = POPi;
+
GV * const gv2 = MUTABLE_GV(POPs);
+ IO * const io2 = GvIOn(gv2);
GV * const gv1 = MUTABLE_GV(POPs);
- IO * const io1 = gv1 ? GvIOn(gv1) : NULL;
- IO * const io2 = gv2 ? GvIOn(gv2) : NULL;
- int fd[2];
-
- if (!io1)
- report_evil_fh(gv1);
- if (!io2)
- report_evil_fh(gv2);
+ IO * const io1 = GvIOn(gv1);
- if (io1 && IoIFP(io1))
+ if (IoIFP(io1))
do_close(gv1, FALSE);
- if (io2 && IoIFP(io2))
+ if (IoIFP(io2))
do_close(gv2, FALSE);
- if (!io1 || !io2)
- RETPUSHUNDEF;
-
TAINT_PROPER("socketpair");
if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
RETPUSHUNDEF;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
STRLEN len;
- const int op_type = PL_op->op_type;
+ int op_type;
- if (!io || !IoIFP(io))
+ if (!IoIFP(io))
goto nuts;
addr = SvPV_const(addrsv, len);
+ op_type = PL_op->op_type;
TAINT_PROPER(PL_op_desc[op_type]);
if ((op_type == OP_BIND
? PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len)
dVAR; dSP;
const int backlog = POPi;
GV * const gv = MUTABLE_GV(POPs);
- IO * const io = gv ? GvIOn(gv) : NULL;
+ IO * const io = GvIOn(gv);
- if (!io || !IoIFP(io))
+ if (!IoIFP(io))
goto nuts;
if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0)
{
dVAR; dSP; dTARGET;
IO *nstio;
- IO *gstio;
char namebuf[MAXPATHLEN];
#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__)
Sock_size_t len = sizeof (struct sockaddr_in);
GV * const ngv = MUTABLE_GV(POPs);
int fd;
- if (!ngv)
- goto badexit;
- if (!ggv)
- goto nuts;
-
- gstio = GvIO(ggv);
+ IO * const gstio = GvIO(ggv);
if (!gstio || !IoIFP(gstio))
goto nuts;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
- if (!io || !IoIFP(io))
+ if (!IoIFP(io))
goto nuts;
PUSHi( PerlSock_shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
int fd;
Sock_size_t len;
- if (!io || !IoIFP(io))
+ if (!IoIFP(io))
goto nuts;
fd = PerlIO_fileno(IoIFP(io));
SV *sv;
int fd;
- if (!io || !IoIFP(io))
+ if (!IoIFP(io))
goto nuts;
sv = sv_2mortal(newSV(257));
else
PL_laststatval = PerlLIO_stat(SvPV_nolen_const(PL_statname), &PL_statcache);
if (PL_laststatval < 0) {
- if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname), '\n'))
+ if (ckWARN(WARN_NEWLINE) &&
+ strchr(SvPV_nolen_const(PL_statname), '\n'))
+ {
+ /* PL_warn_nl is constant */
+ GCC_DIAG_IGNORE(-Wformat-nonliteral);
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
+ GCC_DIAG_RESTORE;
+ }
max = 0;
}
}
{
dVAR;
I32 i;
- I32 len;
+ SSize_t len;
I32 odd = 0;
STDCHAR tbuf[512];
STDCHAR *s;
}
if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
'\n'))
+ {
+ /* PL_warn_nl is constant */
+ GCC_DIAG_IGNORE(-Wformat-nonliteral);
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
+ GCC_DIAG_RESTORE;
+ }
FT_RETURNUNDEF;
}
PL_laststype = OP_STAT;
char buf[MAXPATHLEN];
int len;
-#ifndef INCOMPLETE_TAINTS
TAINT;
-#endif
tmps = POPpconstx;
len = readlink(tmps, buf, sizeof(buf) - 1);
if (len < 0)
; e++)
{
/* you don't see this */
- const char * const errmsg =
-#ifdef HAS_SYS_ERRLIST
- sys_errlist[e]
-#else
- strerror(e)
-#endif
- ;
+ const char * const errmsg = Strerror(e) ;
if (!errmsg)
break;
if (instr(s, errmsg)) {
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
- if (!io)
- goto nope;
-
if ((IoIFP(io) || IoOFP(io)))
Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
"Opening filehandle %"HEKf" also as a directory",
const Direntry_t *dp;
IO * const io = GvIOn(gv);
- if (!io || !IoDIRP(io)) {
+ if (!IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
"readdir() attempted on invalid dirhandle %"HEKf,
HEKfARG(GvENAME_HEK(gv)));
#else
sv = newSVpv(dp->d_name, 0);
#endif
-#ifndef INCOMPLETE_TAINTS
if (!(IoFLAGS(io) & IOf_UNTAINT))
SvTAINTED_on(sv);
-#endif
mXPUSHs(sv);
} while (gimme == G_ARRAY);
if (!dp && gimme != G_ARRAY)
- goto nope;
+ RETPUSHUNDEF;
RETURN;
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
- if (!io || !IoDIRP(io)) {
+ if (!IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
"telldir() attempted on invalid dirhandle %"HEKf,
HEKfARG(GvENAME_HEK(gv)));
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
- if (!io || !IoDIRP(io)) {
+ if (!IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
"seekdir() attempted on invalid dirhandle %"HEKf,
HEKfARG(GvENAME_HEK(gv)));
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
- if (!io || !IoDIRP(io)) {
+ if (!IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
"rewinddir() attempted on invalid dirhandle %"HEKf,
HEKfARG(GvENAME_HEK(gv)));
GV * const gv = MUTABLE_GV(POPs);
IO * const io = GvIOn(gv);
- if (!io || !IoDIRP(io)) {
+ if (!IoDIRP(io)) {
Perl_ck_warner(aTHX_ packWARN(WARN_IO),
"closedir() attempted on invalid dirhandle %"HEKf,
HEKfARG(GvENAME_HEK(gv)));
#ifdef HAS_FORK
dVAR; dSP; dTARGET;
Pid_t childpid;
-#if defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO)
+#ifdef HAS_SIGPROCMASK
sigset_t oldmask, newmask;
#endif
EXTEND(SP, 1);
PERL_FLUSHALL_FOR_CHILD;
-#if defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO)
+#ifdef HAS_SIGPROCMASK
sigfillset(&newmask);
sigprocmask(SIG_SETMASK, &newmask, &oldmask);
#endif
for (sig = 1; sig < SIG_SIZE; sig++)
PL_psig_pend[sig] = 0;
}
-#if defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO)
+#ifdef HAS_SIGPROCMASK
{
dSAVE_ERRNO;
sigprocmask(SIG_SETMASK, &oldmask, NULL);
Pid_t childpid;
int pp[2];
I32 did_pipes = 0;
-#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+#ifdef HAS_SIGPROCMASK
sigset_t newset, oldset;
#endif
if (PerlProc_pipe(pp) >= 0)
did_pipes = 1;
-#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+#ifdef HAS_SIGPROCMASK
sigemptyset(&newset);
sigaddset(&newset, SIGCHLD);
sigprocmask(SIG_BLOCK, &newset, &oldset);
PerlLIO_close(pp[0]);
PerlLIO_close(pp[1]);
}
-#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+#ifdef HAS_SIGPROCMASK
sigprocmask(SIG_SETMASK, &oldset, NULL);
#endif
RETURN;
XPUSHi(STATUS_CURRENT);
RETURN;
}
-#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+#ifdef HAS_SIGPROCMASK
sigprocmask(SIG_SETMASK, &oldset, NULL);
#endif
if (did_pipes) {
sv_setpv(sv, pwent->pw_passwd);
# endif
-# ifndef INCOMPLETE_TAINTS
/* passwd is tainted because user himself can diddle with it.
* admittedly not much and in a very limited way, but nevertheless. */
SvTAINTED_on(sv);
-# endif
sv_setuid(PUSHmortal, pwent->pw_uid);
sv_setgid(PUSHmortal, pwent->pw_gid);
# else
PUSHs(sv = sv_mortalcopy(&PL_sv_no));
# endif
-# ifndef INCOMPLETE_TAINTS
/* pw_gecos is tainted because user himself can diddle with it. */
SvTAINTED_on(sv);
-# endif
mPUSHs(newSVpv(pwent->pw_dir, 0));
PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_shell, 0)));
-# ifndef INCOMPLETE_TAINTS
/* pw_shell is tainted because user himself can diddle with it. */
SvTAINTED_on(sv);
-# endif
# ifdef PWEXPIRE
mPUSHi(pwent->pw_expire);
https://perl5.git.perl.org / perl5.git / blobdiff