perl 3.0 patch #31
Larry Wall
lwall at jpl-devvax.JPL.NASA.GOV
Thu Oct 18 02:55:19 AEST 1990
System: perl version 3.0
Patch #: 31
Priority: HIGH
Subject: patch #29, continued
Description:
See patch #29.
Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source
directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle".
If you don't have the patch program, apply the following by hand,
or get patch (version 2.0, latest patchlevel).
After patching:
*** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #36 FIRST ***
If patch indicates that patchlevel is the wrong version, you may need
to apply one or more previous patches, or the patch may already
have been applied. See the patchlevel.h file to find out what has or
has not been applied. In any event, don't continue with the patch.
If you are missing previous patches they can be obtained from me:
Larry Wall
lwall at jpl-devvax.jpl.nasa.gov
If you send a mail message of the following form it will greatly speed
processing:
Subject: Command
@SH mailpatch PATH perl 3.0 LIST
^ note the c
where PATH is a return path FROM ME TO YOU either in Internet notation,
or in bang notation from some well-known host, and LIST is the number
of one or more patches you need, separated by spaces, commas, and/or
hyphens. Saying 35- says everything from 35 to the end.
You can also get the patches via anonymous FTP from
jpl-devvax.jpl.nasa.gov (128.149.1.143).
Index: patchlevel.h
Prereq: 30
1c1
< #define PATCHLEVEL 30
---
> #define PATCHLEVEL 31
Index: doio.c
Prereq: 3.0.1.10
*** doio.c.old Tue Oct 16 11:49:17 1990
--- doio.c Tue Oct 16 11:49:28 1990
***************
*** 1,4 ****
! /* $Header: doio.c,v 3.0.1.10 90/08/13 22:14:29 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: doio.c,v 3.0.1.11 90/10/15 16:16:11 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,19 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: doio.c,v $
+ * Revision 3.0.1.11 90/10/15 16:16:11 lwall
+ * patch29: added SysV IPC
+ * patch29: file - didn't auto-close cleanly
+ * patch29: close; core dumped
+ * patch29: more MSDOS and OS/2 updates, from Kai Uwe Rommel
+ * patch29: various portability fixes
+ * patch29: *foo now prints as *package'foo
+ *
* Revision 3.0.1.10 90/08/13 22:14:29 lwall
* patch28: close-on-exec problems on dup'ed file descriptors
* patch28: F_FREESP wasn't implemented the way I thought
***************
*** 75,80 ****
--- 83,95 ----
#include <sys/select.h>
#endif
+ #ifdef SYSVIPC
+ #include <sys/ipc.h>
+ #include <sys/msg.h>
+ #include <sys/sem.h>
+ #include <sys/shm.h>
+ #endif
+
#ifdef I_PWD
#include <pwd.h>
#endif
***************
*** 112,126 ****
fd = fileno(stio->ifp);
if (stio->type == '|')
result = mypclose(stio->ifp);
else if (stio->ifp != stio->ofp) {
! if (stio->ofp)
! fclose(stio->ofp);
! result = fclose(stio->ifp);
}
- else if (stio->type != '-')
- result = fclose(stio->ifp);
else
! result = 0;
if (result == EOF && fd > 2)
fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
stab_name(stab));
--- 127,144 ----
fd = fileno(stio->ifp);
if (stio->type == '|')
result = mypclose(stio->ifp);
+ else if (stio->type == '-')
+ result = 0;
else if (stio->ifp != stio->ofp) {
! if (stio->ofp) {
! result = fclose(stio->ofp);
! fclose(stio->ifp); /* clear stdio, fd already closed */
! }
! else
! result = fclose(stio->ifp);
}
else
! result = fclose(stio->ifp);
if (result == EOF && fd > 2)
fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
stab_name(stab));
***************
*** 391,399 ****
bool explicit;
{
bool retval = FALSE;
! register STIO *stio = stab_io(stab);
int status;
if (!stio) { /* never opened */
if (dowarn && explicit)
warn("Close on unopened file <%s>",stab_name(stab));
--- 409,422 ----
bool explicit;
{
bool retval = FALSE;
! register STIO *stio;
int status;
+ if (!stab)
+ stab = argvstab;
+ if (!stab)
+ return FALSE;
+ stio = stab_io(stab);
if (!stio) { /* never opened */
if (dowarn && explicit)
warn("Close on unopened file <%s>",stab_name(stab));
***************
*** 408,416 ****
else if (stio->type == '-')
retval = TRUE;
else {
! if (stio->ofp && stio->ofp != stio->ifp) /* a socket */
! fclose(stio->ofp);
! retval = (fclose(stio->ifp) != EOF);
}
stio->ofp = stio->ifp = Nullfp;
}
--- 431,442 ----
else if (stio->type == '-')
retval = TRUE;
else {
! if (stio->ofp && stio->ofp != stio->ifp) { /* a socket */
! retval = (fclose(stio->ofp) != EOF);
! fclose(stio->ifp); /* clear stdio, fd already closed */
! }
! else
! retval = (fclose(stio->ifp) != EOF);
}
stio->ofp = stio->ifp = Nullfp;
}
***************
*** 552,558 ****
--- 578,588 ----
}
else {
retval = (int)str_gnum(argstr);
+ #ifdef MSDOS
+ s = (char*)(long)retval; /* ouch */
+ #else
s = (char*)retval; /* ouch */
+ #endif
}
#ifndef lint
***************
*** 593,599 ****
if (tmpstab != defstab) {
statstab = tmpstab;
str_set(statname,"");
! if (!stab_io(tmpstab) ||
fstat(fileno(stab_io(tmpstab)->ifp),&statcache) < 0) {
max = 0;
}
--- 623,629 ----
if (tmpstab != defstab) {
statstab = tmpstab;
str_set(statname,"");
! if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
fstat(fileno(stab_io(tmpstab)->ifp),&statcache) < 0) {
max = 0;
}
***************
*** 665,671 ****
}
#if !defined(TRUNCATE) && !defined(CHSIZE) && defined(F_FREESP)
! /* code courtesy of Pim Zandbergen */
#define CHSIZE
int chsize(fd, length)
--- 695,701 ----
}
#if !defined(TRUNCATE) && !defined(CHSIZE) && defined(F_FREESP)
! /* code courtesy of William Kucharski */
#define CHSIZE
int chsize(fd, length)
***************
*** 836,845 ****
}
else {
tmps = str_get(str);
! if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'a' && tmps[3] == 'b'
&& str->str_cur == sizeof(STBP) && strlen(tmps) < str->str_cur) {
! tmps = stab_name(((STAB*)str)); /* a stab value, be nice */
! str = ((STAB*)str)->str_magic;
putc('*',fp);
}
if (str->str_cur && (fwrite(tmps,1,str->str_cur,fp) == 0 || ferror(fp)))
--- 866,877 ----
}
else {
tmps = str_get(str);
! if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'B' && tmps[3] == '\0'
&& str->str_cur == sizeof(STBP) && strlen(tmps) < str->str_cur) {
! STR *tmpstr = str_static(&str_undef);
! stab_fullname(tmpstr,((STAB*)str));/* a stab value, be nice */
! str = tmpstr;
! tmps = str->str_ptr;
putc('*',fp);
}
if (str->str_cur && (fwrite(tmps,1,str->str_cur,fp) == 0 || ferror(fp)))
***************
*** 1920,1927 ****
--- 1952,1961 ----
#ifdef PWCLASS
str_set(str,pwent->pw_class);
#else
+ #ifdef PWCOMMENT
str_set(str, pwent->pw_comment);
#endif
+ #endif
(void)astore(ary, ++sp, str = str_static(&str_no));
str_set(str, pwent->pw_gecos);
(void)astore(ary, ++sp, str = str_static(&str_no));
***************
*** 2288,2290 ****
--- 2322,2563 ----
#endif
return FALSE;
}
+
+ #ifdef SYSVIPC
+
+ int
+ do_ipcget(optype, arglast)
+ int optype;
+ int *arglast;
+ {
+ register STR **st = stack->ary_array;
+ register int sp = arglast[0];
+ key_t key;
+ int n, flags;
+
+ key = (key_t)str_gnum(st[++sp]);
+ n = (optype == O_MSGGET) ? 0 : (int)str_gnum(st[++sp]);
+ flags = (int)str_gnum(st[++sp]);
+ errno = 0;
+ switch (optype)
+ {
+ case O_MSGGET:
+ return msgget(key, flags);
+ case O_SEMGET:
+ return semget(key, n, flags);
+ case O_SHMGET:
+ return shmget(key, n, flags);
+ }
+ return -1; /* should never happen */
+ }
+
+ int
+ do_ipcctl(optype, arglast)
+ int optype;
+ int *arglast;
+ {
+ register STR **st = stack->ary_array;
+ register int sp = arglast[0];
+ STR *astr;
+ char *a;
+ int id, n, cmd, infosize, getinfo, ret;
+
+ id = (int)str_gnum(st[++sp]);
+ n = (optype == O_SEMCTL) ? (int)str_gnum(st[++sp]) : 0;
+ cmd = (int)str_gnum(st[++sp]);
+ astr = st[++sp];
+
+ infosize = 0;
+ getinfo = (cmd == IPC_STAT);
+
+ switch (optype)
+ {
+ case O_MSGCTL:
+ if (cmd == IPC_STAT || cmd == IPC_SET)
+ infosize = sizeof(struct msqid_ds);
+ break;
+ case O_SHMCTL:
+ if (cmd == IPC_STAT || cmd == IPC_SET)
+ infosize = sizeof(struct shmid_ds);
+ break;
+ case O_SEMCTL:
+ if (cmd == IPC_STAT || cmd == IPC_SET)
+ infosize = sizeof(struct semid_ds);
+ else if (cmd == GETALL || cmd == SETALL)
+ {
+ struct semid_ds semds;
+ if (semctl(id, 0, IPC_STAT, &semds) == -1)
+ return -1;
+ getinfo = (cmd == GETALL);
+ infosize = semds.sem_nsems * sizeof(ushort);
+ }
+ break;
+ }
+
+ if (infosize)
+ {
+ if (getinfo)
+ {
+ STR_GROW(astr, infosize+1);
+ a = str_get(astr);
+ }
+ else
+ {
+ a = str_get(astr);
+ if (astr->str_cur != infosize)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ }
+ }
+ else
+ {
+ int i = (int)str_gnum(astr);
+ a = (char *)i; /* ouch */
+ }
+ errno = 0;
+ switch (optype)
+ {
+ case O_MSGCTL:
+ ret = msgctl(id, cmd, a);
+ break;
+ case O_SEMCTL:
+ ret = semctl(id, n, cmd, a);
+ break;
+ case O_SHMCTL:
+ ret = shmctl(id, cmd, a);
+ break;
+ }
+ if (getinfo && ret >= 0) {
+ astr->str_cur = infosize;
+ astr->str_ptr[infosize] = '\0';
+ }
+ return ret;
+ }
+
+ int
+ do_msgsnd(arglast)
+ int *arglast;
+ {
+ register STR **st = stack->ary_array;
+ register int sp = arglast[0];
+ STR *mstr;
+ char *mbuf;
+ int id, msize, flags;
+
+ id = (int)str_gnum(st[++sp]);
+ mstr = st[++sp];
+ flags = (int)str_gnum(st[++sp]);
+ mbuf = str_get(mstr);
+ if ((msize = mstr->str_cur - sizeof(long)) < 0) {
+ errno = EINVAL;
+ return -1;
+ }
+ errno = 0;
+ return msgsnd(id, mbuf, msize, flags);
+ }
+
+ int
+ do_msgrcv(arglast)
+ int *arglast;
+ {
+ register STR **st = stack->ary_array;
+ register int sp = arglast[0];
+ STR *mstr;
+ char *mbuf;
+ long mtype;
+ int id, msize, flags, ret;
+
+ id = (int)str_gnum(st[++sp]);
+ mstr = st[++sp];
+ msize = (int)str_gnum(st[++sp]);
+ mtype = (long)str_gnum(st[++sp]);
+ flags = (int)str_gnum(st[++sp]);
+ mbuf = str_get(mstr);
+ if (mstr->str_cur < sizeof(long)+msize+1) {
+ STR_GROW(mstr, sizeof(long)+msize+1);
+ mbuf = str_get(mstr);
+ }
+ errno = 0;
+ ret = msgrcv(id, mbuf, msize, mtype, flags);
+ if (ret >= 0) {
+ mstr->str_cur = sizeof(long)+ret;
+ mstr->str_ptr[sizeof(long)+ret] = '\0';
+ }
+ return ret;
+ }
+
+ int
+ do_semop(arglast)
+ int *arglast;
+ {
+ register STR **st = stack->ary_array;
+ register int sp = arglast[0];
+ STR *opstr;
+ char *opbuf;
+ int id, opsize;
+
+ id = (int)str_gnum(st[++sp]);
+ opstr = st[++sp];
+ opbuf = str_get(opstr);
+ opsize = opstr->str_cur;
+ if (opsize < sizeof(struct sembuf)
+ || (opsize % sizeof(struct sembuf)) != 0) {
+ errno = EINVAL;
+ return -1;
+ }
+ errno = 0;
+ return semop(id, opbuf, opsize/sizeof(struct sembuf));
+ }
+
+ int
+ do_shmio(optype, arglast)
+ int optype;
+ int *arglast;
+ {
+ register STR **st = stack->ary_array;
+ register int sp = arglast[0];
+ STR *mstr;
+ char *mbuf, *shm;
+ int id, mpos, msize;
+ struct shmid_ds shmds;
+ extern char *shmat();
+
+ id = (int)str_gnum(st[++sp]);
+ mstr = st[++sp];
+ mpos = (int)str_gnum(st[++sp]);
+ msize = (int)str_gnum(st[++sp]);
+ errno = 0;
+ if (shmctl(id, IPC_STAT, &shmds) == -1)
+ return -1;
+ if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
+ errno = EFAULT; /* can't do as caller requested */
+ return -1;
+ }
+ shm = shmat(id, (char *)NULL, (optype == O_SHMREAD) ? SHM_RDONLY : 0);
+ if (shm == (char *)-1) /* I hate System V IPC, I really do */
+ return -1;
+ mbuf = str_get(mstr);
+ if (optype == O_SHMREAD) {
+ if (mstr->str_cur < msize) {
+ STR_GROW(mstr, msize+1);
+ mbuf = str_get(mstr);
+ }
+ bcopy(shm + mpos, mbuf, msize);
+ mstr->str_cur = msize;
+ mstr->str_ptr[msize] = '\0';
+ }
+ else {
+ int n;
+
+ if ((n = mstr->str_cur) > msize)
+ n = msize;
+ bcopy(mbuf, shm + mpos, n);
+ if (n < msize)
+ bzero(shm + mpos + n, msize - n);
+ }
+ return shmdt(shm);
+ }
+
+ #endif /* SYSVIPC */
Index: dolist.c
Prereq: 3.0.1.9
*** dolist.c.old Tue Oct 16 11:49:58 1990
--- dolist.c Tue Oct 16 11:50:08 1990
***************
*** 1,4 ****
! /* $Header: dolist.c,v 3.0.1.9 90/08/13 22:15:35 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: dolist.c,v 3.0.1.10 90/10/15 16:19:48 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,16 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: dolist.c,v $
+ * Revision 3.0.1.10 90/10/15 16:19:48 lwall
+ * patch29: added caller
+ * patch29: added scalar reverse
+ * patch29: sort undefined_subroutine @array is now a fatal error
+ *
* Revision 3.0.1.9 90/08/13 22:15:35 lwall
* patch28: defined(@array) and defined(%array) didn't work right
*
***************
*** 1301,1312 ****
register STR **down = &st[arglast[2]];
register int i = arglast[2] - arglast[1];
- if (gimme != G_ARRAY) {
- str_sset(str,&str_undef);
- STABSET(str);
- st[arglast[0]+1] = str;
- return arglast[0]+1;
- }
while (i-- > 0) {
*up++ = *down;
if (i-- > 0)
--- 1306,1311 ----
***************
*** 1317,1322 ****
--- 1316,1347 ----
return arglast[2] - 1;
}
+ int
+ do_sreverse(str,gimme,arglast)
+ STR *str;
+ int gimme;
+ int *arglast;
+ {
+ STR **st = stack->ary_array;
+ register char *up;
+ register char *down;
+ register int tmp;
+
+ str_sset(str,st[arglast[2]]);
+ up = str_get(str);
+ if (str->str_cur > 1) {
+ down = str->str_ptr + str->str_cur - 1;
+ while (down > up) {
+ tmp = *up;
+ *up++ = *down;
+ *down-- = tmp;
+ }
+ }
+ STABSET(str);
+ st[arglast[0]+1] = str;
+ return arglast[0]+1;
+ }
+
static CMD *sortcmd;
static STAB *firststab = Nullstab;
static STAB *secondstab = Nullstab;
***************
*** 1359,1367 ****
max = up - &st[sp];
sp--;
if (max > 1) {
! if (stab_sub(stab) && (sortcmd = stab_sub(stab)->cmd)) {
int oldtmps_base = tmps_base;
if (!sortstack) {
sortstack = anew(Nullstab);
sortstack->ary_flags = 0;
--- 1384,1394 ----
max = up - &st[sp];
sp--;
if (max > 1) {
! if (stab) {
int oldtmps_base = tmps_base;
+ if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
+ fatal("Undefined subroutine \"%s\" in sort", stab_name(stab));
if (!sortstack) {
sortstack = anew(Nullstab);
sortstack->ary_flags = 0;
***************
*** 1468,1478 ****
--- 1495,1573 ----
}
int
+ do_caller(arg,maxarg,gimme,arglast)
+ ARG *arg;
+ int maxarg;
+ int gimme;
+ int *arglast;
+ {
+ STR **st = stack->ary_array;
+ register int sp = arglast[0];
+ register CSV *csv = curcsv;
+ STR *str;
+ int count = 0;
+
+ if (!csv)
+ fatal("There is no caller");
+ if (maxarg)
+ count = (int) str_gnum(st[sp+1]);
+ for (;;) {
+ if (!csv)
+ return sp;
+ if (csv->curcsv && csv->curcsv->sub == stab_sub(DBsub))
+ count++;
+ if (!count--)
+ break;
+ csv = csv->curcsv;
+ }
+ if (gimme != G_ARRAY) {
+ STR *str = arg->arg_ptr.arg_str;
+ str_set(str,csv->curcmd->c_stash->tbl_name);
+ STABSET(str);
+ st[++sp] = str;
+ return sp;
+ }
+
+ #ifndef lint
+ (void)astore(stack,++sp,
+ str_2static(str_make(csv->curcmd->c_stash->tbl_name,0)) );
+ (void)astore(stack,++sp,
+ str_2static(str_make(stab_val(csv->curcmd->c_filestab)->str_ptr,0)) );
+ (void)astore(stack,++sp,
+ str_2static(str_nmake((double)csv->curcmd->c_line)) );
+ if (!maxarg)
+ return sp;
+ str = str_static(&str_undef);
+ stab_fullname(str, csv->stab);
+ (void)astore(stack,++sp, str);
+ (void)astore(stack,++sp,
+ str_2static(str_nmake((double)csv->hasargs)) );
+ (void)astore(stack,++sp,
+ str_2static(str_nmake((double)csv->wantarray)) );
+ if (csv->hasargs) {
+ ARRAY *ary = csv->argarray;
+
+ if (dbargs->ary_max < ary->ary_fill)
+ astore(dbargs,ary->ary_fill,Nullstr);
+ Copy(ary->ary_array, dbargs->ary_array, ary->ary_fill+1, STR*);
+ dbargs->ary_fill = ary->ary_fill;
+ }
+ #else
+ (void)astore(stack,++sp,
+ str_2static(str_make("",0)));
+ #endif
+ return sp;
+ }
+
+ int
do_tms(str,gimme,arglast)
STR *str;
int gimme;
int *arglast;
{
+ #ifdef MSDOS
+ return -1;
+ #else
STR **st = stack->ary_array;
register int sp = arglast[0];
***************
*** 1502,1507 ****
--- 1597,1603 ----
str_2static(str_nmake(0.0)));
#endif
return sp;
+ #endif
}
int
Index: dump.c
Prereq: 3.0.1.1
*** dump.c.old Tue Oct 16 11:50:19 1990
--- dump.c Tue Oct 16 11:50:21 1990
***************
*** 1,4 ****
! /* $Header: dump.c,v 3.0.1.1 90/03/27 15:49:58 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: dump.c,v 3.0.1.2 90/10/15 16:22:10 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: dump.c,v $
+ * Revision 3.0.1.2 90/10/15 16:22:10 lwall
+ * patch29: *foo now prints as *package'foo
+ *
* Revision 3.0.1.1 90/03/27 15:49:58 lwall
* patch16: changed unsigned to unsigned int
*
***************
*** 25,30 ****
--- 28,34 ----
register int i;
register STAB *stab;
register HENT *entry;
+ STR *str = str_static(&str_undef);
dump_cmd(main_root,Nullcmd);
for (i = 0; i <= 127; i++) {
***************
*** 31,37 ****
for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
stab = (STAB*)entry->hent_val;
if (stab_sub(stab)) {
! dump("\nSUB %s = ", stab_name(stab));
dump_cmd(stab_sub(stab)->cmd,Nullcmd);
}
}
--- 35,42 ----
for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
stab = (STAB*)entry->hent_val;
if (stab_sub(stab)) {
! stab_fullname(str,stab);
! dump("\nSUB %s = ", str->str_ptr);
dump_cmd(stab_sub(stab)->cmd,Nullcmd);
}
}
***************
*** 246,258 ****
dump_stab(stab)
register STAB *stab;
{
if (!stab) {
fprintf(stderr,"{}\n");
return;
}
dumplvl++;
fprintf(stderr,"{\n");
! dump("STAB_NAME = %s\n",stab_name(stab));
dumplvl--;
dump("}\n");
}
--- 251,267 ----
dump_stab(stab)
register STAB *stab;
{
+ STR *str;
+
if (!stab) {
fprintf(stderr,"{}\n");
return;
}
+ str = str_static(&str_undef);
dumplvl++;
fprintf(stderr,"{\n");
! stab_fullname(str,stab);
! dump("STAB_NAME = %s\n", str->str_ptr);
dumplvl--;
dump("}\n");
}
Index: eval.c
Prereq: 3.0.1.8
*** eval.c.old Tue Oct 16 11:51:56 1990
--- eval.c Tue Oct 16 11:52:06 1990
***************
*** 1,4 ****
! /* $Header: eval.c,v 3.0.1.8 90/08/13 22:17:14 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: eval.c,v 3.0.1.9 90/10/15 16:46:13 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,25 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: eval.c,v $
+ * Revision 3.0.1.9 90/10/15 16:46:13 lwall
+ * patch29: added caller
+ * patch29: added scalar
+ * patch29: added cmp and <=>
+ * patch29: added sysread and syswrite
+ * patch29: added -M, -A and -C
+ * patch29: index and substr now have optional 3rd args
+ * patch29: you can now read into the middle string
+ * patch29: ~ now works on vector string
+ * patch29: non-existent array values no longer cause core dumps
+ * patch29: eof; core dumped
+ * patch29: oct and hex now produce unsigned result
+ * patch29: unshift did not return the documented value
+ *
* Revision 3.0.1.8 90/08/13 22:17:14 lwall
* patch28: the NSIG hack didn't work right on Xenix
* patch28: defined(@array) and defined(%array) didn't work right
***************
*** 90,96 ****
static STIO *stio;
static struct lstring *lstr;
static int old_record_separator;
- extern int wantarray;
double sin(), cos(), atan2(), pow();
--- 104,109 ----
***************
*** 158,163 ****
--- 171,178 ----
case O_ITEM:
if (gimme == G_ARRAY)
goto array_return;
+ /* FALL THROUGH */
+ case O_SCALAR:
STR_SSET(str,st[1]);
STABSET(str);
break;
***************
*** 353,358 ****
--- 368,381 ----
value = str_gnum(st[1]);
value = (value != str_gnum(st[2])) ? 1.0 : 0.0;
goto donumset;
+ case O_NCMP:
+ value = str_gnum(st[1]);
+ value -= str_gnum(st[2]);
+ if (value > 0.0)
+ value = 1.0;
+ else if (value < 0.0)
+ value = -1.0;
+ goto donumset;
case O_BIT_AND:
if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
value = str_gnum(st[1]);
***************
*** 466,477 ****
else {
STR_SSET(str,st[1]);
tmps = str_get(str);
! for (anum = str->str_cur; anum; anum--)
*tmps = ~*tmps;
}
break;
case O_SELECT:
! tmps = stab_name(defoutstab);
if (maxarg > 0) {
if ((arg[1].arg_type & A_MASK) == A_WORD)
defoutstab = arg[1].arg_ptr.arg_stab;
--- 489,500 ----
else {
STR_SSET(str,st[1]);
tmps = str_get(str);
! for (anum = str->str_cur; anum; anum--, tmps++)
*tmps = ~*tmps;
}
break;
case O_SELECT:
! stab_fullname(str,defoutstab);
if (maxarg > 0) {
if ((arg[1].arg_type & A_MASK) == A_WORD)
defoutstab = arg[1].arg_ptr.arg_stab;
***************
*** 481,487 ****
stab_io(defoutstab) = stio_new();
curoutstab = defoutstab;
}
- str_set(str, tmps);
STABSET(str);
break;
case O_WRITE:
--- 504,509 ----
***************
*** 617,624 ****
case O_AELEM:
anum = ((int)str_gnum(st[2])) - arybase;
str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
- if (!str)
- goto say_undef;
break;
case O_DELETE:
tmpstab = arg[1].arg_ptr.arg_stab;
--- 639,644 ----
***************
*** 653,665 ****
tmpstab = arg[1].arg_ptr.arg_stab;
tmps = str_get(st[2]);
str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
- if (!str)
- goto say_undef;
break;
case O_LAELEM:
anum = ((int)str_gnum(st[2])) - arybase;
str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
! if (!str)
fatal("Assignment to non-creatable value, subscript %d",anum);
break;
case O_LHELEM:
--- 673,683 ----
tmpstab = arg[1].arg_ptr.arg_stab;
tmps = str_get(st[2]);
str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE);
break;
case O_LAELEM:
anum = ((int)str_gnum(st[2])) - arybase;
str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE);
! if (!str || str == &str_undef)
fatal("Assignment to non-creatable value, subscript %d",anum);
break;
case O_LHELEM:
***************
*** 667,673 ****
tmps = str_get(st[2]);
anum = st[2]->str_cur;
str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
! if (!str)
fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
if (tmpstab == envstab) /* heavy wizardry going on here */
str_magic(str, tmpstab, 'E', tmps, anum); /* str is now magic */
--- 685,691 ----
tmps = str_get(st[2]);
anum = st[2]->str_cur;
str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE);
! if (!str || str == &str_undef)
fatal("Assignment to non-creatable value, subscript \"%s\"",tmps);
if (tmpstab == envstab) /* heavy wizardry going on here */
str_magic(str, tmpstab, 'E', tmps, anum); /* str is now magic */
***************
*** 678,683 ****
--- 696,703 ----
else if (stab_hash(tmpstab)->tbl_dbm)
str_magic(str, tmpstab, 'D', tmps, anum);
#endif
+ else if (perldb && tmpstab == DBline)
+ str_magic(str, tmpstab, 'L', tmps, anum);
break;
case O_LSLICE:
anum = 2;
***************
*** 752,758 ****
if (anum < 0 || anum > st[1]->str_cur)
str_nset(str,"",0);
else {
! optype = (int)str_gnum(st[3]);
if (optype < 0)
optype = 0;
tmps += anum;
--- 772,778 ----
if (anum < 0 || anum > st[1]->str_cur)
str_nset(str,"",0);
else {
! optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]);
if (optype < 0)
optype = 0;
tmps += anum;
***************
*** 802,828 ****
tmps = str_get(st[1]);
value = (double) !str_eq(st[1],st[2]);
goto donumset;
case O_SUBR:
sp = do_subr(arg,gimme,arglast);
st = stack->ary_array + arglast[0]; /* maybe realloced */
goto array_return;
case O_DBSUBR:
! sp = do_dbsubr(arg,gimme,arglast);
st = stack->ary_array + arglast[0]; /* maybe realloced */
goto array_return;
case O_SORT:
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
stab = stabent(str_get(st[1]),TRUE);
- if (!stab)
- stab = defoutstab;
sp = do_sort(str,stab,
gimme,arglast);
goto array_return;
case O_REVERSE:
! sp = do_reverse(str,
! gimme,arglast);
goto array_return;
case O_WARN:
if (arglast[2] - arglast[1] != 1) {
--- 822,858 ----
tmps = str_get(st[1]);
value = (double) !str_eq(st[1],st[2]);
goto donumset;
+ case O_SCMP:
+ tmps = str_get(st[1]);
+ value = (double) str_cmp(st[1],st[2]);
+ goto donumset;
case O_SUBR:
sp = do_subr(arg,gimme,arglast);
st = stack->ary_array + arglast[0]; /* maybe realloced */
goto array_return;
case O_DBSUBR:
! sp = do_subr(arg,gimme,arglast);
st = stack->ary_array + arglast[0]; /* maybe realloced */
goto array_return;
+ case O_CALLER:
+ sp = do_caller(arg,maxarg,gimme,arglast);
+ st = stack->ary_array + arglast[0]; /* maybe realloced */
+ goto array_return;
case O_SORT:
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
stab = stabent(str_get(st[1]),TRUE);
sp = do_sort(str,stab,
gimme,arglast);
goto array_return;
case O_REVERSE:
! if (gimme == G_ARRAY)
! sp = do_reverse(str,
! gimme,arglast);
! else
! sp = do_sreverse(str,
! gimme,arglast);
goto array_return;
case O_WARN:
if (arglast[2] - arglast[1] != 1) {
***************
*** 893,905 ****
tmps = str_get(st[1]);
if (!tmps || !*tmps) {
tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
! if (tmpstr)
! tmps = str_get(tmpstr);
}
if (!tmps || !*tmps) {
tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
! if (tmpstr)
! tmps = str_get(tmpstr);
}
#ifdef TAINT
taintproper("Insecure dependency in chdir");
--- 923,933 ----
tmps = str_get(st[1]);
if (!tmps || !*tmps) {
tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE);
! tmps = str_get(tmpstr);
}
if (!tmps || !*tmps) {
tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE);
! tmps = str_get(tmpstr);
}
#ifdef TAINT
taintproper("Insecure dependency in chdir");
***************
*** 918,924 ****
tmps = "";
else
tmps = str_get(st[1]);
! str_reset(tmps,arg[2].arg_ptr.arg_hash);
value = 1.0;
goto donumset;
case O_LIST:
--- 946,952 ----
tmps = "";
else
tmps = str_get(st[1]);
! str_reset(tmps,curcmd->c_stash);
value = 1.0;
goto donumset;
case O_LIST:
***************
*** 946,953 ****
stab = arg[1].arg_ptr.arg_stab;
else
stab = stabent(str_get(st[1]),TRUE);
! if (do_eof(stab)) /* make sure we have fp with something */
! str_set(str, No);
else {
#ifdef TAINT
tainted = 1;
--- 974,983 ----
stab = arg[1].arg_ptr.arg_stab;
else
stab = stabent(str_get(st[1]),TRUE);
! if (!stab)
! stab = argvstab;
! if (!stab || do_eof(stab)) /* make sure we have fp with something */
! goto say_undef;
else {
#ifdef TAINT
tainted = 1;
***************
*** 972,977 ****
--- 1002,1008 ----
goto donumset;
case O_RECV:
case O_READ:
+ case O_SYSREAD:
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
***************
*** 978,992 ****
stab = stabent(str_get(st[1]),TRUE);
tmps = str_get(st[2]);
anum = (int)str_gnum(st[3]);
- STR_GROW(st[2], anum+1), (tmps = str_get(st[2])); /* sneaky */
errno = 0;
if (!stab_io(stab) || !stab_io(stab)->ifp)
! goto say_zero;
#ifdef SOCKET
! else if (optype == O_RECV) {
argtype = sizeof buf;
! optype = (int)str_gnum(st[4]);
! anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, optype,
buf, &argtype);
if (anum >= 0) {
st[2]->str_cur = anum;
--- 1009,1028 ----
stab = stabent(str_get(st[1]),TRUE);
tmps = str_get(st[2]);
anum = (int)str_gnum(st[3]);
errno = 0;
+ maxarg = sp - arglast[0];
+ if (maxarg > 4)
+ warn("Too many args on read");
+ if (maxarg == 4)
+ maxarg = (int)str_gnum(st[4]);
+ else
+ maxarg = 0;
if (!stab_io(stab) || !stab_io(stab)->ifp)
! goto say_undef;
#ifdef SOCKET
! if (optype == O_RECV) {
argtype = sizeof buf;
! anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg,
buf, &argtype);
if (anum >= 0) {
st[2]->str_cur = anum;
***************
*** 997,1021 ****
str_sset(str,&str_undef);
break;
}
! else if (stab_io(stab)->type == 's') {
argtype = sizeof buf;
! anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, 0,
buf, &argtype);
}
! #else
! else if (optype == O_RECV)
! goto badsock;
#endif
else
! anum = fread(tmps, 1, anum, stab_io(stab)->ifp);
if (anum < 0)
goto say_undef;
! st[2]->str_cur = anum;
! st[2]->str_ptr[anum] = '\0';
value = (double)anum;
goto donumset;
case O_SEND:
- #ifdef SOCKET
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
--- 1033,1064 ----
str_sset(str,&str_undef);
break;
}
! #else
! if (optype == O_RECV)
! goto badsock;
! #endif
! STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2])); /* sneaky */
! #ifdef SOCKET
! if (stab_io(stab)->type == 's') {
argtype = sizeof buf;
! anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0,
buf, &argtype);
}
! else
#endif
+ if (optype == O_SYSREAD) {
+ anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
+ }
else
! anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
if (anum < 0)
goto say_undef;
! st[2]->str_cur = anum+maxarg;
! st[2]->str_ptr[anum+maxarg] = '\0';
value = (double)anum;
goto donumset;
+ case O_SYSWRITE:
case O_SEND:
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
***************
*** 1022,1038 ****
stab = stabent(str_get(st[1]),TRUE);
tmps = str_get(st[2]);
anum = (int)str_gnum(st[3]);
- optype = sp - arglast[0];
errno = 0;
- if (optype > 4)
- warn("Too many args on send");
stio = stab_io(stab);
if (!stio || !stio->ifp) {
anum = -1;
! if (dowarn)
! warn("Send on closed socket");
}
! else if (optype >= 4) {
tmps2 = str_get(st[4]);
anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
anum, tmps2, st[4]->str_cur);
--- 1065,1095 ----
stab = stabent(str_get(st[1]),TRUE);
tmps = str_get(st[2]);
anum = (int)str_gnum(st[3]);
errno = 0;
stio = stab_io(stab);
+ maxarg = sp - arglast[0];
if (!stio || !stio->ifp) {
anum = -1;
! if (dowarn) {
! if (optype == O_SYSWRITE)
! warn("Syswrite on closed filehandle");
! else
! warn("Send on closed socket");
! }
}
! else if (optype == O_SYSWRITE) {
! if (maxarg > 4)
! warn("Too many args on syswrite");
! if (maxarg == 4)
! optype = (int)str_gnum(st[4]);
! else
! optype = 0;
! anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum);
! }
! #ifdef SOCKET
! else if (maxarg >= 4) {
! if (maxarg > 4)
! warn("Too many args on send");
tmps2 = str_get(st[4]);
anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur,
anum, tmps2, st[4]->str_cur);
***************
*** 1039,1051 ****
}
else
anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
if (anum < 0)
goto say_undef;
value = (double)anum;
goto donumset;
- #else
- goto badsock;
- #endif
case O_SEEK:
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
--- 1096,1109 ----
}
else
anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum);
+ #else
+ else
+ goto badsock;
+ #endif
if (anum < 0)
goto say_undef;
value = (double)anum;
goto donumset;
case O_SEEK:
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
***************
*** 1059,1065 ****
case O_RETURN:
tmps = "_SUB_"; /* just fake up a "last _SUB_" */
optype = O_LAST;
! if (wantarray == G_ARRAY) {
lastretstr = Nullstr;
lastspbase = arglast[1];
lastsize = arglast[2] - arglast[1];
--- 1117,1123 ----
case O_RETURN:
tmps = "_SUB_"; /* just fake up a "last _SUB_" */
optype = O_LAST;
! if (curcsv->wantarray == G_ARRAY) {
lastretstr = Nullstr;
lastspbase = arglast[1];
lastsize = arglast[2] - arglast[1];
***************
*** 1118,1125 ****
longjmp(top_env, 1);
case O_INDEX:
tmps = str_get(st[1]);
#ifndef lint
! if (!(tmps2 = fbminstr((unsigned char*)tmps,
(unsigned char*)tmps + st[1]->str_cur, st[2])))
#else
if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
--- 1176,1192 ----
longjmp(top_env, 1);
case O_INDEX:
tmps = str_get(st[1]);
+ if (maxarg < 3)
+ anum = 0;
+ else {
+ anum = (int) str_gnum(st[3]) - arybase;
+ if (anum < 0)
+ anum = 0;
+ else if (anum > st[1]->str_cur)
+ anum = st[1]->str_cur;
+ }
#ifndef lint
! if (!(tmps2 = fbminstr((unsigned char*)tmps + anum,
(unsigned char*)tmps + st[1]->str_cur, st[2])))
#else
if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr))
***************
*** 1131,1138 ****
case O_RINDEX:
tmps = str_get(st[1]);
tmps2 = str_get(st[2]);
#ifndef lint
! if (!(tmps2 = rninstr(tmps, tmps + st[1]->str_cur,
tmps2, tmps2 + st[2]->str_cur)))
#else
if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
--- 1198,1214 ----
case O_RINDEX:
tmps = str_get(st[1]);
tmps2 = str_get(st[2]);
+ if (maxarg < 3)
+ anum = st[1]->str_cur;
+ else {
+ anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur;
+ if (anum < 0)
+ anum = 0;
+ else if (anum > st[1]->str_cur)
+ anum = st[1]->str_cur;
+ }
#ifndef lint
! if (!(tmps2 = rninstr(tmps, tmps + anum,
tmps2, tmps2 + st[2]->str_cur)))
#else
if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch))
***************
*** 1370,1377 ****
case O_FORK:
#ifdef FORK
anum = fork();
! if (!anum && (tmpstab = stabent("$",allstabs)))
! str_numset(STAB_STR(tmpstab),(double)getpid());
value = (double)anum;
goto donumset;
#else
--- 1446,1456 ----
case O_FORK:
#ifdef FORK
anum = fork();
! if (!anum) {
! if (tmpstab = stabent("$",allstabs))
! str_numset(STAB_STR(tmpstab),(double)getpid());
! hclear(pidstatus); /* no kids, so don't wait for 'em */
! }
value = (double)anum;
goto donumset;
#else
***************
*** 1392,1397 ****
--- 1471,1490 ----
fatal("Unsupported function wait");
break;
#endif
+ case O_WAITPID:
+ #ifdef WAITPID
+ #ifndef lint
+ anum = (int)str_gnum(st[1]);
+ optype = (int)str_gnum(st[2]);
+ anum = wait4pid(anum, &argflags,optype);
+ value = (double)anum;
+ #endif
+ statusvalue = (unsigned short)argflags;
+ goto donumset;
+ #else
+ fatal("Unsupported function wait");
+ break;
+ #endif
case O_SYSTEM:
#ifdef FORK
#ifdef TAINT
***************
*** 1412,1419 ****
#ifndef lint
ihand = signal(SIGINT, SIG_IGN);
qhand = signal(SIGQUIT, SIG_IGN);
! while ((argtype = wait(&argflags)) != anum && argtype >= 0)
! pidgone(argtype,argflags);
#else
ihand = qhand = 0;
#endif
--- 1505,1511 ----
#ifndef lint
ihand = signal(SIGINT, SIG_IGN);
qhand = signal(SIGQUIT, SIG_IGN);
! argtype = wait4pid(anum, &argflags, 0);
#else
ihand = qhand = 0;
#endif
***************
*** 1420,1426 ****
(void)signal(SIGINT, ihand);
(void)signal(SIGQUIT, qhand);
statusvalue = (unsigned short)argflags;
! if (argtype == -1)
value = -1.0;
else {
value = (double)((unsigned int)argflags & 0xffff);
--- 1512,1518 ----
(void)signal(SIGINT, ihand);
(void)signal(SIGQUIT, qhand);
statusvalue = (unsigned short)argflags;
! if (argtype < 0)
value = -1.0;
else {
value = (double)((unsigned int)argflags & 0xffff);
***************
*** 1446,1452 ****
}
goto donumset;
#endif /* FORK */
! case O_EXEC:
if ((arg[1].arg_type & A_MASK) == A_STAB)
value = (double)do_aexec(st[1],arglast);
else if (arglast[2] - arglast[1] != 1)
--- 1538,1544 ----
}
goto donumset;
#endif /* FORK */
! case O_EXEC_OP:
if ((arg[1].arg_type & A_MASK) == A_STAB)
value = (double)do_aexec(st[1],arglast);
else if (arglast[2] - arglast[1] != 1)
***************
*** 1463,1469 ****
argtype = 3;
snarfnum:
! anum = 0;
if (maxarg < 1)
tmps = str_get(stab_val(defstab));
else
--- 1555,1561 ----
argtype = 3;
snarfnum:
! tmplong = 0;
if (maxarg < 1)
tmps = str_get(stab_val(defstab));
else
***************
*** 1478,1492 ****
/* FALL THROUGH */
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7':
! anum <<= argtype;
! anum += *tmps++ & 15;
break;
case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
if (argtype != 4)
goto out;
! anum <<= 4;
! anum += (*tmps++ & 7) + 9;
break;
case 'x':
argtype = 4;
--- 1570,1584 ----
/* FALL THROUGH */
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7':
! tmplong <<= argtype;
! tmplong += *tmps++ & 15;
break;
case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
if (argtype != 4)
goto out;
! tmplong <<= 4;
! tmplong += (*tmps++ & 7) + 9;
break;
case 'x':
argtype = 4;
***************
*** 1495,1501 ****
}
}
out:
! value = (double)anum;
goto donumset;
case O_CHOWN:
#ifdef CHOWN
--- 1587,1593 ----
}
}
out:
! value = (double)tmplong;
goto donumset;
case O_CHOWN:
#ifdef CHOWN
***************
*** 1535,1540 ****
--- 1627,1680 ----
fatal("Unsupported function umask");
break;
#endif
+ #ifdef SYSVIPC
+ case O_MSGGET:
+ case O_SHMGET:
+ case O_SEMGET:
+ if ((anum = do_ipcget(optype, arglast)) == -1)
+ goto say_undef;
+ value = (double)anum;
+ goto donumset;
+ case O_MSGCTL:
+ case O_SHMCTL:
+ case O_SEMCTL:
+ anum = do_ipcctl(optype, arglast);
+ if (anum == -1)
+ goto say_undef;
+ if (anum != 0) {
+ value = (double)anum;
+ goto donumset;
+ }
+ str_set(str,"0 but true");
+ STABSET(str);
+ break;
+ case O_MSGSND:
+ value = (double)(do_msgsnd(arglast) >= 0);
+ goto donumset;
+ case O_MSGRCV:
+ value = (double)(do_msgrcv(arglast) >= 0);
+ goto donumset;
+ case O_SEMOP:
+ value = (double)(do_semop(arglast) >= 0);
+ goto donumset;
+ case O_SHMREAD:
+ case O_SHMWRITE:
+ value = (double)(do_shmio(optype, arglast) >= 0);
+ goto donumset;
+ #else /* not SYSVIPC */
+ case O_MSGGET:
+ case O_MSGCTL:
+ case O_MSGSND:
+ case O_MSGRCV:
+ case O_SEMGET:
+ case O_SEMCTL:
+ case O_SEMOP:
+ case O_SHMGET:
+ case O_SHMCTL:
+ case O_SHMREAD:
+ case O_SHMWRITE:
+ fatal("System V IPC is not implemented on this machine");
+ #endif /* not SYSVIPC */
case O_RENAME:
tmps = str_get(st[1]);
tmps2 = str_get(st[2]);
***************
*** 1604,1609 ****
--- 1744,1753 ----
#endif
if (instr(buf,"cannot make"))
errno = EEXIST;
+ else if (instr(buf,"existing file"))
+ errno = EEXIST;
+ else if (instr(buf,"ile exists"))
+ errno = EEXIST;
else if (instr(buf,"non-exist"))
errno = ENOENT;
else if (instr(buf,"does not exist"))
***************
*** 1769,1781 ****
if (arglast[2] - arglast[1] != 1)
do_unshift(ary,arglast);
else {
! str = Str_new(52,0); /* must copy the STR */
! str_sset(str,st[2]);
aunshift(ary,1);
! (void)astore(ary,0,str);
}
value = (double)(ary->ary_fill + 1);
! break;
case O_REQUIRE:
case O_DOFILE:
--- 1913,1925 ----
if (arglast[2] - arglast[1] != 1)
do_unshift(ary,arglast);
else {
! STR *tmpstr = Str_new(52,0); /* must copy the STR */
! str_sset(tmpstr,st[2]);
aunshift(ary,1);
! (void)astore(ary,0,tmpstr);
}
value = (double)(ary->ary_fill + 1);
! goto donumset;
case O_REQUIRE:
case O_DOFILE:
***************
*** 1789,1795 ****
tainted |= tmpstr->str_tainted;
taintproper("Insecure dependency in eval");
#endif
! sp = do_eval(tmpstr, optype, arg[2].arg_ptr.arg_hash,
gimme,arglast);
goto array_return;
--- 1933,1939 ----
tainted |= tmpstr->str_tainted;
taintproper("Insecure dependency in eval");
#endif
! sp = do_eval(tmpstr, optype, curcmd->c_stash,
gimme,arglast);
goto array_return;
***************
*** 1846,1851 ****
--- 1990,2011 ----
value = (double)statcache.st_size;
goto donumset;
+ case O_FTMTIME:
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ value = (double)(basetime - statcache.st_mtime) / 86400.0;
+ goto donumset;
+ case O_FTATIME:
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ value = (double)(basetime - statcache.st_atime) / 86400.0;
+ goto donumset;
+ case O_FTCTIME:
+ if (mystat(arg,st[1]) < 0)
+ goto say_undef;
+ value = (double)(basetime - statcache.st_ctime) / 86400.0;
+ goto donumset;
+
case O_FTSOCK:
#ifdef S_IFSOCK
anum = S_IFSOCK;
***************
*** 2116,2121 ****
--- 2276,2283 ----
stab = arg[1].arg_ptr.arg_stab;
else
stab = stabent(str_get(st[1]),TRUE);
+ if (!stab)
+ goto say_undef;
sp = do_getsockname(optype,stab,arglast);
goto array_return;
***************
*** 2250,2255 ****
--- 2412,2419 ----
stab = arg[1].arg_ptr.arg_stab;
else
stab = stabent(str_get(st[1]),TRUE);
+ if (!stab)
+ goto say_undef;
sp = do_dirop(optype,stab,gimme,arglast);
goto array_return;
case O_SYSCALL:
Index: MANIFEST
*** MANIFEST.old Tue Oct 16 15:30:56 1990
--- MANIFEST Tue Oct 16 15:30:59 1990
***************
*** 52,57 ****
--- 52,61 ----
eg/scan/scan_suid Scan for setuid anomalies
eg/scan/scanner An anomaly reporter
eg/shmkill A program to remove unused shared memory
+ eg/sysvipc/README Intro to Sys V IPC examples
+ eg/sysvipc/ipcmsg Example of SYS V IPC message queues
+ eg/sysvipc/ipcsem Example of Sys V IPC semaphores
+ eg/sysvipc/ipcshm Example of Sys V IPC shared memory
eg/travesty A program to print travesties of its input text
eg/van/empty A program to empty the trashcan
eg/van/unvanish A program to undo what vanish does
***************
*** 81,86 ****
--- 85,91 ----
hash.h Public declarations for the above
ioctl.pl Sample ioctl.pl
lib/abbrev.pl An abbreviation table builder
+ lib/cacheout.pl Manages output filehandles when you need too many
lib/complete.pl A command completion subroutine
lib/ctime.pl A ctime workalike
lib/dumpvar.pl A variable dumper
***************
*** 89,95 ****
lib/getopts.pl Perl library supporting option parsing
lib/importenv.pl Perl routine to get environment into variables
lib/look.pl A "look" equivalent
- lib/nsyslog.pl Newer syslog.pl
lib/perldb.pl Perl debugging routines
lib/pwd.pl Routines to keep track of PWD environment variable
lib/stat.pl Perl library supporting stat function
--- 94,99 ----
***************
*** 115,124 ****
--- 119,142 ----
msdos/popen.c My_popen and my_pclose for MS-DOS
os2/Makefile Makefile for OS/2
os2/README.OS2 Notes for OS/2
+ os2/a2p.cs Compiler script for a2p
+ os2/a2p.def Linker defs for a2p
os2/config.h Configuration file for OS/2
+ os2/dir.h Directory header
+ os2/director.c Directory routines
os2/eg/os2.pl Sample script for OS/2
os2/eg/syscalls.pl Example of syscall on OS/2
+ os2/makefile Make file
+ os2/mktemp.c Mktemp() using TMP
+ os2/os2.c Unix compatibility functions
+ os2/perl.bad names of protect-only API calls for BIND
+ os2/perl.cs Compiler script for perl
+ os2/perl.def Linker defs for perl
+ os2/perlglob.cs Compiler script for perlglob
+ os2/perlglob.def Linker defs for perlglob
+ os2/perlsh.cmd Poor man's shell for os2
os2/popen.c Code for opening pipes
+ os2/selfrun.cmd Example of extproc feature
os2/suffix.c Code for creating backup filenames
patchlevel.h The current patch level of perl
perl.h Global declarations
*** End of Patch 31 ***
More information about the Comp.sources.bugs
mailing list