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
int stat_mode = S_IRUSR;
bool effective = FALSE;
- char opchar;
+ 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;
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 (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 && ckWARN(WARN_OVERFLOW)) {