mode = "rb";
else if (PL_op->op_private & OPpOPEN_IN_CRLF)
mode = "rt";
- fp = PerlProc_popen((char*)tmps, (char *)mode);
+ fp = PerlProc_popen(tmps, mode);
if (fp) {
const char *type = NULL;
if (PL_curcop->cop_io) {
SvTAINTED_on(sv);
}
}
- STATUS_NATIVE_SET(PerlProc_pclose(fp));
+ STATUS_NATIVE_CHILD_SET(PerlProc_pclose(fp));
TAINT; /* "I believe that this is not gratuitous!" */
}
else {
sv_setsv(error,*PL_stack_sp--);
}
}
- DIE_NULL;
+ DIE(aTHX_ Nullch);
}
else {
if (SvPOK(error) && SvCUR(error))
}
tmps = SvPV_const(sv, len);
- ok = do_openn(gv, (char *)tmps, len, FALSE, O_RDONLY, 0, Nullfp, MARK+1, (SP-MARK));
+ ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, MARK+1, (SP-MARK));
SP = ORIGMARK;
if (ok)
PUSHi( (I32)PL_forkprocess );
LEAVE;
SPAGAIN;
}
- else if (ckWARN(WARN_UNTIE)) {
- if (mg && SvREFCNT(obj) > 1)
+ else if (mg && SvREFCNT(obj) > 1 && ckWARN(WARN_UNTIE)) {
Perl_warner(aTHX_ packWARN(WARN_UNTIE),
"untie attempted while %"UVuf" inner references still exist",
(UV)SvREFCNT(obj) - 1 ) ;
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
s = SvPVX(sv);
- New(403, fd_sets[i], growsize, char);
+ Newx(fd_sets[i], growsize, char);
for (offset = 0; offset < growsize; offset += masksize) {
for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
fd_sets[i][j+offset] = s[(k % masksize) + offset];
RETURN;
}
if (!gv || do_eof(gv)) { /* make sure we have fp with something */
- if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)
- && (!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY)))
+ if ((!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY))
+ && ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
SETERRNO(EBADF,RMS_IFI);
RETPUSHUNDEF;
/* Need TIEHANDLE method ? */
const char * const tmps = SvPV_const(sv, len);
/* FIXME? do_open should do const */
- if (do_open(gv, (char*)tmps, len, TRUE, mode, perm, Nullfp)) {
+ if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
IoLINES(GvIOp(gv)) = 0;
PUSHs(&PL_sv_yes);
}
if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
IoLINES(io) = 0;
IoFLAGS(io) &= ~IOf_START;
- do_open(gv, (char *)"-", 1, FALSE, O_RDONLY, 0, Nullfp);
+ do_open(gv, "-", 1, FALSE, O_RDONLY, 0, Nullfp);
sv_setpvn(GvSV(gv), "-", 1);
SvSETMAGIC(GvSV(gv));
}
static const char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
/* If the call succeeded, make sure we don't have a zeroed port/addr */
if (((struct sockaddr *)SvPVX_const(sv))->sa_family == AF_INET &&
- !memcmp((char *)SvPVX_const(sv) + sizeof(u_short), nowhere,
+ !memcmp(SvPVX_const(sv) + sizeof(u_short), nowhere,
sizeof(u_short) + sizeof(struct in_addr))) {
goto nuts2;
}
PP(pp_chdir)
{
dSP; dTARGET;
- const char *tmps;
- SV **svp;
+ const char *tmps = 0;
+ GV *gv = NULL;
- if( MAXARG == 1 )
- tmps = POPpconstx;
- else
- tmps = 0;
+ if( MAXARG == 1 ) {
+ SV * const sv = POPs;
+ if (SvTYPE(sv) == SVt_PVGV) {
+ gv = (GV*)sv;
+ }
+ else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
+ gv = (GV*)SvRV(sv);
+ }
+ else {
+ tmps = SvPVx_nolen_const(sv);
+ }
+ }
- if( !tmps || !*tmps ) {
- if ( (svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE))
- || (svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE))
+ if( !gv && (!tmps || !*tmps) ) {
+ HV * const table = GvHVn(PL_envgv);
+ SV **svp;
+
+ if ( (svp = hv_fetch(table, "HOME", 4, FALSE))
+ || (svp = hv_fetch(table, "LOGDIR", 6, FALSE))
#ifdef VMS
- || (svp = hv_fetch(GvHVn(PL_envgv), "SYS$LOGIN", 9, FALSE))
+ || (svp = hv_fetch(table, "SYS$LOGIN", 9, FALSE))
#endif
)
{
}
TAINT_PROPER("chdir");
- PUSHi( PerlDir_chdir(tmps) >= 0 );
+ if (gv) {
+#ifdef HAS_FCHDIR
+ IO* const io = GvIO(gv);
+ if (io) {
+ if (IoIFP(io)) {
+ PUSHi(fchdir(PerlIO_fileno(IoIFP(io))) >= 0);
+ }
+ else if (IoDIRP(io)) {
+#ifdef HAS_DIRFD
+ PUSHi(fchdir(dirfd(IoDIRP(io))) >= 0);
+#else
+ DIE(aTHX_ PL_no_func, "dirfd");
+#endif
+ }
+ else {
+ PUSHi(0);
+ }
+ }
+ else {
+ PUSHi(0);
+ }
+#else
+ DIE(aTHX_ PL_no_func, "fchdir");
+#endif
+ }
+ else
+ PUSHi( PerlDir_chdir(tmps) >= 0 );
#ifdef VMS
/* Clear the DEFAULT element of ENV so we'll get the new value
* in the future. */
PerlIO *myfp;
int anum = 1;
- New(666, cmdline, strlen(cmd) + (strlen(filename) * 2) + 10, char);
+ Newx(cmdline, strlen(cmd) + (strlen(filename) * 2) + 10, char);
strcpy(cmdline, cmd);
strcat(cmdline, " ");
for (s = cmdline + strlen(cmdline); *filename; ) {
}
# if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
/* 0 and -1 are both error returns (the former applies to WNOHANG case) */
- STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
+ STATUS_NATIVE_CHILD_SET((childpid && childpid != -1) ? argflags : -1);
# else
- STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+ STATUS_NATIVE_CHILD_SET((childpid > 0) ? argflags : -1);
# endif
XPUSHi(childpid);
RETURN;
}
# if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
/* 0 and -1 are both error returns (the former applies to WNOHANG case) */
- STATUS_NATIVE_SET((result && result != -1) ? argflags : -1);
+ STATUS_NATIVE_CHILD_SET((result && result != -1) ? argflags : -1);
# else
- STATUS_NATIVE_SET((result > 0) ? argflags : -1);
+ STATUS_NATIVE_CHILD_SET((result > 0) ? argflags : -1);
# endif
SETi(result);
RETURN;
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, (Sighandler_t) SIG_IGN, &ihand);
+ rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
#endif
do {
result = wait4pid(childpid, &status, 0);
}
if (PL_statusvalue == -1) /* hint that value must be returned as is */
result = 1;
- STATUS_NATIVE_SET(value);
+ STATUS_NATIVE_CHILD_SET(value);
do_execfree();
SP = ORIGMARK;
PUSHi(result ? value : STATUS_CURRENT);
* Given that legal timezones are typically between GMT-12 and GMT+12
* we turn back the clock 23 hours before calling the localtime
* function, and add those to the return value. This will never cause
- * day wrapping problems, since the edge case is Jan *19*
+ * day wrapping problems, since the edge case is Tue Jan *19*
*/
T = *tp - 82800; /* 23 hour. allows up to GMT-23 */
P = localtime (&T);
P->tm_hour += 23;
if (P->tm_hour >= 24) {
P->tm_hour -= 24;
- P->tm_mday++;
+ P->tm_mday++; /* 18 -> 19 */
+ P->tm_wday++; /* Mon -> Tue */
+ P->tm_yday++; /* 18 -> 19 */
}
return (P);
} /* S_my_localtime */
https://perl5.git.perl.org / perl5.git / blobdiff