# define FD_CLOEXEC 1 /* NeXT needs this */
#endif
+#include "reentr.h"
+
#undef PERL_EFF_ACCESS_R_OK /* EFFective uid/gid ACCESS R_OK */
#undef PERL_EFF_ACCESS_W_OK
#undef PERL_EFF_ACCESS_X_OK
;
}
else if (gimme == G_SCALAR) {
+ SV *oldrs = PL_rs;
+ PL_rs = &PL_sv_undef;
sv_setpv(TARG, ""); /* note that this preserves previous buffer */
while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
/*SUPPRESS 530*/
;
+ PL_rs = oldrs;
XPUSHs(TARG);
SvTAINTED_on(TARG);
}
IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
IoOFP(wstio) = PerlIO_fdopen(fd[1], "w");
+ IoOFP(rstio) = IoIFP(rstio);
IoIFP(wstio) = IoOFP(wstio);
IoTYPE(rstio) = IoTYPE_RDONLY;
IoTYPE(wstio) = IoTYPE_WRONLY;
RETPUSHUNDEF;
}
+ PUTBACK;
if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
- (discp) ? SvPV_nolen(discp) : Nullch))
+ (discp) ? SvPV_nolen(discp) : Nullch)) {
+ SPAGAIN;
RETPUSHYES;
- else
+ }
+ else {
+ SPAGAIN;
RETPUSHUNDEF;
+ }
}
PP(pp_tie)
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
- EXTEND(SP,items);
+ EXTEND(SP,(I32)items);
while (items--)
PUSHs(*MARK++);
PUTBACK;
ENTER;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
- EXTEND(SP,items);
+ EXTEND(SP,(I32)items);
while (items--)
PUSHs(*MARK++);
PUTBACK;
sv_unmagic(varsv, how);
/* Croak if a self-tie on an aggregate is attempted. */
if (varsv == SvRV(sv) &&
- (SvTYPE(sv) == SVt_PVAV ||
- SvTYPE(sv) == SVt_PVHV))
+ (SvTYPE(varsv) == SVt_PVAV ||
+ SvTYPE(varsv) == SVt_PVHV))
Perl_croak(aTHX_
"Self-ties of arrays and hashes are not supported");
- sv_magic(varsv, sv, how, Nullch, 0);
+ sv_magic(varsv, (SvRV(sv) == varsv ? Nullsv : sv), how, Nullch, 0);
}
LEAVE;
SP = PL_stack_base + markoff;
if (bufsize >= 256)
bufsize = 255;
#endif
- buffer = SvGROW(bufsv, length+1);
+ buffer = SvGROW(bufsv, (STRLEN)(length+1));
/* 'offset' means 'flags' here */
count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
(struct sockaddr *)namebuf, &bufsize);
blen = sv_len_utf8(bufsv);
}
if (offset < 0) {
- if (-offset > blen)
+ if (-offset > (int)blen)
DIE(aTHX_ "Offset outside string");
offset += blen;
}
}
more_bytes:
bufsize = SvCUR(bufsv);
- buffer = SvGROW(bufsv, length+offset+1);
+ buffer = SvGROW(bufsv, (STRLEN)(length+offset+1));
if (offset > bufsize) { /* Zero any newly allocated space */
Zero(buffer+bufsize, offset-bufsize, char);
}
if (MARK < SP) {
offset = SvIVx(*++MARK);
if (offset < 0) {
- if (-offset > blen)
+ if (-offset > (IV)blen)
DIE(aTHX_ "Offset outside string");
offset += blen;
- } else if (offset >= blen && blen > 0)
+ } else if (offset >= (IV)blen && blen > 0)
DIE(aTHX_ "Offset outside string");
} else
offset = 0;
#else
retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s);
#endif
-#else
- DIE(aTHX_ "fcntl is not implemented");
-#endif
if (SvPOK(argsv)) {
if (s[SvCUR(argsv)] != 17)
PUSHp(zero_but_true, ZBTLEN);
}
RETURN;
+
+#else
+ DIE(aTHX_ "fcntl is not implemented");
+#endif
}
PP(pp_flock)
dSP;
STRLEN n_a;
char *dirname = POPpx;
- char *dscp = NULL;
- GV *gv;
- register IO *io;
- bool want_utf8 = FALSE;
-
- if (MAXARG == 3)
- dscp = POPpx;
-
- gv = (GV*)POPs;
- io = GvIOn(gv);
+ GV *gv = (GV*)POPs;
+ register IO *io = GvIOn(gv);
if (!io)
goto nope;
- if (dscp) {
- if (*dscp == ':') {
- if (strnEQ(dscp + 1, "utf8", 4))
- want_utf8 = TRUE;
- else
- Perl_croak(aTHX_ "Unknown discipline '%s'", dscp);
- }
- else
- Perl_croak(aTHX_ "Unknown discipline '%s'", dscp);
- }
-
if (IoDIRP(io))
PerlDir_close(IoDIRP(io));
if (!(IoDIRP(io) = PerlDir_open(dirname)))
goto nope;
- if (want_utf8)
- IoFLAGS(io) |= IOf_DIR_UTF8;
-
RETPUSHYES;
nope:
if (!errno)
if (!(IoFLAGS(io) & IOf_UNTAINT))
SvTAINTED_on(sv);
#endif
- if (IoFLAGS(io) & IOf_DIR_UTF8 && !IN_BYTES)
- SvUTF8_on(sv);
XPUSHs(sv_2mortal(sv));
}
}
if (!(IoFLAGS(io) & IOf_UNTAINT))
SvTAINTED_on(sv);
#endif
- if (IoFLAGS(io) & IOf_DIR_UTF8)
- sv_utf8_upgrade(sv);
XPUSHs(sv_2mortal(sv));
}
RETURN;
I32 value;
STRLEN n_a;
int result;
- int pp[2];
I32 did_pipes = 0;
if (PL_tainting) {
TAINT_ENV();
while (++MARK <= SP) {
(void)SvPV_nolen(*MARK); /* stringify for taint check */
- if (PL_tainted)
+ if (PL_tainted)
break;
}
MARK = ORIGMARK;
PERL_FLUSHALL_FOR_CHILD;
#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO)
{
- Pid_t childpid;
- int status;
- Sigsave_t ihand,qhand; /* place to save signals during system() */
-
- if (PerlProc_pipe(pp) >= 0)
- did_pipes = 1;
- while ((childpid = PerlProc_fork()) == -1) {
- if (errno != EAGAIN) {
- value = -1;
- SP = ORIGMARK;
- PUSHi(value);
- if (did_pipes) {
- PerlLIO_close(pp[0]);
- PerlLIO_close(pp[1]);
- }
- RETURN;
- }
- sleep(5);
- }
- if (childpid > 0) {
- if (did_pipes)
- PerlLIO_close(pp[1]);
+ Pid_t childpid;
+ int pp[2];
+
+ if (PerlProc_pipe(pp) >= 0)
+ did_pipes = 1;
+ while ((childpid = PerlProc_fork()) == -1) {
+ if (errno != EAGAIN) {
+ value = -1;
+ SP = ORIGMARK;
+ PUSHi(value);
+ if (did_pipes) {
+ PerlLIO_close(pp[0]);
+ PerlLIO_close(pp[1]);
+ }
+ RETURN;
+ }
+ sleep(5);
+ }
+ if (childpid > 0) {
+ Sigsave_t ihand,qhand; /* place to save signals during system() */
+ int status;
+
+ if (did_pipes)
+ PerlLIO_close(pp[1]);
#ifndef PERL_MICRO
- rsignal_save(SIGINT, SIG_IGN, &ihand);
- rsignal_save(SIGQUIT, SIG_IGN, &qhand);
+ rsignal_save(SIGINT, SIG_IGN, &ihand);
+ rsignal_save(SIGQUIT, SIG_IGN, &qhand);
#endif
- do {
- result = wait4pid(childpid, &status, 0);
- } while (result == -1 && errno == EINTR);
+ do {
+ result = wait4pid(childpid, &status, 0);
+ } while (result == -1 && errno == EINTR);
#ifndef PERL_MICRO
- (void)rsignal_restore(SIGINT, &ihand);
- (void)rsignal_restore(SIGQUIT, &qhand);
-#endif
- STATUS_NATIVE_SET(result == -1 ? -1 : status);
- do_execfree(); /* free any memory child malloced on fork */
- SP = ORIGMARK;
- if (did_pipes) {
- int errkid;
- int n = 0, n1;
-
- while (n < sizeof(int)) {
- n1 = PerlLIO_read(pp[0],
- (void*)(((char*)&errkid)+n),
- (sizeof(int)) - n);
- if (n1 <= 0)
- break;
- n += n1;
- }
- PerlLIO_close(pp[0]);
- if (n) { /* Error */
- if (n != sizeof(int))
- DIE(aTHX_ "panic: kid popen errno read");
- errno = errkid; /* Propagate errno from kid */
- STATUS_CURRENT = -1;
- }
- }
- PUSHi(STATUS_CURRENT);
- RETURN;
- }
- if (did_pipes) {
- PerlLIO_close(pp[0]);
+ (void)rsignal_restore(SIGINT, &ihand);
+ (void)rsignal_restore(SIGQUIT, &qhand);
+#endif
+ STATUS_NATIVE_SET(result == -1 ? -1 : status);
+ do_execfree(); /* free any memory child malloced on fork */
+ SP = ORIGMARK;
+ if (did_pipes) {
+ int errkid;
+ int n = 0, n1;
+
+ while (n < sizeof(int)) {
+ n1 = PerlLIO_read(pp[0],
+ (void*)(((char*)&errkid)+n),
+ (sizeof(int)) - n);
+ if (n1 <= 0)
+ break;
+ n += n1;
+ }
+ PerlLIO_close(pp[0]);
+ if (n) { /* Error */
+ if (n != sizeof(int))
+ DIE(aTHX_ "panic: kid popen errno read");
+ errno = errkid; /* Propagate errno from kid */
+ STATUS_CURRENT = -1;
+ }
+ }
+ PUSHi(STATUS_CURRENT);
+ RETURN;
+ }
+ if (did_pipes) {
+ PerlLIO_close(pp[0]);
#if defined(HAS_FCNTL) && defined(F_SETFD)
- fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+ fcntl(pp[1], F_SETFD, FD_CLOEXEC);
#endif
- }
- }
- if (PL_op->op_flags & OPf_STACKED) {
- SV *really = *++MARK;
- value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
- }
- else if (SP - MARK != 1)
- value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes);
- else {
- value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes);
+ }
+ if (PL_op->op_flags & OPf_STACKED) {
+ SV *really = *++MARK;
+ value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes);
+ }
+ else if (SP - MARK != 1)
+ value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes);
+ else {
+ value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes);
+ }
+ PerlProc__exit(-1);
}
- PerlProc__exit(-1);
#else /* ! FORK or VMS or OS/2 */
PL_statusvalue = 0;
result = 0;
TAINT_ENV();
while (++MARK <= SP) {
(void)SvPV_nolen(*MARK); /* stringify for taint check */
- if (PL_tainted)
+ if (PL_tainted)
break;
}
MARK = ORIGMARK;
else if (which == OP_GSBYPORT) {
#ifdef HAS_GETSERVBYPORT
char *proto = POPpbytex;
- unsigned short port = POPu;
+ unsigned short port = (unsigned short)POPu;
#ifdef HAS_HTONS
port = PerlSock_htons(port);
https://perl5.git.perl.org / perl5.git / blobdiff