#ifndef getpwent
struct passwd *getpwent (void);
#elif defined (VMS) && defined (my_getpwent)
- struct passwd *Perl_my_getpwent (void);
+ struct passwd *Perl_my_getpwent (pTHX);
#endif
# endif
#endif
#undef PERL_EFF_ACCESS_W_OK
#undef PERL_EFF_ACCESS_X_OK
+/* AIX 5.2 and below use mktime for localtime, and defines the edge case
+ * for time 0x7fffffff to be valid only in UTC. AIX 5.3 provides localtime64
+ * available in the 32bit environment, which could warrant Configure
+ * checks in the future.
+ */
+#ifdef _AIX
+#define LOCALTIME_EDGECASE_BROKEN
+#endif
+
/* F_OK unused: if stat() cannot find it... */
#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESS) && defined(EFF_ONLY_OK) && !defined(NO_EFF_ONLY_OK)
{
dSP; dTARGET;
PerlIO *fp;
- STRLEN n_a;
- char *tmps = POPpx;
+ const char * const tmps = POPpconstx;
const I32 gimme = GIMME_V;
const char *mode = "r";
mode = "rb";
else if (PL_op->op_private & OPpOPEN_IN_CRLF)
mode = "rt";
- fp = PerlProc_popen(tmps, (char *)mode);
+ fp = PerlProc_popen(tmps, mode);
if (fp) {
const char *type = NULL;
if (PL_curcop->cop_io) {
- type = SvPV_nolen(PL_curcop->cop_io);
+ type = SvPV_nolen_const(PL_curcop->cop_io);
}
if (type && *type)
PerlIO_apply_layers(aTHX_ fp,mode,type);
if (gimme == G_VOID) {
char tmpbuf[256];
while (PerlIO_read(fp, tmpbuf, sizeof tmpbuf) > 0)
- /*SUPPRESS 530*/
;
}
else if (gimme == G_SCALAR) {
PL_rs = &PL_sv_undef;
sv_setpvn(TARG, "", 0); /* note that this preserves previous buffer */
while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
- /*SUPPRESS 530*/
;
LEAVE;
XPUSHs(TARG);
SvTAINTED_on(TARG);
}
else {
- SV *sv;
-
for (;;) {
- sv = NEWSV(56, 79);
+ SV * const sv = NEWSV(56, 79);
if (sv_gets(sv, fp, 0) == Nullch) {
SvREFCNT_dec(sv);
break;
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 {
- STATUS_NATIVE_SET(-1);
+ STATUS_NATIVE_CHILD_SET(-1);
if (gimme == G_SCALAR)
RETPUSHUNDEF;
}
else {
tmpsv = TOPs;
}
- tmps = SvPV(tmpsv, len);
+ tmps = SvPV_const(tmpsv, len);
if ((!tmps || !len) && PL_errgv) {
- SV *error = ERRSV;
- (void)SvUPGRADE(error, SVt_PV);
+ SV * const error = ERRSV;
+ SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...caught");
tmpsv = error;
- tmps = SvPV(tmpsv, len);
+ tmps = SvPV_const(tmpsv, len);
}
if (!tmps || !len)
tmpsv = sv_2mortal(newSVpvn("Warning: something's wrong", 26));
dTARGET;
do_join(TARG, &PL_sv_no, MARK, SP);
tmpsv = TARG;
- tmps = SvPV(tmpsv, len);
+ tmps = SvPV_const(tmpsv, len);
multiarg = 1;
SP = MARK + 1;
}
else {
tmpsv = TOPs;
- tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, len);
+ tmps = SvROK(tmpsv) ? Nullch : SvPV_const(tmpsv, len);
}
if (!tmps || !len) {
SV *error = ERRSV;
- (void)SvUPGRADE(error, SVt_PV);
+ SvUPGRADE(error, SVt_PV);
if (multiarg ? SvROK(error) : SvROK(tmpsv)) {
if (!multiarg)
SvSetSV(error,tmpsv);
sv_setsv(error,*PL_stack_sp--);
}
}
- DIE_NULL;
+ DIE(aTHX_ Nullch);
}
else {
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...propagated");
tmpsv = error;
- tmps = SvPV(tmpsv, len);
+ if (SvOK(tmpsv))
+ tmps = SvPV_const(tmpsv, len);
+ else
+ tmps = Nullch;
}
}
if (!tmps || !len)
GV *gv;
SV *sv;
IO *io;
- char *tmps;
+ const char *tmps;
STRLEN len;
MAGIC *mg;
bool ok;
sv = *++MARK;
}
else {
- sv = GvSV(gv);
+ sv = GvSVn(gv);
}
- tmps = SvPV(sv, len);
+ tmps = SvPV_const(sv, len);
ok = do_openn(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp, MARK+1, (SP-MARK));
SP = ORIGMARK;
if (ok)
TAINT_PROPER("umask");
XPUSHi(anum);
#else
- /* Only DIE if trying to restrict permissions on `user' (self).
+ /* Only DIE if trying to restrict permissions on "user" (self).
* Otherwise it's harmless and more useful to just return undef
* since 'group' and 'other' concepts probably don't exist here. */
if (MAXARG >= 1 && (POPi & 0700))
PUTBACK;
if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
- (discp) ? SvPV_nolen(discp) : Nullch)) {
+ (discp) ? SvPV_nolen_const(discp) : Nullch)) {
if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
if (!PerlIO_binmode(aTHX_ IoOFP(io),IoTYPE(io),
mode_from_discipline(discp),
- (discp) ? SvPV_nolen(discp) : Nullch)) {
+ (discp) ? SvPV_nolen_const(discp) : Nullch)) {
SPAGAIN;
RETPUSHUNDEF;
}
RETPUSHYES;
if ((mg = SvTIED_mg(sv, how))) {
- SV *obj = SvRV(SvTIED_obj(sv, mg));
+ SV * const obj = SvRV(SvTIED_obj(sv, mg));
GV *gv;
CV *cv = NULL;
if (obj) {
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 ) ;
PP(pp_tied)
{
dSP;
- MAGIC *mg;
+ const MAGIC *mg;
SV *sv = POPs;
const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
PP(pp_dbmopen)
{
dVAR; dSP;
- HV *hv;
dPOPPOPssrl;
HV* stash;
GV *gv;
SV *sv;
- hv = (HV*)POPs;
+ HV * const hv = (HV*)POPs;
sv = sv_mortalcopy(&PL_sv_no);
sv_setpv(sv, "AnyDBM_File");
struct timeval *tbuf = &timebuf;
I32 growsize;
char *fd_sets[4];
- STRLEN n_a;
#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
I32 masksize;
I32 offset;
SP -= 4;
for (i = 1; i <= 3; i++) {
- if (!SvPOK(SP[i]))
+ SV *sv = SP[i];
+ if (SvOK(sv) && SvREADONLY(sv)) {
+ if (SvIsCOW(sv))
+ sv_force_normal_flags(sv, 0);
+ if (SvREADONLY(sv))
+ DIE(aTHX_ PL_no_modify);
+ }
+ if (!SvPOK(sv))
continue;
- j = SvCUR(SP[i]);
+ j = SvCUR(sv);
if (maxlen < j)
maxlen = j;
}
continue;
}
else if (!SvPOK(sv))
- SvPV_force(sv,n_a); /* force string conversion */
+ SvPV_force_nolen(sv); /* force string conversion */
j = SvLEN(sv);
if (j < growsize) {
Sv_Grow(sv, growsize);
#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];
}
}
- if (nfound == -1)
- PUSHs(&PL_sv_undef);
- else
- PUSHi(nfound);
+ PUSHi(nfound);
if (GIMME == G_ARRAY && tbuf) {
value = (NV)(timebuf.tv_sec) +
(NV)(timebuf.tv_usec) / 1000000.0;
if (! hv)
XPUSHs(&PL_sv_undef);
else {
- GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
+ GV ** const gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
if (gvp && *gvp == egv) {
gv_efullname4(TARG, PL_defoutgv, Nullch, TRUE);
XPUSHTARG;
PP(pp_getc)
{
dVAR; dSP; dTARGET;
- GV *gv;
IO *io = NULL;
MAGIC *mg;
-
- if (MAXARG == 0)
- gv = PL_stdingv;
- else
- gv = (GV*)POPs;
+ GV * const gv = (MAXARG==0) ? PL_stdingv : (GV*)POPs;
if (gv && (io = GvIO(gv))
&& (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
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;
*SvPVX(TARG) = PerlIO_getc(IoIFP(GvIOp(gv))); /* should never be EOF */
if (PerlIO_isutf8(IoIFP(GvIOp(gv)))) {
/* Find out how many bytes the char needs */
- Size_t len = UTF8SKIP(SvPVX(TARG));
+ Size_t len = UTF8SKIP(SvPVX_const(TARG));
if (len > 1) {
SvGROW(TARG,len+1);
len = PerlIO_read(IoIFP(GvIOp(gv)),SvPVX(TARG)+1,len-1);
PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
PUSHFORMAT(cx);
cx->blk_sub.retop = retop;
- PAD_SET_CUR(CvPADLIST(cv), 1);
+ SAVECOMPPAD();
+ PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1);
setdefout(gv); /* locally select filehandle so $% et al work */
return CvSTART(cv);
if (!cv) {
if (fgv) {
SV * const tmpsv = sv_newmortal();
- char *name;
+ const char *name;
gv_efullname4(tmpsv, fgv, Nullch, FALSE);
- name = SvPV_nolen(tmpsv);
+ name = SvPV_nolen_const(tmpsv);
if (name && *name)
DIE(aTHX_ "Undefined format \"%s\" called", name);
}
PP(pp_leavewrite)
{
dVAR; dSP;
- GV *gv = cxstack[cxstack_ix].blk_sub.gv;
- register IO *io = GvIOp(gv);
- PerlIO *ofp = IoOFP(io);
+ GV * const gv = cxstack[cxstack_ix].blk_sub.gv;
+ register IO * const io = GvIOp(gv);
+ PerlIO * const ofp = IoOFP(io);
PerlIO *fp;
SV **newsp;
I32 gimme;
CV *cv;
if (!IoTOP_GV(io)) {
GV *topgv;
- SV *topname;
if (!IoTOP_NAME(io)) {
+ SV *topname;
if (!IoFMT_NAME(io))
IoFMT_NAME(io) = savepv(GvNAME(gv));
topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv)));
}
if (s) {
const STRLEN save = SvCUR(PL_formtarget);
- SvCUR_set(PL_formtarget, s - SvPVX(PL_formtarget));
+ SvCUR_set(PL_formtarget, s - SvPVX_const(PL_formtarget));
do_print(PL_formtarget, ofp);
SvCUR_set(PL_formtarget, save);
sv_chop(PL_formtarget, s);
cv = GvFORM(fgv);
if (!cv) {
SV * const sv = sv_newmortal();
- char *name;
+ const char *name;
gv_efullname4(sv, fgv, Nullch, FALSE);
- name = SvPV_nolen(sv);
+ name = SvPV_nolen_const(sv);
if (name && *name)
DIE(aTHX_ "Undefined top format \"%s\" called",name);
}
/* bad_ofp: */
PL_formtarget = PL_bodytarget;
PUTBACK;
+ PERL_UNUSED_VAR(newsp);
+ PERL_UNUSED_VAR(gimme);
return cx->blk_sub.retop;
}
PP(pp_sysopen)
{
dSP;
- GV *gv;
- SV *sv;
- char *tmps;
- STRLEN len;
const int perm = (MAXARG > 3) ? POPi : 0666;
const int mode = POPi;
-
- sv = POPs;
- gv = (GV *)POPs;
+ SV * const sv = POPs;
+ GV * const gv = (GV *)POPs;
+ STRLEN len;
/* Need TIEHANDLE method ? */
-
- tmps = SvPV(sv, len);
+ const char * const tmps = SvPV_const(sv, len);
+ /* FIXME? do_open should do const */
if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
IoLINES(GvIOp(gv)) = 0;
PUSHs(&PL_sv_yes);
{
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
int offset;
- GV *gv;
IO *io;
char *buffer;
SSize_t length;
Sock_size_t bufsize;
SV *bufsv;
STRLEN blen;
- MAGIC *mg;
int fp_utf8;
int buffer_utf8;
SV *read_target;
STRLEN charskip = 0;
STRLEN skip = 0;
- gv = (GV*)*++MARK;
+ GV * const gv = (GV*)*++MARK;
if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD)
- && gv && (io = GvIO(gv))
- && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ && gv && (io = GvIO(gv)) )
{
- SV *sv;
-
- PUSHMARK(MARK-1);
- *MARK = SvTIED_obj((SV*)io, mg);
- ENTER;
- call_method("READ", G_SCALAR);
- LEAVE;
- SPAGAIN;
- sv = POPs;
- SP = ORIGMARK;
- PUSHs(sv);
- RETURN;
+ const MAGIC * mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
+ if (mg) {
+ SV *sv;
+ PUSHMARK(MARK-1);
+ *MARK = SvTIED_obj((SV*)io, mg);
+ ENTER;
+ call_method("READ", G_SCALAR);
+ LEAVE;
+ SPAGAIN;
+ sv = POPs;
+ SP = ORIGMARK;
+ PUSHs(sv);
+ RETURN;
+ }
}
if (!gv)
SvCUR_set(bufsv, offset);
read_target = sv_newmortal();
- (void)SvUPGRADE(read_target, SVt_PV);
+ SvUPGRADE(read_target, SVt_PV);
buffer = SvGROW(read_target, (STRLEN)(length + 1));
}
report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY);
goto say_undef;
}
- SvCUR_set(read_target, count+(buffer - SvPVX(read_target)));
+ SvCUR_set(read_target, count+(buffer - SvPVX_const(read_target)));
*SvEND(read_target) = '\0';
(void)SvPOK_only(read_target);
if (fp_utf8 && !IN_BYTES) {
if (buffer - charskip + skip > bend) {
/* partial character - try for rest of it */
length = skip - (bend-buffer);
- offset = bend - SvPVX(bufsv);
+ offset = bend - SvPVX_const(bufsv);
charstart = FALSE;
charskip += count;
goto more_bytes;
*/
if (got < wanted && count == length) {
length = wanted - got;
- offset = bend - SvPVX(bufsv);
+ offset = bend - SvPVX_const(bufsv);
goto more_bytes;
}
/* return value is character count */
GV *gv;
IO *io;
SV *bufsv;
- char *buffer;
+ const char *buffer;
Size_t length;
SSize_t retval;
STRLEN blen;
bufsv = sv_2mortal(newSVsv(bufsv));
buffer = sv_2pvutf8(bufsv, &blen);
} else
- buffer = SvPV(bufsv, blen);
+ buffer = SvPV_const(bufsv, blen);
}
else {
if (DO_UTF8(bufsv)) {
bufsv = sv_2mortal(newSVsv(bufsv));
sv_utf8_downgrade(bufsv, FALSE);
}
- buffer = SvPV(bufsv, blen);
+ buffer = SvPV_const(bufsv, blen);
}
if (PL_op->op_type == OP_SYSWRITE) {
if (length > blen - offset)
length = blen - offset;
if (DO_UTF8(bufsv)) {
- buffer = (char*)utf8_hop((U8 *)buffer, offset);
+ buffer = (const char*)utf8_hop((const U8 *)buffer, offset);
length = utf8_hop((U8 *)buffer, length) - (U8 *)buffer;
}
else {
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));
}
}
else {
SV *sv = POPs;
- char *name;
- STRLEN n_a;
+ const char *name;
if (SvTYPE(sv) == SVt_PVGV) {
tmpgv = (GV*)sv; /* *main::FRED for example */
goto do_ftruncate_io;
}
- name = SvPV(sv, n_a);
+ name = SvPV_nolen_const(sv);
TAINT_PROPER("truncate");
#ifdef HAS_TRUNCATE
if (truncate(name, len) < 0)
extern void GETUSERMODE();
#endif
SV *addrsv = POPs;
- char *addr;
+ /* OK, so on what platform does bind modify addr? */
+ const char *addr;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
STRLEN len;
if (!io || !IoIFP(io))
goto nuts;
- addr = SvPV(addrsv, len);
+ addr = SvPV_const(addrsv, len);
TAINT_PROPER("bind");
#ifdef MPE /* Deal with MPE bind() peculiarities */
if (((struct sockaddr *)addr)->sa_family == AF_INET) {
#ifdef HAS_SOCKET
dSP;
SV *addrsv = POPs;
- char *addr;
+ const char *addr;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
STRLEN len;
if (!io || !IoIFP(io))
goto nuts;
- addr = SvPV(addrsv, len);
+ addr = SvPV_const(addrsv, len);
TAINT_PROPER("connect");
if (PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
RETPUSHYES;
PUSHs(sv);
break;
case OP_SSOCKOPT: {
- char *buf;
+ const char *buf;
int aint;
if (SvPOKp(sv)) {
STRLEN l;
- buf = SvPV(sv, l);
+ buf = SvPV_const(sv, l);
len = l;
}
else {
aint = (int)SvIV(sv);
- buf = (char*)&aint;
+ buf = (const char*)&aint;
len = sizeof(int);
}
if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0)
{
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(sv))->sa_family == AF_INET &&
- !memcmp((char *)SvPVX(sv) + sizeof(u_short), nowhere,
+ if (((struct sockaddr *)SvPVX_const(sv))->sa_family == AF_INET &&
+ !memcmp(SvPVX_const(sv) + sizeof(u_short), nowhere,
sizeof(u_short) + sizeof(struct in_addr))) {
goto nuts2;
}
GV *gv;
I32 gimme;
I32 max = 13;
- STRLEN n_a;
if (PL_op->op_flags & OPf_REF) {
gv = cGVOP_gv;
"lstat() on filehandle %s", GvENAME(gv));
goto do_fstat;
}
- sv_setpv(PL_statname, SvPV(sv,n_a));
+ sv_setpv(PL_statname, SvPV_nolen_const(sv));
PL_statgv = Nullgv;
PL_laststype = PL_op->op_type;
if (PL_op->op_type == OP_LSTAT)
- PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, n_a), &PL_statcache);
+ PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(PL_statname), &PL_statcache);
else
- PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache);
+ PL_laststatval = PerlLIO_stat(SvPV_nolen_const(PL_statname), &PL_statcache);
if (PL_laststatval < 0) {
- if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
+ if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname), '\n'))
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
max = 0;
}
STACKED_FTEST_CHECK;
#if defined(HAS_ACCESS) && defined(R_OK)
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
- STRLEN n_a;
result = access(POPpx, R_OK);
if (result == 0)
RETPUSHYES;
STACKED_FTEST_CHECK;
#if defined(HAS_ACCESS) && defined(W_OK)
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
- STRLEN n_a;
result = access(POPpx, W_OK);
if (result == 0)
RETPUSHYES;
STACKED_FTEST_CHECK;
#if defined(HAS_ACCESS) && defined(X_OK)
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
- STRLEN n_a;
result = access(POPpx, X_OK);
if (result == 0)
RETPUSHYES;
STACKED_FTEST_CHECK;
#ifdef PERL_EFF_ACCESS_R_OK
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
- STRLEN n_a;
result = PERL_EFF_ACCESS_R_OK(POPpx);
if (result == 0)
RETPUSHYES;
STACKED_FTEST_CHECK;
#ifdef PERL_EFF_ACCESS_W_OK
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
- STRLEN n_a;
result = PERL_EFF_ACCESS_W_OK(POPpx);
if (result == 0)
RETPUSHYES;
STACKED_FTEST_CHECK;
#ifdef PERL_EFF_ACCESS_X_OK
if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
- STRLEN n_a;
result = PERL_EFF_ACCESS_X_OK(POPpx);
if (result == 0)
RETPUSHYES;
if (GvIO(gv) && IoIFP(GvIOp(gv)))
fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
else if (tmpsv && SvOK(tmpsv)) {
- STRLEN n_a;
- char *tmps = SvPV(tmpsv, n_a);
+ const char *tmps = SvPV_nolen_const(tmpsv);
if (isDIGIT(*tmps))
fd = atoi(tmps);
else
register IO *io;
register SV *sv;
GV *gv;
- STRLEN n_a;
PerlIO *fp;
STACKED_FTEST_CHECK;
really_filename:
PL_statgv = Nullgv;
PL_laststype = OP_STAT;
- sv_setpv(PL_statname, SvPV(sv, n_a));
- if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) {
- if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
+ sv_setpv(PL_statname, SvPV_nolen_const(sv));
+ if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
+ if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
+ '\n'))
Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
RETPUSHUNDEF;
}
PP(pp_chdir)
{
dSP; dTARGET;
- char *tmps;
- SV **svp;
- STRLEN n_a;
+ const char *tmps = 0;
+ GV *gv = NULL;
- if( MAXARG == 1 )
- tmps = POPpx;
- 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( !gv && (!tmps || !*tmps) ) {
+ HV * const table = GvHVn(PL_envgv);
+ SV **svp;
- if( !tmps || !*tmps ) {
- if ( (svp = hv_fetch(GvHVn(PL_envgv), "HOME", 4, FALSE))
- || (svp = hv_fetch(GvHVn(PL_envgv), "LOGDIR", 6, FALSE))
+ 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
)
{
if( MAXARG == 1 )
deprecate("chdir('') or chdir(undef) as chdir()");
- tmps = SvPV(*svp, n_a);
+ tmps = SvPV_nolen_const(*svp);
}
else {
PUSHi(0);
}
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. */
{
#ifdef HAS_CHROOT
dSP; dTARGET;
- STRLEN n_a;
char *tmps = POPpx;
TAINT_PROPER("chroot");
PUSHi( chroot(tmps) >= 0 );
{
dSP; dTARGET;
int anum;
- STRLEN n_a;
-
- char *tmps2 = POPpx;
- char *tmps = SvPV(TOPs, n_a);
+ const char *tmps2 = POPpconstx;
+ const char *tmps = SvPV_nolen_const(TOPs);
TAINT_PROPER("rename");
#ifdef HAS_RENAME
anum = PerlLIO_rename(tmps, tmps2);
{
#ifdef HAS_LINK
dSP; dTARGET;
- STRLEN n_a;
- char *tmps2 = POPpx;
- char *tmps = SvPV(TOPs, n_a);
+ const char *tmps2 = POPpconstx;
+ const char *tmps = SvPV_nolen_const(TOPs);
TAINT_PROPER("link");
SETi( PerlLIO_link(tmps, tmps2) >= 0 );
RETURN;
{
#ifdef HAS_SYMLINK
dSP; dTARGET;
- STRLEN n_a;
- char *tmps2 = POPpx;
- char *tmps = SvPV(TOPs, n_a);
+ const char *tmps2 = POPpconstx;
+ const char *tmps = SvPV_nolen_const(TOPs);
TAINT_PROPER("symlink");
SETi( symlink(tmps, tmps2) >= 0 );
RETURN;
dSP;
#ifdef HAS_SYMLINK
dTARGET;
- char *tmps;
+ const char *tmps;
char buf[MAXPATHLEN];
int len;
- STRLEN n_a;
#ifndef INCOMPLETE_TAINTS
TAINT;
#endif
- tmps = POPpx;
+ tmps = POPpconstx;
len = readlink(tmps, buf, sizeof(buf) - 1);
EXTEND(SP, 1);
if (len < 0)
#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
STATIC int
-S_dooneliner(pTHX_ char *cmd, char *filename)
+S_dooneliner(pTHX_ const char *cmd, const char *filename)
{
- char *save_filename = filename;
+ char * const save_filename = filename;
char *cmdline;
char *s;
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; ) {
* -d, chdir(), chmod(), chown(), chroot(), fcntl()?,
* (mkdir()), opendir(), rename(), rmdir(), stat(). --jhi */
-#define TRIMSLASHES(tmps,len,copy) (tmps) = SvPV(TOPs, (len)); \
+#define TRIMSLASHES(tmps,len,copy) (tmps) = SvPV_const(TOPs, (len)); \
if ((len) > 1 && (tmps)[(len)-1] == '/') { \
do { \
(len)--; \
int oldumask;
#endif
STRLEN len;
- char *tmps;
+ const char *tmps;
bool copy = FALSE;
if (MAXARG > 1)
{
dSP; dTARGET;
STRLEN len;
- char *tmps;
+ const char *tmps;
bool copy = FALSE;
TRIMSLASHES(tmps,len,copy);
{
#if defined(Direntry_t) && defined(HAS_READDIR)
dSP;
- STRLEN n_a;
- char *dirname = POPpx;
+ const char *dirname = POPpconstx;
GV *gv = (GV*)POPs;
register IO *io = GvIOn(gv);
if (childpid < 0)
RETSETUNDEF;
if (!childpid) {
- /*SUPPRESS 560*/
if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV))) {
SvREADONLY_off(GvSV(tmpgv));
sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
}
# 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;
{
dSP; dMARK; dORIGMARK; dTARGET;
I32 value;
- STRLEN n_a;
int result;
if (PL_tainting) {
TAINT_ENV();
while (++MARK <= SP) {
- (void)SvPV_nolen(*MARK); /* stringify for taint check */
+ (void)SvPV_nolen_const(*MARK); /* stringify for taint check */
if (PL_tainted)
break;
}
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);
(void)rsignal_restore(SIGINT, &ihand);
(void)rsignal_restore(SIGQUIT, &qhand);
#endif
- STATUS_NATIVE_SET(result == -1 ? -1 : status);
+ STATUS_NATIVE_CHILD_SET(result == -1 ? -1 : status);
do_execfree(); /* free any memory child malloced on fork */
SP = ORIGMARK;
if (did_pipes) {
if (n != sizeof(int))
DIE(aTHX_ "panic: kid popen errno read");
errno = errkid; /* Propagate errno from kid */
- STATUS_CURRENT = -1;
+ STATUS_NATIVE_CHILD_SET(-1);
}
}
PUSHi(STATUS_CURRENT);
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);
+ value = (I32)do_exec3(SvPVx_nolen(sv_mortalcopy(*SP)), pp[1], did_pipes);
}
PerlProc__exit(-1);
}
result = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV *really = *++MARK;
-# if defined(WIN32) || defined(OS2) || defined(SYMBIAN)
+# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
value = (I32)do_aspawn(really, MARK, SP);
# else
value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
# endif
}
else if (SP - MARK != 1) {
-# if defined(WIN32) || defined(OS2) || defined(SYMBIAN)
+# if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
value = (I32)do_aspawn(Nullsv, MARK, SP);
# else
value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
# endif
}
else {
- value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
+ value = (I32)do_spawn(SvPVx_nolen(sv_mortalcopy(*SP)));
}
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);
{
dSP; dMARK; dORIGMARK; dTARGET;
I32 value;
- STRLEN n_a;
if (PL_tainting) {
TAINT_ENV();
while (++MARK <= SP) {
- (void)SvPV_nolen(*MARK); /* stringify for taint check */
+ (void)SvPV_nolen_const(*MARK); /* stringify for taint check */
if (PL_tainted)
break;
}
#endif
else {
#ifdef VMS
- value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
+ value = (I32)vms_do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
#else
# ifdef __OPEN_VM
- (void) do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
+ (void) do_spawn(SvPVx_nolen(sv_mortalcopy(*SP)));
value = 0;
# else
- value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), n_a));
+ value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
# endif
#endif
}
#ifdef HAS_GETPPID
dSP; dTARGET;
# ifdef THREADS_HAVE_PIDS
- {
- IV cur_ppid = getppid();
- if (cur_ppid == 1)
- /* maybe the parent process has died. Refresh ppid cache */
- PL_ppid = cur_ppid;
- }
+ if (PL_ppid != 1 && getppid() == 1)
+ /* maybe the parent process has died. Refresh ppid cache */
+ PL_ppid = 1;
XPUSHi( PL_ppid );
# else
XPUSHi( getppid() );
return pp_gmtime();
}
+#ifdef LOCALTIME_EDGECASE_BROKEN
+static struct tm *S_my_localtime (pTHX_ Time_t *tp)
+{
+ auto time_t T;
+ auto struct tm *P;
+
+ /* No workarounds in the valid range */
+ if (!tp || *tp < 0x7fff573f || *tp >= 0x80000000)
+ return (localtime (tp));
+
+ /* This edge case is to workaround the undefined behaviour, where the
+ * TIMEZONE makes the time go beyond the defined range.
+ * gmtime (0x7fffffff) => 2038-01-19 03:14:07
+ * If there is a negative offset in TZ, like MET-1METDST, some broken
+ * implementations of localtime () (like AIX 5.2) barf with bogus
+ * return values:
+ * 0x7fffffff gmtime 2038-01-19 03:14:07
+ * 0x7fffffff localtime 1901-12-13 21:45:51
+ * 0x7fffffff mylocaltime 2038-01-19 04:14:07
+ * 0x3c19137f gmtime 2001-12-13 20:45:51
+ * 0x3c19137f localtime 2001-12-13 21:45:51
+ * 0x3c19137f mylocaltime 2001-12-13 21:45:51
+ * 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 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++; /* 18 -> 19 */
+ P->tm_wday++; /* Mon -> Tue */
+ P->tm_yday++; /* 18 -> 19 */
+ }
+ return (P);
+} /* S_my_localtime */
+#endif
+
PP(pp_gmtime)
{
dSP;
#endif
if (PL_op->op_type == OP_LOCALTIME)
+#ifdef LOCALTIME_EDGECASE_BROKEN
+ tmbuf = S_my_localtime(aTHX_ &when);
+#else
tmbuf = localtime(&when);
+#endif
else
tmbuf = gmtime(&when);
#endif
struct hostent *hent;
unsigned long len;
- STRLEN n_a;
EXTEND(SP, 10);
if (which == OP_GHBYNAME) {
h_errno = PL_reentrant_buffer->_gethostent_errno;
# endif
#endif
- STATUS_NATIVE_SET(h_errno);
+ STATUS_UNIX_SET(h_errno);
}
#endif
struct netent *getnetent(void);
#endif
struct netent *nent;
- STRLEN n_a;
if (which == OP_GNBYNAME){
#ifdef HAS_GETNETBYNAME
h_errno = PL_reentrant_buffer->_getnetent_errno;
# endif
#endif
- STATUS_NATIVE_SET(h_errno);
+ STATUS_UNIX_SET(h_errno);
}
#endif
struct protoent *getprotoent(void);
#endif
struct protoent *pent;
- STRLEN n_a;
if (which == OP_GPBYNAME) {
#ifdef HAS_GETPROTOBYNAME
struct servent *getservent(void);
#endif
struct servent *sent;
- STRLEN n_a;
if (which == OP_GSBYNAME) {
#ifdef HAS_GETSERVBYNAME
dSP;
I32 which = PL_op->op_type;
register SV *sv;
- STRLEN n_a;
struct passwd *pwent = NULL;
/*
* We currently support only the SysV getsp* shadow password interface.
register char **elem;
register SV *sv;
struct group *grent;
- STRLEN n_a;
if (which == OP_GGRNAM) {
char* name = POPpbytex;
unsigned long a[20];
register I32 i = 0;
I32 retval = -1;
- STRLEN n_a;
if (PL_tainting) {
while (++MARK <= SP) {
else if (*MARK == &PL_sv_undef)
a[i++] = 0;
else
- a[i++] = (unsigned long)SvPV_force(*MARK, n_a);
+ a[i++] = (unsigned long)SvPV_force_nolen(*MARK);
if (i > 15)
break;
}
https://perl5.git.perl.org / perl5.git / blobdiff