#include "EXTERN.h"
#define PERL_IN_PP_SYS_C
#include "perl.h"
-#if !defined(PERL_MICRO) && defined(Quad_t)
-# include "time64.h"
-# include "time64.c"
-#endif
+#include "time64.h"
+#include "time64.c"
#ifdef I_SHADOW
/* Shadow password support for solaris - pdo@cs.umd.edu
const Gid_t egid = getegid();
int res;
- LOCK_CRED_MUTEX;
#if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID)
Perl_croak(aTHX_ "switching effective uid is not implemented");
#else
#endif
#endif
Perl_croak(aTHX_ "leaving effective gid failed");
- UNLOCK_CRED_MUTEX;
return res;
}
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
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) {
case OP_FTRREAD:
- opchar = 'R';
#if !(defined(HAS_ACCESS) && defined(R_OK))
use_access = 0;
#endif
break;
case OP_FTRWRITE:
- opchar = 'W';
#if defined(HAS_ACCESS) && defined(W_OK)
access_mode = W_OK;
#else
break;
case OP_FTREXEC:
- opchar = 'X';
#if defined(HAS_ACCESS) && defined(X_OK)
access_mode = X_OK;
#else
break;
case OP_FTEWRITE:
- opchar = 'w';
#ifdef PERL_EFF_ACCESS
access_mode = W_OK;
#endif
stat_mode = S_IWUSR;
-#ifndef PERL_EFF_ACCESS
- use_access = 0;
-#endif
- effective = TRUE;
- break;
+ /* fall through */
case OP_FTEREAD:
- opchar = 'r';
#ifndef PERL_EFF_ACCESS
use_access = 0;
#endif
break;
case OP_FTEEXEC:
- opchar = 'x';
#ifdef PERL_EFF_ACCESS
access_mode = X_OK;
#else
break;
}
- tryAMAGICftest(opchar);
-
if (use_access) {
#if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
const char *name = POPpx;
const int op_type = PL_op->op_type;
char opchar = '?';
dSP;
- STACKED_FTEST_CHECK;
switch (op_type) {
case OP_FTIS: opchar = 'e'; break;
}
tryAMAGICftest(opchar);
+ STACKED_FTEST_CHECK;
+
result = my_stat();
SPAGAIN;
if (result < 0)
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. */
- if (!SvAMAGIC(TOPs)) {
#ifndef S_ISUID
if(PL_op->op_type == OP_FTSUID)
RETPUSHNO;
if(PL_op->op_type == OP_FTSVTX)
RETPUSHNO;
#endif
- }
STACKED_FTEST_CHECK;
- 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);
-
result = my_stat();
SPAGAIN;
if (result < 0)
PP(pp_ftlink)
{
dVAR;
- I32 result;
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;
- STACKED_FTEST_CHECK;
-
tryAMAGICftest('t');
+ STACKED_FTEST_CHECK;
+
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
else if (isGV(TOPs))
GV *gv;
PerlIO *fp;
- STACKED_FTEST_CHECK;
-
tryAMAGICftest(PL_op->op_type == OP_FTTEXT ? 'T' : 'B');
+ STACKED_FTEST_CHECK;
+
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
else if (isGV(TOPs))
PP(pp_wait)
{
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)
dVAR; dSP; dTARGET;
Pid_t childpid;
int argflags;
PP(pp_waitpid)
{
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(__LIBCATAMOUNT__)
dVAR; dSP; dTARGET;
const int optype = POPi;
const Pid_t pid = TOPi;
{
dVAR;
dSP;
-#if defined(PERL_MICRO) || !defined(Quad_t)
- Time_t when;
- const struct tm *err;
- struct tm tmbuf;
-#else
Time64_T when;
struct TM tmbuf;
struct TM *err;
-#endif
const char *opname = PL_op->op_type == OP_LOCALTIME ? "localtime" : "gmtime";
static const char * const dayname[] =
{"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
{"Jan", "Feb", "Mar", "Apr", "May", "Jun",
"Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
-#if defined(PERL_MICRO) || !defined(Quad_t)
- if (MAXARG < 1)
- (void)time(&when);
- else
- when = (Time_t)SvIVx(POPs);
-
- if (PL_op->op_type == OP_LOCALTIME)
- err = localtime(&when);
- else
- err = gmtime(&when);
-
- if (!err)
- tmbuf = *err;
-#else
if (MAXARG < 1) {
time_t now;
(void)time(&now);
when = (Time64_T)now;
}
else {
- /* XXX POPq uses an SvIV so it won't work with 32 bit integer scalars
- using a double causes an unfortunate loss of accuracy on high numbers.
- What we really need is an SvQV.
- */
double input = Perl_floor(POPn);
when = (Time64_T)input;
if (when != input && ckWARN(WARN_OVERFLOW)) {
}
if (PL_op->op_type == OP_LOCALTIME)
- err = localtime64_r(&when, &tmbuf);
+ err = S_localtime64_r(&when, &tmbuf);
else
- err = gmtime64_r(&when, &tmbuf);
-#endif
+ err = S_gmtime64_r(&when, &tmbuf);
if (err == NULL && ckWARN(WARN_OVERFLOW)) {
/* XXX %lld broken for quads */
projects / p5sagit/p5-mst-13.2.git / blobdiff