#include "EXTERN.h"
#define PERL_IN_PP_SYS_C
#include "perl.h"
-#ifndef PERL_MICRO
+#if !defined(PERL_MICRO) && defined(Quad_t)
# include "time64.h"
# include "time64.c"
#endif
break;
case SVt_PVGV:
if (isGV_with_GP(varsv)) {
-#ifdef GV_UNIQUE_CHECK
- if (GvUNIQUE((const GV *)varsv)) {
- Perl_croak(aTHX_ "Attempt to tie unique GV");
- }
-#endif
methname = "TIEHANDLE";
how = PERL_MAGIC_tiedscalar;
/* For tied filehandles, we apply tiedscalar magic to the IO
SV *sv;
if (MARK == SP - 1) {
- EXTEND(SP, 1000);
- sv = sv_2mortal(newSViv(sv_len(*SP)));
- PUSHs(sv);
+ sv = *SP;
+ mXPUSHi(sv_len(sv));
PUTBACK;
}
int stat_mode = S_IRUSR;
bool effective = FALSE;
+ char opchar = '?';
dSP;
+ switch (PL_op->op_type) {
+ case OP_FTRREAD: opchar = 'R'; break;
+ case OP_FTRWRITE: opchar = 'W'; break;
+ case OP_FTREXEC: opchar = 'X'; break;
+ case OP_FTEREAD: opchar = 'r'; break;
+ case OP_FTEWRITE: opchar = 'w'; break;
+ case OP_FTEEXEC: opchar = 'x'; break;
+ }
+ tryAMAGICftest(opchar);
+
STACKED_FTEST_CHECK;
switch (PL_op->op_type) {
access_mode = W_OK;
#endif
stat_mode = S_IWUSR;
- /* Fall through */
+ /* fall through */
case OP_FTEREAD:
#ifndef PERL_EFF_ACCESS
dVAR;
I32 result;
const int op_type = PL_op->op_type;
+ char opchar = '?';
dSP;
+
+ switch (op_type) {
+ case OP_FTIS: opchar = 'e'; break;
+ case OP_FTSIZE: opchar = 's'; break;
+ case OP_FTMTIME: opchar = 'M'; break;
+ case OP_FTCTIME: opchar = 'C'; break;
+ case OP_FTATIME: opchar = 'A'; break;
+ }
+ tryAMAGICftest(opchar);
+
STACKED_FTEST_CHECK;
+
result = my_stat();
SPAGAIN;
if (result < 0)
{
dVAR;
I32 result;
+ char opchar = '?';
dSP;
+ switch (PL_op->op_type) {
+ case OP_FTROWNED: opchar = 'O'; break;
+ case OP_FTEOWNED: opchar = 'o'; break;
+ case OP_FTZERO: opchar = 'z'; break;
+ case OP_FTSOCK: opchar = 'S'; break;
+ case OP_FTCHR: opchar = 'c'; break;
+ case OP_FTBLK: opchar = 'b'; break;
+ case OP_FTFILE: opchar = 'f'; break;
+ case OP_FTDIR: opchar = 'd'; break;
+ case OP_FTPIPE: opchar = 'p'; break;
+ case OP_FTSUID: opchar = 'u'; break;
+ case OP_FTSGID: opchar = 'g'; break;
+ case OP_FTSVTX: opchar = 'k'; break;
+ }
+ tryAMAGICftest(opchar);
+
/* I believe that all these three are likely to be defined on most every
system these days. */
#ifndef S_ISUID
#endif
STACKED_FTEST_CHECK;
+
result = my_stat();
SPAGAIN;
if (result < 0)
PP(pp_ftlink)
{
dVAR;
- I32 result = my_lstat();
dSP;
+ I32 result;
+
+ tryAMAGICftest('l');
+ result = my_lstat();
+ SPAGAIN;
+
if (result < 0)
RETPUSHUNDEF;
if (S_ISLNK(PL_statcache.st_mode))
GV *gv;
SV *tmpsv = NULL;
+ tryAMAGICftest('t');
+
STACKED_FTEST_CHECK;
if (PL_op->op_flags & OPf_REF)
GV *gv;
PerlIO *fp;
+ tryAMAGICftest(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
+
STACKED_FTEST_CHECK;
if (PL_op->op_flags & OPf_REF)
if (MAXARG < 2) {
pgrp = 0;
pid = 0;
+ XPUSHi(-1);
}
else {
pgrp = POPi;
{
dVAR;
dSP;
-#ifdef PERL_MICRO
+#if defined(PERL_MICRO) || !defined(Quad_t)
Time_t when;
const struct tm *err;
struct tm tmbuf;
{"Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
-#ifdef PERL_MICRO
+#if defined(PERL_MICRO) || !defined(Quad_t)
if (MAXARG < 1)
(void)time(&when);
else
using a double causes an unfortunate loss of accuracy on high numbers.
What we really need is an SvQV.
*/
- double input = POPn;
+ double input = Perl_floor(POPn);
when = (Time64_T)input;
- if( when != input ) {
+ if (when != input && ckWARN(WARN_OVERFLOW)) {
Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"%s(%.0f) too large", opname, input);
}
}
if (PL_op->op_type == OP_LOCALTIME)
- err = localtime64_r(&when, &tmbuf);
+ err = S_localtime64_r(&when, &tmbuf);
else
- err = gmtime64_r(&when, &tmbuf);
+ err = S_gmtime64_r(&when, &tmbuf);
#endif
- if( err == NULL ) {
+ if (err == NULL && ckWARN(WARN_OVERFLOW)) {
/* XXX %lld broken for quads */
Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
"%s(%.0f) failed", opname, (double)when);
PUSHs(sv);
if (grent) {
if (which == OP_GGRNAM)
+#if Gid_t_sign <= 0
sv_setiv(sv, (IV)grent->gr_gid);
+#else
+ sv_setuv(sv, (UV)grent->gr_gid);
+#endif
else
sv_setpv(sv, grent->gr_name);
}
PUSHs(sv_mortalcopy(&PL_sv_no));
#endif
+#if Gid_t_sign <= 0
mPUSHi(grent->gr_gid);
+#else
+ mPUSHu(grent->gr_gid);
+#endif
#if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API))
/* In UNICOS/mk (_CRAYMPP) the multithreading