# endif /* no flock() or fcntl(F_SETLK,...) */
# ifdef FLOCK
- static int FLOCK(int, int);
+ static int FLOCK _((int, int));
/*
* These are the flock() constants. Since this sytems doesn't have
if (MAXARG > 1)
sv = POPs;
- else if (SvTYPE(TOPs) == SVt_PVGV)
- sv = GvSV(TOPs);
- else
+ if (!isGV(TOPs))
DIE(no_usym, "filehandle");
+ if (MAXARG <= 1)
+ sv = GvSV(TOPs);
gv = (GV*)POPs;
+ if (!isGV(gv))
+ DIE(no_usym, "filehandle");
if (GvIOp(gv))
IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
tmps = SvPV(sv, len);
methname = "TIESCALAR";
stash = gv_stashsv(mark[1], FALSE);
- if (!stash || !(gv = gv_fetchmethod(stash, methname)) || !GvCV(gv))
+ if (!stash || !(gv = gv_fetchmethod(stash, methname)))
DIE("Can't locate object method \"%s\" via package \"%s\"",
methname, SvPV(mark[1],na));
if (perldb && curstash != debstash)
op->op_private |= OPpENTERSUB_DB;
- XPUSHs((SV*)gv);
+ XPUSHs((SV*)GvCV(gv));
PUTBACK;
if (op = pp_entersub())
sv = sv_mortalcopy(&sv_no);
sv_setpv(sv, "AnyDBM_File");
stash = gv_stashsv(sv, FALSE);
- if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
+ if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
PUTBACK;
perl_require_pv("AnyDBM_File.pm");
SPAGAIN;
- if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
+ if (!(gv = gv_fetchmethod(stash, "TIEHASH")))
DIE("No dbm on this machine");
}
else
PUSHs(sv_2mortal(newSViv(O_RDWR)));
PUSHs(right);
- PUSHs((SV*)gv);
+ PUSHs((SV*)GvCV(gv));
PUTBACK;
if (op = pp_entersub())
PUSHs(left);
PUSHs(sv_2mortal(newSViv(O_RDONLY)));
PUSHs(right);
- PUSHs((SV*)gv);
+ PUSHs((SV*)GvCV(gv));
PUTBACK;
if (op = pp_entersub())
}
#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
-#ifdef __linux__
+#if defined(__linux__) || defined(OS2)
growsize = sizeof(fd_set);
#else
growsize = maxlen; /* little endians can use vecs directly */
fgv = gv;
cv = GvFORM(fgv);
-
if (!cv) {
if (fgv) {
SV *tmpsv = sv_newmortal();
}
DIE("Not a format reference");
}
- IoFLAGS(io) &= ~IOf_DIDTOP;
+ if (CvCLONE(cv))
+ cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+ IoFLAGS(io) &= ~IOf_DIDTOP;
return doform(cv,gv,op->op_next);
}
gv_efullname3(tmpsv, fgv, Nullch);
DIE("Undefined top format \"%s\" called",SvPVX(tmpsv));
}
+ if (CvCLONE(cv))
+ cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
return doform(cv,gv,op);
}
goto nuts2;
break;
}
+#ifdef BOGUS_GETNAME_RETURN
+ /* Interactive Unix, getpeername() and getsockname()
+ does not return valid namelen */
+ if (aint == BOGUS_GETNAME_RETURN)
+ aint = sizeof(struct sockaddr);
+#endif
SvCUR_set(sv,aint);
*SvEND(sv) ='\0';
PUSHs(sv);
STDCHAR tbuf[512];
register STDCHAR *s;
register IO *io;
- SV *sv;
+ register SV *sv;
+ GV *gv;
- if (op->op_flags & OPf_REF) {
+ if (op->op_flags & OPf_REF)
+ gv = cGVOP->op_gv;
+ else if (isGV(TOPs))
+ gv = (GV*)POPs;
+ else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
+ gv = (GV*)SvRV(POPs);
+ else
+ gv = Nullgv;
+
+ if (gv) {
EXTEND(SP, 1);
- if (cGVOP->op_gv == defgv) {
+ if (gv == defgv) {
if (statgv)
io = GvIO(statgv);
else {
}
}
else {
- statgv = cGVOP->op_gv;
+ statgv = gv;
+ laststatval = -1;
sv_setpv(statname, "");
io = GvIO(statgv);
}
if (io && IoIFP(io)) {
- if (PerlIO_has_base(IoIFP(io))) {
- Fstat(PerlIO_fileno(IoIFP(io)), &statcache);
+ if (! PerlIO_has_base(IoIFP(io)))
+ DIE("-T and -B not implemented on filehandles");
+ laststatval = Fstat(PerlIO_fileno(IoIFP(io)), &statcache);
+ if (laststatval < 0)
+ RETPUSHUNDEF;
if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */
if (op->op_type == OP_FTTEXT)
RETPUSHNO;
/* sfio can have large buffers - limit to 512 */
if (len > 512)
len = 512;
- }
- else {
- DIE("-T and -B not implemented on filehandles");
- }
}
else {
if (dowarn)
}
else {
sv = POPs;
+ really_filename:
statgv = Nullgv;
+ laststatval = -1;
sv_setpv(statname, SvPV(sv, na));
- really_filename:
#ifdef HAS_OPEN3
i = open(SvPV(sv, na), O_RDONLY, 0);
#else
warn(warn_nl, "open");
RETPUSHUNDEF;
}
- Fstat(i, &statcache);
+ laststatval = Fstat(i, &statcache);
+ if (laststatval < 0)
+ RETPUSHUNDEF;
len = read(i, tbuf, 512);
(void)close(i);
if (len <= 0) {
#ifdef HAS_RENAME
anum = rename(tmps, tmps2);
#else
- if (same_dirent(tmps2, tmps)) /* can always rename to same name */
- anum = 1;
- else {
- if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
- (void)UNLINK(tmps2);
- if (!(anum = link(tmps, tmps2)))
- anum = UNLINK(tmps);
+ if (!(anum = Stat(tmps, &statbuf))) {
+ if (same_dirent(tmps2, tmps)) /* can always rename to same name */
+ anum = 1;
+ else {
+ if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
+ (void)UNLINK(tmps2);
+ if (!(anum = link(tmps, tmps2)))
+ anum = UNLINK(tmps);
+ }
}
#endif
SETi( anum >= 0 );
PP(pp_fork)
{
+#ifdef HAS_FORK
dSP; dTARGET;
int childpid;
GV *tmpgv;
EXTEND(SP, 1);
-#ifdef HAS_FORK
childpid = fork();
if (childpid < 0)
RETSETUNDEF;
PP(pp_wait)
{
+#if !defined(DOSISH) || defined(OS2)
dSP; dTARGET;
int childpid;
int argflags;
- I32 value;
- EXTEND(SP, 1);
-#ifdef HAS_WAIT
- childpid = wait(&argflags);
- if (childpid > 0)
- pidgone(childpid, argflags);
- value = (I32)childpid;
- statusvalue = FIXSTATUS(argflags);
- PUSHi(value);
+ childpid = wait4pid(-1, &argflags, 0);
+ statusvalue = (childpid > 0) ? FIXSTATUS(argflags) : -1;
+ XPUSHi(childpid);
RETURN;
#else
DIE(no_func, "Unsupported function wait");
PP(pp_waitpid)
{
+#if !defined(DOSISH) || defined(OS2)
dSP; dTARGET;
int childpid;
int optype;
int argflags;
- I32 value;
-#ifdef HAS_WAIT
optype = POPi;
childpid = TOPi;
childpid = wait4pid(childpid, &argflags, optype);
- value = (I32)childpid;
- statusvalue = FIXSTATUS(argflags);
- SETi(value);
+ statusvalue = (childpid > 0) ? FIXSTATUS(argflags) : -1;
+ SETi(childpid);
RETURN;
#else
DIE(no_func, "Unsupported function wait");
projects / p5sagit/p5-mst-13.2.git / blobdiff