#include "EXTERN.h"
#define PERL_IN_PP_SYS_C
#include "perl.h"
-#ifndef PERL_MICRO
-# 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;
}
NOOP;
}
else if (gimme == G_SCALAR) {
- ENTER;
+ ENTER_with_name("backtick");
SAVESPTR(PL_rs);
PL_rs = &PL_sv_undef;
sv_setpvs(TARG, ""); /* note that this preserves previous buffer */
while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL)
NOOP;
- LEAVE;
+ LEAVE_with_name("backtick");
XPUSHs(TARG);
SvTAINTED_on(TARG);
}
* without at the same time croaking, for some reason, or if
* perl was built with PERL_EXTERNAL_GLOB */
- ENTER;
+ ENTER_with_name("glob");
#ifndef VMS
if (PL_tainting) {
#endif /* !DOSISH */
result = do_readline();
- LEAVE;
+ LEAVE_with_name("glob");
return result;
}
tmpsv = newSVpvs_flags("Died", SVs_TEMP);
DIE(aTHX_ "%"SVf, SVfARG(tmpsv));
+ RETURN;
}
/* I/O. */
MAGIC *mg;
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
- if (IoDIRP(io) && ckWARN2(WARN_IO, WARN_DEPRECATED))
- Perl_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
- "Opening dirhandle %s also as a file", GvENAME(gv));
+ if (IoDIRP(io))
+ Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
+ "Opening dirhandle %s also as a file",
+ GvENAME(gv));
mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
*MARK-- = SvTIED_obj(MUTABLE_SV(io), mg);
PUSHMARK(MARK);
PUTBACK;
- ENTER;
+ ENTER_with_name("call_OPEN");
call_method("OPEN", G_SCALAR);
- LEAVE;
+ LEAVE_with_name("call_OPEN");
SPAGAIN;
RETURN;
}
PUSHMARK(SP);
XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
PUTBACK;
- ENTER;
+ ENTER_with_name("call_CLOSE");
call_method("CLOSE", G_SCALAR);
- LEAVE;
+ LEAVE_with_name("call_CLOSE");
SPAGAIN;
RETURN;
}
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_func, "pipe");
+ return NORMAL;
#endif
}
PUSHMARK(SP);
XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
PUTBACK;
- ENTER;
+ ENTER_with_name("call_FILENO");
call_method("FILENO", G_SCALAR);
- LEAVE;
+ LEAVE_with_name("call_FILENO");
SPAGAIN;
RETURN;
}
if (discp)
XPUSHs(discp);
PUTBACK;
- ENTER;
+ ENTER_with_name("call_BINMODE");
call_method("BINMODE", G_SCALAR);
- LEAVE;
+ LEAVE_with_name("call_BINMODE");
SPAGAIN;
RETURN;
}
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
}
items = SP - MARK++;
if (sv_isobject(*MARK)) { /* Calls GET magic. */
- ENTER;
+ ENTER_with_name("call_TIE");
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP,(I32)items);
DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no));
}
- ENTER;
+ ENTER_with_name("call_TIE");
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
EXTEND(SP,(I32)items);
"Self-ties of arrays and hashes are not supported");
sv_magic(varsv, (SvRV(sv) == varsv ? NULL : sv), how, NULL, 0);
}
- LEAVE;
+ LEAVE_with_name("call_TIE");
SP = PL_stack_base + markoff;
PUSHs(sv);
RETURN;
XPUSHs(SvTIED_obj(MUTABLE_SV(gv), mg));
mXPUSHi(SvREFCNT(obj) - 1);
PUTBACK;
- ENTER;
+ ENTER_with_name("call_UNTIE");
call_sv(MUTABLE_SV(cv), G_VOID);
- LEAVE;
+ LEAVE_with_name("call_UNTIE");
SPAGAIN;
}
- 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 ) ;
+ else if (mg && SvREFCNT(obj) > 1) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_UNTIE),
+ "untie attempted while %"UVuf" inner references still exist",
+ (UV)SvREFCNT(obj) - 1 ) ;
}
}
}
DIE(aTHX_ "%s", PL_no_modify);
}
if (!SvPOK(sv)) {
- if (ckWARN(WARN_MISC))
- Perl_warner(aTHX_ packWARN(WARN_MISC), "Non-string passed as bitmask");
+ Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Non-string passed as bitmask");
SvPV_force_nolen(sv); /* force string conversion */
}
j = SvCUR(sv);
RETURN;
#else
DIE(aTHX_ "select not implemented");
+ return NORMAL;
#endif
}
{
dVAR;
SvREFCNT_inc_simple_void(gv);
- if (PL_defoutgv)
- SvREFCNT_dec(PL_defoutgv);
+ SvREFCNT_dec(PL_defoutgv);
PL_defoutgv = gv;
}
}
else {
if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) {
- if (ckWARN(WARN_IO))
- Perl_warner(aTHX_ packWARN(WARN_IO), "page overflow");
+ Perl_ck_warner(aTHX_ packWARN(WARN_IO), "page overflow");
}
if (!do_print(PL_formtarget, fp))
PUSHs(&PL_sv_no);
DIE(aTHX_ "Offset outside string");
}
offset += blen_chars;
- } else if (offset >= (IV)blen_chars && blen_chars > 0) {
+ } else if (offset > (IV)blen_chars) {
Safefree(tmpbuf);
DIE(aTHX_ "Offset outside string");
}
RETURN;
}
}
+ else if (!gv) {
+ if (!errno)
+ SETERRNO(EBADF,RMS_IFI);
+ PUSHi(-1);
+ RETURN;
+ }
#if LSEEKSIZE > IVSIZE
PUSHn( do_tell(gv) );
RETURN;
#else
DIE(aTHX_ PL_no_func, "flock()");
+ return NORMAL;
#endif
}
RETPUSHYES;
#else
DIE(aTHX_ PL_no_sock_func, "socket");
+ return NORMAL;
#endif
}
RETPUSHYES;
#else
DIE(aTHX_ PL_no_sock_func, "socketpair");
+ return NORMAL;
#endif
}
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_sock_func, "bind");
+ return NORMAL;
#endif
}
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_sock_func, "connect");
+ return NORMAL;
#endif
}
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_sock_func, "listen");
+ return NORMAL;
#endif
}
#else
DIE(aTHX_ PL_no_sock_func, "accept");
+ return NORMAL;
#endif
}
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_sock_func, "shutdown");
+ return NORMAL;
#endif
}
#else
DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
+ return NORMAL;
#endif
}
#else
DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]);
+ return NORMAL;
#endif
}
if (PL_op->op_type == OP_LSTAT) {
if (gv != PL_defgv) {
do_fstat_warning_check:
- if (ckWARN(WARN_IO))
- Perl_warner(aTHX_ packWARN(WARN_IO),
- "lstat() on filehandle %s", gv ? GvENAME(gv) : "");
+ Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+ "lstat() on filehandle %s", gv ? GvENAME(gv) : "");
} else if (PL_laststype != OP_LSTAT)
Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
}
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)
RETURN;
#else
DIE(aTHX_ PL_no_func, "chroot");
+ return NORMAL;
#endif
}
{
/* Have neither. */
DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+ return NORMAL;
}
#endif
if (!io)
goto nope;
- if ((IoIFP(io) || IoOFP(io)) && ckWARN2(WARN_IO, WARN_DEPRECATED))
- Perl_warner(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
- "Opening filehandle %s also as a directory", GvENAME(gv));
+ if ((IoIFP(io) || IoOFP(io)))
+ Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
+ "Opening filehandle %s also as a directory",
+ GvENAME(gv));
if (IoDIRP(io))
PerlDir_close(IoDIRP(io));
if (!(IoDIRP(io) = PerlDir_open(dirname)))
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_dir_func, "opendir");
+ return NORMAL;
#endif
}
{
#if !defined(Direntry_t) || !defined(HAS_READDIR)
DIE(aTHX_ PL_no_dir_func, "readdir");
+ return NORMAL;
#else
#if !defined(I_DIRENT) && !defined(VMS)
Direntry_t *readdir (DIR *);
register IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io)) {
- if(ckWARN(WARN_IO)) {
- Perl_warner(aTHX_ packWARN(WARN_IO),
- "readdir() attempted on invalid dirhandle %s", GvENAME(gv));
- }
+ Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+ "readdir() attempted on invalid dirhandle %s", GvENAME(gv));
goto nope;
}
register IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io)) {
- if(ckWARN(WARN_IO)) {
- Perl_warner(aTHX_ packWARN(WARN_IO),
- "telldir() attempted on invalid dirhandle %s", GvENAME(gv));
- }
+ Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+ "telldir() attempted on invalid dirhandle %s", GvENAME(gv));
goto nope;
}
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_dir_func, "telldir");
+ return NORMAL;
#endif
}
register IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io)) {
- if(ckWARN(WARN_IO)) {
- Perl_warner(aTHX_ packWARN(WARN_IO),
- "seekdir() attempted on invalid dirhandle %s", GvENAME(gv));
- }
+ Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+ "seekdir() attempted on invalid dirhandle %s", GvENAME(gv));
goto nope;
}
(void)PerlDir_seek(IoDIRP(io), along);
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_dir_func, "seekdir");
+ return NORMAL;
#endif
}
register IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io)) {
- if(ckWARN(WARN_IO)) {
- Perl_warner(aTHX_ packWARN(WARN_IO),
- "rewinddir() attempted on invalid dirhandle %s", GvENAME(gv));
- }
+ Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+ "rewinddir() attempted on invalid dirhandle %s", GvENAME(gv));
goto nope;
}
(void)PerlDir_rewind(IoDIRP(io));
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_dir_func, "rewinddir");
+ return NORMAL;
#endif
}
register IO * const io = GvIOn(gv);
if (!io || !IoDIRP(io)) {
- if(ckWARN(WARN_IO)) {
- Perl_warner(aTHX_ packWARN(WARN_IO),
- "closedir() attempted on invalid dirhandle %s", GvENAME(gv));
- }
+ Perl_ck_warner(aTHX_ packWARN(WARN_IO),
+ "closedir() attempted on invalid dirhandle %s", GvENAME(gv));
goto nope;
}
#ifdef VOID_CLOSEDIR
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_dir_func, "closedir");
+ return NORMAL;
#endif
}
RETURN;
# else
DIE(aTHX_ PL_no_func, "fork");
+ return NORMAL;
# endif
#endif
}
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;
RETURN;
#else
DIE(aTHX_ PL_no_func, "wait");
+ return NORMAL;
#endif
}
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;
RETURN;
#else
DIE(aTHX_ PL_no_func, "waitpid");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_func, "getppid");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_func, "getpgrp()");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_func, "setpgrp()");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_func, "getpriority()");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_func, "setpriority()");
+ return NORMAL;
#endif
}
RETURN;
# else
DIE(aTHX_ "times not implemented");
+ return NORMAL;
# endif
#endif /* HAS_TIMES */
}
{
dVAR;
dSP;
-#ifdef PERL_MICRO
- 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"};
-#ifdef PERL_MICRO
- 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 = POPn;
+ double input = Perl_floor(POPn);
when = (Time64_T)input;
- if( when != input ) {
- Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
- "%s(%.0f) too large", opname, input);
+ if (when != input) {
+ Perl_ck_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);
-#endif
+ err = S_gmtime64_r(&when, &tmbuf);
- if( err == NULL ) {
+ if (err == NULL) {
/* XXX %lld broken for quads */
- Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
- "%s(%.0f) failed", opname, (double)when);
+ Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+ "%s(%.0f) failed", opname, (double)when);
}
if (GIMME != G_ARRAY) { /* scalar context */
RETURN;
#else
DIE(aTHX_ PL_no_func, "alarm");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ "System V IPC is not implemented on this machine");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_sock_func, "gethostent");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_sock_func, "getnetent");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_sock_func, "getprotoent");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_sock_func, "getservent");
+ return NORMAL;
#endif
}
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "sethostent");
+ return NORMAL;
#endif
}
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "setnetent");
+ return NORMAL;
#endif
}
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "setprotoent");
+ return NORMAL;
#endif
}
RETSETYES;
#else
DIE(aTHX_ PL_no_sock_func, "setservent");
+ return NORMAL;
#endif
}
RETPUSHYES;
#else
DIE(aTHX_ PL_no_sock_func, "endhostent");
+ return NORMAL;
#endif
}
RETPUSHYES;
#else
DIE(aTHX_ PL_no_sock_func, "endnetent");
+ return NORMAL;
#endif
}
RETPUSHYES;
#else
DIE(aTHX_ PL_no_sock_func, "endprotoent");
+ return NORMAL;
#endif
}
RETPUSHYES;
#else
DIE(aTHX_ PL_no_sock_func, "endservent");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+ return NORMAL;
#endif
}
RETPUSHYES;
#else
DIE(aTHX_ PL_no_func, "setpwent");
+ return NORMAL;
#endif
}
RETPUSHYES;
#else
DIE(aTHX_ PL_no_func, "endpwent");
+ return NORMAL;
#endif
}
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
RETURN;
#else
DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]);
+ return NORMAL;
#endif
}
RETPUSHYES;
#else
DIE(aTHX_ PL_no_func, "setgrent");
+ return NORMAL;
#endif
}
RETPUSHYES;
#else
DIE(aTHX_ PL_no_func, "endgrent");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_func, "getlogin");
+ return NORMAL;
#endif
}
RETURN;
#else
DIE(aTHX_ PL_no_func, "syscall");
+ return NORMAL;
#endif
}
static int
fcntl_emulate_flock(int fd, int operation)
{
+ int res;
struct flock flock;
switch (operation & ~LOCK_NB) {
flock.l_whence = SEEK_SET;
flock.l_start = flock.l_len = (Off_t)0;
- return fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock);
+ res = fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock);
+ if (res == -1 && ((errno == EAGAIN) || (errno == EACCES)))
+ errno = EWOULDBLOCK;
+ return res;
}
#endif /* FCNTL_EMULATE_FLOCK */