#define PERL_IN_PP_SYS_C
#include "perl.h"
#include "time64.h"
-#include "time64.c"
#ifdef I_SHADOW
/* Shadow password support for solaris - pdo@cs.umd.edu
I32 gimme;
PERL_CONTEXT *cx;
OP *retop;
+ bool is_return = cBOOL(PL_op->op_type == OP_RETURN);
- if (!io || !(ofp = IoOFP(io)))
+ if (is_return || !io || !(ofp = IoOFP(io)))
goto forget_top;
DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n",
SP = newsp; /* ignore retval of formline */
LEAVE;
- if (!io || !(fp = IoOFP(io))) {
+ if (is_return)
+ /* XXX the semantics of doing 'return' in a format aren't documented.
+ * Currently we ignore any args to 'return' and just return
+ * a single undef in both scalar and list contexts
+ */
+ PUSHs(&PL_sv_undef);
+ else if (!io || !(fp = IoOFP(io))) {
if (io && IoIFP(io))
report_wrongway_fh(gv, '<');
else
fd = PerlIO_fileno(IoIFP(io));
if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
+ if (PL_op->op_type == OP_SYSREAD || PL_op->op_type == OP_RECV) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+ "%s() is deprecated on :utf8 handles",
+ OP_DESC(PL_op));
+ }
buffer = SvPVutf8_force(bufsv, blen);
/* UTF-8 may not have been set if they are all low bytes */
SvUTF8_on(bufsv);
doing_utf8 = DO_UTF8(bufsv);
if (PerlIO_isutf8(IoIFP(io))) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_DEPRECATED),
+ "%s() is deprecated on :utf8 handles",
+ OP_DESC(PL_op));
if (!SvUTF8(bufsv)) {
/* We don't modify the original scalar. */
tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
SETERRNO(EBADF,RMS_IFI);
result = 0;
} else {
- PerlIO_flush(fp);
+ if (len < 0) {
+ SETERRNO(EINVAL, LIB_INVARG);
+ result = 0;
+ } else {
+ PerlIO_flush(fp);
#ifdef HAS_TRUNCATE
- if (ftruncate(fd, len) < 0)
+ if (ftruncate(fd, len) < 0)
#else
- if (my_chsize(fd, len) < 0)
+ if (my_chsize(fd, len) < 0)
#endif
- result = 0;
+ result = 0;
+ }
}
}
}
SV * const sv = POPs;
if (PL_op->op_flags & OPf_SPECIAL) {
gv = gv_fetchsv(sv, 0, SVt_PVIO);
+ if (!gv) {
+ if (ckWARN(WARN_UNOPENED)) {
+ Perl_warner(aTHX_ packWARN(WARN_UNOPENED),
+ "chdir() on unopened filehandle %" SVf, sv);
+ }
+ SETERRNO(EBADF,RMS_IFI);
+ PUSHi(0);
+ TAINT_PROPER("chdir");
+ RETURN;
+ }
}
else if (!(gv = MAYBE_DEREF_GV(sv)))
tmps = SvPV_nomg_const_nolen(sv);
}
else {
PUSHi(0);
+ SETERRNO(EINVAL, LIB_INVARG);
TAINT_PROPER("chdir");
RETURN;
}
STRLEN len;
const char *tmps;
bool copy = FALSE;
- const int mode = (MAXARG > 1 && (TOPs||((void)POPs,0))) ? POPi : 0777;
+ const unsigned int mode = (MAXARG > 1 && (TOPs||((void)POPs,0))) ? POPu : 0777;
TRIMSLASHES(tmps,len,copy);
}
else {
if (PL_op->op_type == OP_LOCALTIME)
- err = S_localtime64_r(&when, &tmbuf);
+ err = Perl_localtime64_r(&when, &tmbuf);
else
- err = S_gmtime64_r(&when, &tmbuf);
+ err = Perl_gmtime64_r(&when, &tmbuf);
}
if (err == NULL) {
{
#ifdef HAS_ALARM
dSP; dTARGET;
- int anum;
- anum = POPi;
- anum = alarm((unsigned int)anum);
- if (anum < 0)
- RETPUSHUNDEF;
- PUSHi(anum);
- RETURN;
+ /* alarm() takes an unsigned int number of seconds, and return the
+ * unsigned int number of seconds remaining in the previous alarm
+ * (alarms don't stack). Therefore negative return values are not
+ * possible. */
+ int anum = POPi;
+ if (anum < 0) {
+ /* Note that while the C library function alarm() as such has
+ * no errors defined (or in other words, properly behaving client
+ * code shouldn't expect any), alarm() being obsoleted by
+ * setitimer() and often being implemented in terms of
+ * setitimer(), can fail. */
+ /* diag_listed_as: %s() with negative argument */
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC),
+ "alarm() with negative argument");
+ SETERRNO(EINVAL, LIB_INVARG);
+ RETPUSHUNDEF;
+ }
+ else {
+ unsigned int retval = alarm(anum);
+ if ((int)retval < 0) /* Strictly speaking "cannot happen". */
+ RETPUSHUNDEF;
+ PUSHu(retval);
+ RETURN;
+ }
#else
DIE(aTHX_ PL_no_func, "alarm");
#endif
PerlProc_pause();
else {
duration = POPi;
- PerlProc_sleep((unsigned int)duration);
+ if (duration < 0) {
+ /* diag_listed_as: %s() with negative argument */
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC),
+ "sleep() with negative argument");
+ SETERRNO(EINVAL, LIB_INVARG);
+ XPUSHi(0);
+ RETURN;
+ } else {
+ PerlProc_sleep((unsigned int)duration);
+ }
}
(void)time(&when);
XPUSHi(when - lasttime);
grent = (const struct group *)getgrnam(name);
}
else if (which == OP_GGRGID) {
+#if Gid_t_sign == 1
+ const Gid_t gid = POPu;
+#elif Gid_t_sign == -1
const Gid_t gid = POPi;
+#else
+# error "Unexpected Gid_t_sign"
+#endif
grent = (const struct group *)getgrgid(gid);
}
else