perl 3.0 patch #39
Larry Wall
lwall at jpl-devvax.JPL.NASA.GOV
Sat Nov 10 22:26:04 AEST 1990
System: perl version 3.0
Patch #: 39
Priority:
Subject: patch #38, continued
Description:
See patch #38.
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 #40 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: 38
1c1
< #define PATCHLEVEL 38
---
> #define PATCHLEVEL 39
Index: os2/director.c
*** os2/director.c.old Sat Nov 10 02:29:33 1990
--- os2/director.c Sat Nov 10 02:29:34 1990
***************
*** 5,11 ****
* MS-DOS. Written by Michael Rendell ({uunet,utai}michael at garfield),
* August 1897
* Ported to OS/2 by Kai Uwe Rommel
! * December 1989
*/
#include <sys/types.h>
--- 5,12 ----
* MS-DOS. Written by Michael Rendell ({uunet,utai}michael at garfield),
* August 1897
* Ported to OS/2 by Kai Uwe Rommel
! * December 1989, February 1990
! * Change for HPFS support, October 1990
*/
#include <sys/types.h>
***************
*** 12,20 ****
--- 13,23 ----
#include <sys/stat.h>
#include <sys/dir.h>
+ #include <stdlib.h>
#include <stdio.h>
#include <malloc.h>
#include <string.h>
+ #include <ctype.h>
#define INCL_NOPM
#include <os2.h>
***************
*** 29,34 ****
--- 32,38 ----
static HDIR hdir;
static USHORT count;
static FILEFINDBUF find;
+ static BOOL lower;
DIR *opendir(char *name)
***************
*** 125,131 ****
dp.d_namlen = dp.d_reclen =
strlen(strcpy(dp.d_name, dirp -> dd_cp -> _d_entry));
- strlwr(dp.d_name); /* JF */
dp.d_ino = 0;
dp.d_size = dirp -> dd_cp -> _d_size;
--- 129,134 ----
***************
*** 176,181 ****
--- 179,222 ----
}
+ static int IsFileSystemFAT(char *dir)
+ {
+ USHORT nDrive;
+ ULONG lMap;
+ BYTE bData[64], bName[3];
+ USHORT cbData;
+
+ if ( _osmode == DOS_MODE )
+ return TRUE;
+ else
+ {
+ /* We separate FAT and HPFS file systems here.
+ * Filenames read from a FAT system are converted to lower case
+ * while the case of filenames read from a HPFS (and other future
+ * file systems, like Unix-compatibles) is preserved.
+ */
+
+ if ( isalpha(dir[0]) && (dir[1] == ':') )
+ nDrive = toupper(dir[0]) - '@';
+ else
+ DosQCurDisk(&nDrive, &lMap);
+
+ bName[0] = (char) (nDrive + '@');
+ bName[1] = ':';
+ bName[2] = 0;
+
+ cbData = sizeof(bData);
+
+ if ( !DosQFSAttach(bName, 0U, 1U, bData, &cbData, 0L) )
+ return !strcmp(bData + (*(USHORT *) (bData + 2) + 7), "FAT");
+ else
+ return FALSE;
+
+ /* End of this ugly code */
+ }
+ }
+
+
static char *getdirent(char *dir)
{
int done;
***************
*** 182,187 ****
--- 223,230 ----
if (dir != NULL)
{ /* get first entry */
+ lower = IsFileSystemFAT(dir);
+
hdir = HDIR_CREATE;
count = 1;
done = DosFindFirst(dir, &hdir, attributes,
***************
*** 189,194 ****
--- 232,240 ----
}
else /* get next entry */
done = DosFindNext(hdir, &find, sizeof(find), &count);
+
+ if ( lower )
+ strlwr(find.achName);
if (done == 0)
return find.achName;
Index: doarg.c
Prereq: 3.0.1.8
*** doarg.c.old Sat Nov 10 02:24:24 1990
--- doarg.c Sat Nov 10 02:24:33 1990
***************
*** 1,4 ****
! /* $Header: doarg.c,v 3.0.1.8 90/10/15 16:04:04 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: doarg.c,v 3.0.1.9 90/11/10 01:14:31 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: doarg.c,v $
+ * Revision 3.0.1.9 90/11/10 01:14:31 lwall
+ * patch38: random cleanup
+ * patch38: optimized join('',...)
+ * patch38: printf cleaned up
+ *
* Revision 3.0.1.8 90/10/15 16:04:04 lwall
* patch29: @ENV = () now works
* patch29: added caller
***************
*** 399,408 ****
str_sset(str,*st++);
else
str_set(str,"");
! for (; items > 0; items--,st++) {
! str_ncat(str,delim,delimlen);
! str_scat(str,*st);
}
STABSET(str);
}
--- 404,419 ----
str_sset(str,*st++);
else
str_set(str,"");
! if (delimlen) {
! for (; items > 0; items--,st++) {
! str_ncat(str,delim,delimlen);
! str_scat(str,*st);
! }
}
+ else {
+ for (; items > 0; items--,st++)
+ str_scat(str,*st);
+ }
STABSET(str);
}
***************
*** 465,473 ****
break;
case 'X':
shrink:
! str->str_cur -= len;
! if (str->str_cur < 0)
fatal("X outside of string");
str->str_ptr[str->str_cur] = '\0';
break;
case 'x':
--- 476,484 ----
break;
case 'X':
shrink:
! if (str->str_cur < len)
fatal("X outside of string");
+ str->str_cur -= len;
str->str_ptr[str->str_cur] = '\0';
break;
case 'x':
***************
*** 651,656 ****
--- 662,668 ----
{
register char *s;
register char *t;
+ register char *f;
bool dolong;
char ch;
static STR *sargnull = &str_no;
***************
*** 662,710 ****
str_set(str,"");
len--; /* don't count pattern string */
! origs = s = str_get(*sarg);
send = s + (*sarg)->str_cur;
sarg++;
! for ( ; s < send; len--) {
if (len <= 0 || !*sarg) {
sarg = &sargnull;
len = 0;
}
! dolong = FALSE;
! for (t = s; t < send && *t != '%'; t++) ;
if (t >= send)
! break; /* not enough % patterns, oh well */
! for (t++; *sarg && t < send && t != s; t++) {
switch (*t) {
default:
ch = *(++t);
*t = '\0';
! (void)sprintf(buf,s);
! s = t;
! *(t--) = ch;
len++;
break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
! case '.': case '#': case '-': case '+':
! break;
case 'l':
dolong = TRUE;
! break;
case 'c':
ch = *(++t);
*t = '\0';
xlen = (int)str_gnum(*(sarg++));
! if (strEQ(t-2,"%c")) { /* some printfs fail on null chars */
! *buf = xlen;
! str_ncat(str,s,t - s - 2);
! str_ncat(str,buf,1); /* so handle simple case */
! *buf = '\0';
}
else
! (void)sprintf(buf,s,xlen);
! s = t;
! *(t--) = ch;
break;
case 'D':
dolong = TRUE;
--- 674,719 ----
str_set(str,"");
len--; /* don't count pattern string */
! origs = t = s = str_get(*sarg);
send = s + (*sarg)->str_cur;
sarg++;
! for ( ; ; len--) {
if (len <= 0 || !*sarg) {
sarg = &sargnull;
len = 0;
}
! for ( ; t < send && *t != '%'; t++) ;
if (t >= send)
! break; /* end of format string, ignore extra args */
! f = t;
! *buf = '\0';
! xs = buf;
! dolong = FALSE;
! for (t++; t < send; t++) {
switch (*t) {
default:
ch = *(++t);
*t = '\0';
! (void)sprintf(xs,f);
len++;
break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
! case '.': case '#': case '-': case '+': case ' ':
! continue;
case 'l':
dolong = TRUE;
! continue;
case 'c':
ch = *(++t);
*t = '\0';
xlen = (int)str_gnum(*(sarg++));
! if (strEQ(f,"%c")) { /* some printfs fail on null chars */
! *xs = xlen;
! xs[1] = '\0';
}
else
! (void)sprintf(xs,f,xlen);
break;
case 'D':
dolong = TRUE;
***************
*** 713,723 ****
ch = *(++t);
*t = '\0';
if (dolong)
! (void)sprintf(buf,s,(long)str_gnum(*(sarg++)));
else
! (void)sprintf(buf,s,(int)str_gnum(*(sarg++)));
! s = t;
! *(t--) = ch;
break;
case 'X': case 'O':
dolong = TRUE;
--- 722,730 ----
ch = *(++t);
*t = '\0';
if (dolong)
! (void)sprintf(xs,f,(long)str_gnum(*(sarg++)));
else
! (void)sprintf(xs,f,(int)str_gnum(*(sarg++)));
break;
case 'X': case 'O':
dolong = TRUE;
***************
*** 727,744 ****
*t = '\0';
value = str_gnum(*(sarg++));
if (dolong)
! (void)sprintf(buf,s,U_L(value));
else
! (void)sprintf(buf,s,U_I(value));
! s = t;
! *(t--) = ch;
break;
case 'E': case 'e': case 'f': case 'G': case 'g':
ch = *(++t);
*t = '\0';
! (void)sprintf(buf,s,str_gnum(*(sarg++)));
! s = t;
! *(t--) = ch;
break;
case 's':
ch = *(++t);
--- 734,747 ----
*t = '\0';
value = str_gnum(*(sarg++));
if (dolong)
! (void)sprintf(xs,f,U_L(value));
else
! (void)sprintf(xs,f,U_I(value));
break;
case 'E': case 'e': case 'f': case 'G': case 'g':
ch = *(++t);
*t = '\0';
! (void)sprintf(xs,f,str_gnum(*(sarg++)));
break;
case 's':
ch = *(++t);
***************
*** 756,792 ****
xlen = strlen(tokenbuf);
str_free(tmpstr);
}
- if (strEQ(t-2,"%s")) { /* some printfs fail on >128 chars */
- *buf = '\0';
- str_ncat(str,s,t - s - 2);
- *t = ch;
- str_ncat(str,xs,xlen); /* so handle simple case */
- }
- else {
- if (origs == xs) { /* sprintf($s,...$s...) */
- strcpy(tokenbuf+64,s);
- s = tokenbuf+64;
- *t = ch;
- }
- (void)sprintf(buf,s,xs);
- }
sarg++;
! s = t;
! *(t--) = ch;
break;
}
! }
! if (s < t && t >= send) {
! str_cat(str,s);
s = t;
! break;
}
- str_cat(str,buf);
}
! if (*s) {
! (void)sprintf(buf,s,0,0,0,0);
! str_cat(str,buf);
! }
STABSET(str);
}
--- 759,785 ----
xlen = strlen(tokenbuf);
str_free(tmpstr);
}
sarg++;
! if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
! break; /* so handle simple case */
! }
! strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */
! *t = ch;
! (void)sprintf(buf,tokenbuf+64,xs);
! xs = buf;
break;
}
! /* end of switch, copy results */
! *t = ch;
! xlen = strlen(xs);
! STR_GROW(str, str->str_cur + (f - s) + len + 1);
! str_ncat(str, s, f - s);
! str_ncat(str, xs, xlen);
s = t;
! break; /* break from for loop */
}
}
! str_ncat(str, s, t - s);
STABSET(str);
}
Index: doio.c
Prereq: 3.0.1.12
*** doio.c.old Sat Nov 10 02:25:13 1990
--- doio.c Sat Nov 10 02:25:32 1990
***************
*** 1,4 ****
! /* $Header: doio.c,v 3.0.1.12 90/10/20 02:04:18 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: doio.c,v 3.0.1.13 90/11/10 01:17:37 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,15 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: doio.c,v $
+ * Revision 3.0.1.13 90/11/10 01:17:37 lwall
+ * patch38: -e _ was wrong if last stat failed
+ * patch38: more msdos/os2 upgrades
+ *
* Revision 3.0.1.12 90/10/20 02:04:18 lwall
* patch37: split out separate Sys V IPC features
*
***************
*** 112,117 ****
--- 116,123 ----
#include <fcntl.h>
#endif
+ int laststatval = -1;
+
bool
do_open(stab,name,len)
STAB *stab;
***************
*** 598,608 ****
--- 604,618 ----
if (optype == O_IOCTL)
retval = ioctl(fileno(stio->ifp), func, s);
else
+ #ifdef MSDOS
+ fatal("fcntl is not implemented");
+ #else
#ifdef I_FCNTL
retval = fcntl(fileno(stio->ifp), func, s);
#else
fatal("fcntl is not implemented");
#endif
+ #endif
#else /* lint */
retval = 0;
#endif /* lint */
***************
*** 625,631 ****
register ARRAY *ary = stack;
register int sp = arglast[0] + 1;
int max = 13;
- register int i;
if ((arg[1].arg_type & A_MASK) == A_WORD) {
tmpstab = arg[1].arg_ptr.arg_stab;
--- 635,640 ----
***************
*** 635,642 ****
--- 644,654 ----
if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
fstat(fileno(stab_io(tmpstab)->ifp),&statcache) < 0) {
max = 0;
+ laststatval = -1;
}
}
+ else if (laststatval < 0)
+ max = 0;
}
else {
str_sset(statname,ary->ary_array[sp]);
***************
*** 643,653 ****
statstab = Nullstab;
#ifdef LSTAT
if (arg->arg_type == O_LSTAT)
! i = lstat(str_get(statname),&statcache);
else
#endif
! i = stat(str_get(statname),&statcache);
! if (i < 0)
max = 0;
}
--- 655,665 ----
statstab = Nullstab;
#ifdef LSTAT
if (arg->arg_type == O_LSTAT)
! laststatval = lstat(str_get(statname),&statcache);
else
#endif
! laststatval = stat(str_get(statname),&statcache);
! if (laststatval < 0)
max = 0;
}
***************
*** 941,963 ****
if (stio && stio->ifp) {
statstab = arg[1].arg_ptr.arg_stab;
str_set(statname,"");
! return fstat(fileno(stio->ifp), &statcache);
}
else {
if (arg[1].arg_ptr.arg_stab == defstab)
! return 0;
if (dowarn)
warn("Stat on unopened file <%s>",
stab_name(arg[1].arg_ptr.arg_stab));
statstab = Nullstab;
str_set(statname,"");
! return -1;
}
}
else {
statstab = Nullstab;
str_sset(statname,str);
! return stat(str_get(str),&statcache);
}
}
--- 953,975 ----
if (stio && stio->ifp) {
statstab = arg[1].arg_ptr.arg_stab;
str_set(statname,"");
! return (laststatval = fstat(fileno(stio->ifp), &statcache));
}
else {
if (arg[1].arg_ptr.arg_stab == defstab)
! return laststatval;
if (dowarn)
warn("Stat on unopened file <%s>",
stab_name(arg[1].arg_ptr.arg_stab));
statstab = Nullstab;
str_set(statname,"");
! return (laststatval = -1);
}
}
else {
statstab = Nullstab;
str_sset(statname,str);
! return (laststatval = stat(str_get(str),&statcache));
}
}
Index: dolist.c
Prereq: 3.0.1.10
*** dolist.c.old Sat Nov 10 02:25:59 1990
--- dolist.c Sat Nov 10 02:26:08 1990
***************
*** 1,4 ****
! /* $Header: dolist.c,v 3.0.1.10 90/10/15 16:19:48 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: dolist.c,v 3.0.1.11 90/11/10 01:29:49 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,15 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: dolist.c,v $
+ * Revision 3.0.1.11 90/11/10 01:29:49 lwall
+ * patch38: temp string values are now copied less often
+ * patch38: sort parameters are now in the right package
+ *
* Revision 3.0.1.10 90/10/15 16:19:48 lwall
* patch29: added caller
* patch29: added scalar reverse
***************
*** 376,386 ****
for (m = s; m < strend && !isspace(*m); m++) ;
if (m >= strend)
break;
! if (realarray)
! dstr = Str_new(30,m-s);
! else
! dstr = str_static(&str_undef);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
for (s = m + 1; s < strend && isspace(*s); s++) ;
}
--- 380,389 ----
for (m = s; m < strend && !isspace(*m); m++) ;
if (m >= strend)
break;
! dstr = Str_new(30,m-s);
str_nset(dstr,s,m-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
for (s = m + 1; s < strend && isspace(*s); s++) ;
}
***************
*** 391,401 ****
m++;
if (m >= strend)
break;
! if (realarray)
! dstr = Str_new(30,m-s);
! else
! dstr = str_static(&str_undef);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
s = m;
}
--- 394,403 ----
m++;
if (m >= strend)
break;
! dstr = Str_new(30,m-s);
str_nset(dstr,s,m-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
s = m;
}
***************
*** 420,430 ****
for (m = s; m < strend && *m != i; m++) ;
if (m >= strend)
break;
! if (realarray)
! dstr = Str_new(30,m-s);
! else
! dstr = str_static(&str_undef);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
s = m + 1;
}
--- 422,431 ----
for (m = s; m < strend && *m != i; m++) ;
if (m >= strend)
break;
! dstr = Str_new(30,m-s);
str_nset(dstr,s,m-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
s = m + 1;
}
***************
*** 436,446 ****
spat->spat_short)) )
#endif
{
! if (realarray)
! dstr = Str_new(31,m-s);
! else
! dstr = str_static(&str_undef);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
s = m + i;
}
--- 437,446 ----
spat->spat_short)) )
#endif
{
! dstr = Str_new(31,m-s);
str_nset(dstr,s,m-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
s = m + i;
}
***************
*** 459,479 ****
strend = s + (strend - m);
}
m = spat->spat_regexp->startp[0];
! if (realarray)
! dstr = Str_new(32,m-s);
! else
! dstr = str_static(&str_undef);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
if (spat->spat_regexp->nparens) {
for (i = 1; i <= spat->spat_regexp->nparens; i++) {
s = spat->spat_regexp->startp[i];
m = spat->spat_regexp->endp[i];
! if (realarray)
! dstr = Str_new(33,m-s);
! else
! dstr = str_static(&str_undef);
str_nset(dstr,s,m-s);
(void)astore(ary, ++sp, dstr);
}
}
--- 459,477 ----
strend = s + (strend - m);
}
m = spat->spat_regexp->startp[0];
! dstr = Str_new(32,m-s);
str_nset(dstr,s,m-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
if (spat->spat_regexp->nparens) {
for (i = 1; i <= spat->spat_regexp->nparens; i++) {
s = spat->spat_regexp->startp[i];
m = spat->spat_regexp->endp[i];
! dstr = Str_new(33,m-s);
str_nset(dstr,s,m-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
}
}
***************
*** 487,497 ****
if (iters > maxiters)
fatal("Split loop");
if (s < strend || origlimit) { /* keep field after final delim? */
! if (realarray)
! dstr = Str_new(34,strend-s);
! else
! dstr = str_static(&str_undef);
str_nset(dstr,s,strend-s);
(void)astore(ary, ++sp, dstr);
iters++;
}
--- 485,494 ----
if (iters > maxiters)
fatal("Split loop");
if (s < strend || origlimit) { /* keep field after final delim? */
! dstr = Str_new(34,strend-s);
str_nset(dstr,s,strend-s);
+ if (!realarray)
+ str_2static(dstr);
(void)astore(ary, ++sp, dstr);
iters++;
}
***************
*** 554,564 ****
register int len;
/* These must not be in registers: */
- char achar;
short ashort;
int aint;
long along;
- unsigned char auchar;
unsigned short aushort;
unsigned int auint;
unsigned long aulong;
--- 551,559 ----
***************
*** 1296,1304 ****
}
int
! do_reverse(str,gimme,arglast)
! STR *str;
! int gimme;
int *arglast;
{
STR **st = stack->ary_array;
--- 1291,1297 ----
}
int
! do_reverse(arglast)
int *arglast;
{
STR **st = stack->ary_array;
***************
*** 1317,1325 ****
}
int
! do_sreverse(str,gimme,arglast)
STR *str;
- int gimme;
int *arglast;
{
STR **st = stack->ary_array;
--- 1310,1317 ----
}
int
! do_sreverse(str,arglast)
STR *str;
int *arglast;
{
STR **st = stack->ary_array;
***************
*** 1343,1348 ****
--- 1335,1341 ----
}
static CMD *sortcmd;
+ static HASH *sortstash = Null(HASH*);
static STAB *firststab = Nullstab;
static STAB *secondstab = Nullstab;
***************
*** 1391,1404 ****
fatal("Undefined subroutine \"%s\" in sort", stab_name(stab));
if (!sortstack) {
sortstack = anew(Nullstab);
sortstack->ary_flags = 0;
}
oldstack = stack;
stack = sortstack;
tmps_base = tmps_max;
! if (!firststab) {
firststab = stabent("a",TRUE);
secondstab = stabent("b",TRUE);
}
oldfirst = stab_val(firststab);
oldsecond = stab_val(secondstab);
--- 1384,1400 ----
fatal("Undefined subroutine \"%s\" in sort", stab_name(stab));
if (!sortstack) {
sortstack = anew(Nullstab);
+ astore(sortstack, 0, Nullstr);
+ aclear(sortstack);
sortstack->ary_flags = 0;
}
oldstack = stack;
stack = sortstack;
tmps_base = tmps_max;
! if (sortstash != stab_stash(stab)) {
firststab = stabent("a",TRUE);
secondstab = stabent("b",TRUE);
+ sortstash = stab_stash(stab);
}
oldfirst = stab_val(firststab);
oldsecond = stab_val(secondstab);
***************
*** 1485,1491 ****
while (!str->str_nok && str->str_cur <= final->str_cur &&
strNE(str->str_ptr,tmps) ) {
(void)astore(ary, ++sp, str);
! str = str_static(str);
str_inc(str);
}
if (strEQ(str->str_ptr,tmps))
--- 1481,1487 ----
while (!str->str_nok && str->str_cur <= final->str_cur &&
strNE(str->str_ptr,tmps) ) {
(void)astore(ary, ++sp, str);
! str = str_2static(str_smake(str));
str_inc(str);
}
if (strEQ(str->str_ptr,tmps))
***************
*** 1537,1545 ****
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,
--- 1533,1541 ----
str_2static(str_nmake((double)csv->curcmd->c_line)) );
if (!maxarg)
return sp;
! str = Str_new(49,0);
stab_fullname(str, csv->stab);
! (void)astore(stack,++sp, str_2static(str));
(void)astore(stack,++sp,
str_2static(str_nmake((double)csv->hasargs)) );
(void)astore(stack,++sp,
Index: eval.c
Prereq: 3.0.1.9
*** eval.c.old Sat Nov 10 02:26:51 1990
--- eval.c Sat Nov 10 02:27:05 1990
***************
*** 1,4 ****
! /* $Header: eval.c,v 3.0.1.9 90/10/15 16:46:13 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: eval.c,v 3.0.1.10 90/11/10 01:33:22 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,17 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: eval.c,v $
+ * Revision 3.0.1.10 90/11/10 01:33:22 lwall
+ * patch38: random cleanup
+ * patch38: couldn't return from sort routine
+ * patch38: added hooks for unexec()
+ * patch38: added alarm function
+ *
* Revision 3.0.1.9 90/10/15 16:46:13 lwall
* patch29: added caller
* patch29: added scalar
***************
*** 848,858 ****
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) {
--- 854,862 ----
goto array_return;
case O_REVERSE:
if (gimme == G_ARRAY)
! sp = do_reverse(arglast);
else
! sp = do_sreverse(str, arglast);
goto array_return;
case O_WARN:
if (arglast[2] - arglast[1] != 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];
--- 1121,1127 ----
case O_RETURN:
tmps = "_SUB_"; /* just fake up a "last _SUB_" */
optype = O_LAST;
! if (curcsv && curcsv->wantarray == G_ARRAY) {
lastretstr = Nullstr;
lastspbase = arglast[1];
lastsize = arglast[2] - arglast[1];
***************
*** 1171,1177 ****
goto_targ = Nullch; /* just restart from top */
if (optype == O_DUMP) {
do_undump = 1;
! abort();
}
longjmp(top_env, 1);
case O_INDEX:
--- 1175,1181 ----
goto_targ = Nullch; /* just restart from top */
if (optype == O_DUMP) {
do_undump = 1;
! my_unexec();
}
longjmp(top_env, 1);
case O_INDEX:
***************
*** 1355,1360 ****
--- 1359,1376 ----
anum = (int) *tmps;
value = (double) (anum & 255);
#endif
+ goto donumset;
+ case O_ALARM:
+ if (maxarg < 1)
+ tmps = str_get(stab_val(defstab));
+ else
+ tmps = str_get(st[1]);
+ if (!tmps)
+ tmps = "0";
+ anum = alarm((unsigned int)atoi(tmps));
+ if (anum < 0)
+ goto say_undef;
+ value = (double)anum;
goto donumset;
case O_SLEEP:
if (maxarg < 1)
Index: evalargs.xc
Prereq: 3.0.1.7
*** evalargs.xc.old Sat Nov 10 02:27:25 1990
--- evalargs.xc Sat Nov 10 02:27:31 1990
***************
*** 2,10 ****
* kit sizes from getting too big.
*/
! /* $Header: evalargs.xc,v 3.0.1.7 90/10/15 16:48:11 lwall Locked $
*
* $Log: evalargs.xc,v $
* Revision 3.0.1.7 90/10/15 16:48:11 lwall
* patch29: non-existent array values no longer cause core dumps
* patch29: added caller
--- 2,13 ----
* kit sizes from getting too big.
*/
! /* $Header: evalargs.xc,v 3.0.1.8 90/11/10 01:35:49 lwall Locked $
*
* $Log: evalargs.xc,v $
+ * Revision 3.0.1.8 90/11/10 01:35:49 lwall
+ * patch38: array slurps are now faster and take less memory
+ *
* Revision 3.0.1.7 90/10/15 16:48:11 lwall
* patch29: non-existent array values no longer cause core dumps
* patch29: added caller
***************
*** 245,255 ****
astore(stack, sp, Nullstr);
st = stack->ary_array;
}
! st[sp] = str_static(&str_undef);
! if (str_gets(st[sp],fp,0) == Nullch) {
sp--;
break;
}
}
}
statusvalue = mypclose(fp);
--- 248,263 ----
astore(stack, sp, Nullstr);
st = stack->ary_array;
}
! str = st[sp] = Str_new(56,80);
! if (str_gets(str,fp,0) == Nullch) {
sp--;
break;
}
+ if (str->str_len - str->str_cur > 20) {
+ str->str_len = str->str_cur+1;
+ Renew(str->str_ptr, str->str_len, char);
+ }
+ str_2static(str);
}
}
statusvalue = mypclose(fp);
***************
*** 299,305 ****
if (anum > 1) /* assign to scalar */
gimme = G_SCALAR; /* force context to scalar */
if (gimme == G_ARRAY)
! str = str_static(&str_undef);
++sp;
fp = Nullfp;
if (stab_io(last_in_stab)) {
--- 307,313 ----
if (anum > 1) /* assign to scalar */
gimme = G_SCALAR; /* force context to scalar */
if (gimme == G_ARRAY)
! str = Str_new(57,0);
++sp;
fp = Nullfp;
if (stab_io(last_in_stab)) {
***************
*** 369,374 ****
--- 377,383 ----
record_separator = old_record_separator;
if (gimme == G_ARRAY) {
--sp;
+ str_2static(str);
goto array_return;
}
break;
***************
*** 394,404 ****
goto keepgoing; /* unmatched wildcard? */
}
if (gimme == G_ARRAY) {
if (++sp > stack->ary_max) {
astore(stack, sp, Nullstr);
st = stack->ary_array;
}
! str = str_static(&str_undef);
goto keepgoing;
}
}
--- 403,418 ----
goto keepgoing; /* unmatched wildcard? */
}
if (gimme == G_ARRAY) {
+ if (str->str_len - str->str_cur > 20) {
+ str->str_len = str->str_cur+1;
+ Renew(str->str_ptr, str->str_len, char);
+ }
+ str_2static(str);
if (++sp > stack->ary_max) {
astore(stack, sp, Nullstr);
st = stack->ary_array;
}
! str = Str_new(58,80);
goto keepgoing;
}
}
Index: h2ph.SH
*** h2ph.SH.old Sat Nov 10 02:27:45 1990
--- h2ph.SH Sat Nov 10 02:27:48 1990
***************
*** 35,41 ****
%isatype = ('char',1,'short',1,'int',1,'long',1);
foreach $file (@ARGV) {
! ($outfile = $file) =~ s/\.h$/.ph/;
print "$file -> $outfile\n";
if ($file =~ m|^(.*)/|) {
$dir = $1;
--- 35,41 ----
%isatype = ('char',1,'short',1,'int',1,'long',1);
foreach $file (@ARGV) {
! ($outfile = $file) =~ s/\.h$/.ph/ || next;
print "$file -> $outfile\n";
if ($file =~ m|^(.*)/|) {
$dir = $1;
Index: t/lib.big
*** t/lib.big.old Sat Nov 10 02:37:14 1990
--- t/lib.big Sat Nov 10 02:37:16 1990
***************
*** 0 ****
--- 1,280 ----
+ #!./perl
+ require "../lib/bigint.pl";
+
+ $test = 0;
+ $| = 1;
+ print "1..246\n";
+ while (<DATA>) {
+ chop;
+ if (/^&/) {
+ $f = $_;
+ } else {
+ ++$test;
+ @args = split(/:/,$_,99);
+ $ans = pop(@args);
+ $try = "$f('" . join("','", @args) . "');";
+ if (($ans1 = eval($try)) eq $ans) {
+ print "ok $test\n";
+ } else {
+ print "not ok $test\n";
+ print "# '$try' expected: '$ans' got: '$ans1'\n";
+ }
+ }
+ }
+ __END__
+ &bnorm
+ abc:NaN
+ 1 a:NaN
+ 1bcd2:NaN
+ 11111b:NaN
+ +1z:NaN
+ -1z:NaN
+ 0:+0
+ +0:+0
+ +00:+0
+ +0 0 0:+0
+ 000000 0000000 00000:+0
+ -0:+0
+ -0000:+0
+ +1:+1
+ +01:+1
+ +001:+1
+ +00000100000:+100000
+ 123456789:+123456789
+ -1:-1
+ -01:-1
+ -001:-1
+ -123456789:-123456789
+ -00000100000:-100000
+ &bneg
+ abd:NaN
+ +0:+0
+ +1:-1
+ -1:+1
+ +123456789:-123456789
+ -123456789:+123456789
+ &babs
+ abc:NaN
+ +0:+0
+ +1:+1
+ -1:+1
+ +123456789:+123456789
+ -123456789:+123456789
+ &bcmp
+ abc:abc:
+ abc:+0:
+ +0:abc:
+ +0:+0:0
+ -1:+0:-1
+ +0:-1:1
+ +1:+0:1
+ +0:+1:-1
+ -1:+1:-1
+ +1:-1:1
+ -1:-1:0
+ +1:+1:0
+ +123:+123:0
+ +123:+12:1
+ +12:+123:-1
+ -123:-123:0
+ -123:-12:-1
+ -12:-123:1
+ +123:+124:-1
+ +124:+123:1
+ -123:-124:1
+ -124:-123:-1
+ &badd
+ abc:abc:NaN
+ abc:+0:NaN
+ +0:abc:NaN
+ +0:+0:+0
+ +1:+0:+1
+ +0:+1:+1
+ +1:+1:+2
+ -1:+0:-1
+ +0:-1:-1
+ -1:-1:-2
+ -1:+1:+0
+ +1:-1:+0
+ +9:+1:+10
+ +99:+1:+100
+ +999:+1:+1000
+ +9999:+1:+10000
+ +99999:+1:+100000
+ +999999:+1:+1000000
+ +9999999:+1:+10000000
+ +99999999:+1:+100000000
+ +999999999:+1:+1000000000
+ +9999999999:+1:+10000000000
+ +99999999999:+1:+100000000000
+ +10:-1:+9
+ +100:-1:+99
+ +1000:-1:+999
+ +10000:-1:+9999
+ +100000:-1:+99999
+ +1000000:-1:+999999
+ +10000000:-1:+9999999
+ +100000000:-1:+99999999
+ +1000000000:-1:+999999999
+ +10000000000:-1:+9999999999
+ +123456789:+987654321:+1111111110
+ -123456789:+987654321:+864197532
+ -123456789:-987654321:-1111111110
+ +123456789:-987654321:-864197532
+ &bsub
+ abc:abc:NaN
+ abc:+0:NaN
+ +0:abc:NaN
+ +0:+0:+0
+ +1:+0:+1
+ +0:+1:-1
+ +1:+1:+0
+ -1:+0:-1
+ +0:-1:+1
+ -1:-1:+0
+ -1:+1:-2
+ +1:-1:+2
+ +9:+1:+8
+ +99:+1:+98
+ +999:+1:+998
+ +9999:+1:+9998
+ +99999:+1:+99998
+ +999999:+1:+999998
+ +9999999:+1:+9999998
+ +99999999:+1:+99999998
+ +999999999:+1:+999999998
+ +9999999999:+1:+9999999998
+ +99999999999:+1:+99999999998
+ +10:-1:+11
+ +100:-1:+101
+ +1000:-1:+1001
+ +10000:-1:+10001
+ +100000:-1:+100001
+ +1000000:-1:+1000001
+ +10000000:-1:+10000001
+ +100000000:-1:+100000001
+ +1000000000:-1:+1000000001
+ +10000000000:-1:+10000000001
+ +123456789:+987654321:-864197532
+ -123456789:+987654321:-1111111110
+ -123456789:-987654321:+864197532
+ +123456789:-987654321:+1111111110
+ &bmul
+ abc:abc:NaN
+ abc:+0:NaN
+ +0:abc:NaN
+ +0:+0:+0
+ +0:+1:+0
+ +1:+0:+0
+ +0:-1:+0
+ -1:+0:+0
+ +123456789123456789:+0:+0
+ +0:+123456789123456789:+0
+ -1:-1:+1
+ -1:+1:-1
+ +1:-1:-1
+ +1:+1:+1
+ +2:+3:+6
+ -2:+3:-6
+ +2:-3:-6
+ -2:-3:+6
+ +111:+111:+12321
+ +10101:+10101:+102030201
+ +1001001:+1001001:+1002003002001
+ +100010001:+100010001:+10002000300020001
+ +10000100001:+10000100001:+100002000030000200001
+ +11111111111:+9:+99999999999
+ +22222222222:+9:+199999999998
+ +33333333333:+9:+299999999997
+ +44444444444:+9:+399999999996
+ +55555555555:+9:+499999999995
+ +66666666666:+9:+599999999994
+ +77777777777:+9:+699999999993
+ +88888888888:+9:+799999999992
+ +99999999999:+9:+899999999991
+ &bdiv
+ abc:abc:NaN
+ abc:+1:abc:NaN
+ +1:abc:NaN
+ +0:+0:NaN
+ +0:+1:+0
+ +1:+0:NaN
+ +0:-1:+0
+ -1:+0:NaN
+ +1:+1:+1
+ -1:-1:+1
+ +1:-1:-1
+ -1:+1:-1
+ +1:+2:+0
+ +2:+1:+2
+ +1000000000:+9:+111111111
+ +2000000000:+9:+222222222
+ +3000000000:+9:+333333333
+ +4000000000:+9:+444444444
+ +5000000000:+9:+555555555
+ +6000000000:+9:+666666666
+ +7000000000:+9:+777777777
+ +8000000000:+9:+888888888
+ +9000000000:+9:+1000000000
+ +35500000:+113:+314159
+ +71000000:+226:+314159
+ +106500000:+339:+314159
+ +1000000000:+3:+333333333
+ +10:+5:+2
+ +100:+4:+25
+ +1000:+8:+125
+ +10000:+16:+625
+ +999999999999:+9:+111111111111
+ +999999999999:+99:+10101010101
+ +999999999999:+999:+1001001001
+ +999999999999:+9999:+100010001
+ +999999999999999:+99999:+10000100001
+ &bmod
+ abc:abc:NaN
+ abc:+1:abc:NaN
+ +1:abc:NaN
+ +0:+0:NaN
+ +0:+1:+0
+ +1:+0:NaN
+ +0:-1:+0
+ -1:+0:NaN
+ +1:+1:+0
+ -1:-1:+0
+ +1:-1:+0
+ -1:+1:+0
+ +1:+2:+1
+ +2:+1:+0
+ +1000000000:+9:+1
+ +2000000000:+9:+2
+ +3000000000:+9:+3
+ +4000000000:+9:+4
+ +5000000000:+9:+5
+ +6000000000:+9:+6
+ +7000000000:+9:+7
+ +8000000000:+9:+8
+ +9000000000:+9:+0
+ +35500000:+113:+33
+ +71000000:+226:+66
+ +106500000:+339:+99
+ +1000000000:+3:+1
+ +10:+5:+0
+ +100:+4:+0
+ +1000:+8:+0
+ +10000:+16:+0
+ +999999999999:+9:+0
+ +999999999999:+99:+0
+ +999999999999:+999:+0
+ +999999999999:+9999:+0
+ +999999999999999:+99999:+0
+ &bgcd
+ abc:abc:NaN
+ abc:+0:NaN
+ +0:abc:NaN
+ +0:+0:+0
+ +0:+1:+1
+ +1:+0:+1
+ +1:+1:+1
+ +2:+3:+1
+ +3:+2:+1
+ +100:+625:+25
+ +4096:+81:+1
Index: os2/os2.c
Prereq: 3.0.1.1
*** os2/os2.c.old Sat Nov 10 02:29:40 1990
--- os2/os2.c Sat Nov 10 02:29:43 1990
***************
*** 1,4 ****
! /* $Header: os2.c,v 3.0.1.1 90/10/15 17:49:55 lwall Locked $
*
* (C) Copyright 1989, 1990 Diomidis Spinellis.
*
--- 1,4 ----
! /* $Header: os2.c,v 3.0.1.2 90/11/10 01:42:38 lwall Locked $
*
* (C) Copyright 1989, 1990 Diomidis Spinellis.
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: os2.c,v $
+ * Revision 3.0.1.2 90/11/10 01:42:38 lwall
+ * patch38: more msdos/os2 upgrades
+ *
* Revision 3.0.1.1 90/10/15 17:49:55 lwall
* patch29: Initial revision
*
***************
*** 50,56 ****
int chdir(char *path)
{
if ( path[0] != 0 && path[1] == ':' )
! DosSelectDisk(tolower(path[0]) - '@');
DosChDir(path, 0L);
}
--- 53,59 ----
int chdir(char *path)
{
if ( path[0] != 0 && path[1] == ':' )
! DosSelectDisk(toupper(path[0]) - '@');
DosChDir(path, 0L);
}
Index: os2/perl.bad
*** os2/perl.bad.old Sat Nov 10 02:29:50 1990
--- os2/perl.bad Sat Nov 10 02:29:52 1990
***************
*** 4,6 ****
--- 4,7 ----
DOSFLAGPROCESS
DOSSETPRTY
DOSGETPRTY
+ DOSQFSATTACH
Index: os2/perl.cs
*** os2/perl.cs.old Sat Nov 10 02:29:58 1990
--- os2/perl.cs Sat Nov 10 02:30:00 1990
***************
*** 3,13 ****
hash.c perl.c perly.c regcomp.c regexec.c stab.c str.c util.c
)
(-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c{evalargs.xc} toke.c)
! (-W1 -Od -Olt os2.c popen.c mktemp.c director.c suffix.c)
setargv.obj
! perl.def
! perl.bad
perl.exe
! -AL -LB -S0x9000
--- 3,15 ----
hash.c perl.c perly.c regcomp.c regexec.c stab.c str.c util.c
)
(-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c{evalargs.xc} toke.c)
! (-W1 -Od -Olt -I.
! os2\os2.c os2\popen.c os2\mktemp.c os2\director.c os2\suffix.c
! )
setargv.obj
! os2\perl.def
! os2\perl.bad
perl.exe
! -AL -LB -S0x8800
Index: os2/perl.def
*** os2/perl.def.old Sat Nov 10 02:30:10 1990
--- os2/perl.def Sat Nov 10 02:30:11 1990
***************
*** 1,2 ****
NAME PERL WINDOWCOMPAT NEWFILES
! DESCRIPTION 'PERL 3.0, patchlevel 28 - for MS-DOS and OS/2'
--- 1,2 ----
NAME PERL WINDOWCOMPAT NEWFILES
! DESCRIPTION 'PERL 3.0, patchlevel 37 - for MS-DOS and OS/2'
Index: perl.h
Prereq: 3.0.1.9
*** perl.h.old Sat Nov 10 02:30:49 1990
--- perl.h Sat Nov 10 02:30:55 1990
***************
*** 1,4 ****
! /* $Header: perl.h,v 3.0.1.9 90/10/15 17:59:41 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: perl.h,v 3.0.1.10 90/11/10 01:44:13 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: perl.h,v $
+ * Revision 3.0.1.10 90/11/10 01:44:13 lwall
+ * patch38: more msdos/os2 upgrades
+ *
* Revision 3.0.1.9 90/10/15 17:59:41 lwall
* patch29: some machines didn't like unsigned C preprocessor values
*
***************
*** 623,629 ****
#ifndef MSDOS
#define TMPPATH "/tmp/perl-eXXXXXX"
#else
! #define TMPPATH "/tmp/plXXXXXX"
#endif /* MSDOS */
EXT char *e_tmpname;
EXT FILE *e_fp INIT(Nullfp);
--- 626,632 ----
#ifndef MSDOS
#define TMPPATH "/tmp/perl-eXXXXXX"
#else
! #define TMPPATH "plXXXXXX"
#endif /* MSDOS */
EXT char *e_tmpname;
EXT FILE *e_fp INIT(Nullfp);
Index: perl_man.1
Prereq: 3.0.1.9
*** perl_man.1.old Sat Nov 10 02:31:23 1990
--- perl_man.1 Sat Nov 10 02:31:35 1990
***************
*** 1,7 ****
.rn '' }`
! ''' $Header: perl_man.1,v 3.0.1.9 90/10/20 02:14:24 lwall Locked $
'''
''' $Log: perl_man.1,v $
''' Revision 3.0.1.9 90/10/20 02:14:24 lwall
''' patch37: fixed various typos in man page
'''
--- 1,10 ----
.rn '' }`
! ''' $Header: perl_man.1,v 3.0.1.10 90/11/10 01:45:16 lwall Locked $
'''
''' $Log: perl_man.1,v $
+ ''' Revision 3.0.1.10 90/11/10 01:45:16 lwall
+ ''' patch38: random cleanup
+ '''
''' Revision 3.0.1.9 90/10/20 02:14:24 lwall
''' patch37: fixed various typos in man page
'''
***************
*** 631,637 ****
In addition, the token __END__ may be used to indicate the logical end of the
script before the actual end of file.
Any following text is ignored (but may be read via the DATA filehandle).
! The two control characters ^D and ^Z are synomyms for __END__.
.PP
A word that doesn't have any other interpretation in the grammar will be
treated as if it had single quotes around it.
--- 634,640 ----
In addition, the token __END__ may be used to indicate the logical end of the
script before the actual end of file.
Any following text is ignored (but may be read via the DATA filehandle).
! The two control characters ^D and ^Z are synonyms for __END__.
.PP
A word that doesn't have any other interpretation in the grammar will be
treated as if it had single quotes around it.
***************
*** 997,1003 ****
switch.)
.PP
A declaration can be put anywhere a command can, but has no effect on the
! execution of the primary sequence of commands--declarations all take effect
at compile time.
Typically all the declarations are put at the beginning or the end of the script.
.PP
--- 1000,1006 ----
switch.)
.PP
A declaration can be put anywhere a command can, but has no effect on the
! execution of the primary sequence of commands\(*--declarations all take effect
at compile time.
Typically all the declarations are put at the beginning or the end of the script.
.PP
Index: perl_man.2
Prereq: 3.0.1.9
*** perl_man.2.old Sat Nov 10 02:32:05 1990
--- perl_man.2 Sat Nov 10 02:32:18 1990
***************
*** 1,7 ****
''' Beginning of part 2
! ''' $Header: perl_man.2,v 3.0.1.9 90/10/15 18:17:37 lwall Locked $
'''
''' $Log: perl_man.2,v $
''' Revision 3.0.1.9 90/10/15 18:17:37 lwall
''' patch29: added caller
''' patch29: index and substr now have optional 3rd args
--- 1,11 ----
''' Beginning of part 2
! ''' $Header: perl_man.2,v 3.0.1.10 90/11/10 01:46:29 lwall Locked $
'''
''' $Log: perl_man.2,v $
+ ''' Revision 3.0.1.10 90/11/10 01:46:29 lwall
+ ''' patch38: random cleanup
+ ''' patch38: added alarm function
+ '''
''' Revision 3.0.1.9 90/10/15 18:17:37 lwall
''' patch29: added caller
''' patch29: index and substr now have optional 3rd args
***************
*** 75,80 ****
--- 79,93 ----
Does the same thing that the accept system call does.
Returns true if it succeeded, false otherwise.
See example in section on Interprocess Communication.
+ .Ip "alarm(SECONDS)" 8 4
+ .Ip "alarm SECONDS" 8
+ Arranges to have a SIGALRM delivered to this process after the specified number
+ of seconds (minus 1, actually) have elapsed. Thus, alarm(15) will cause
+ a SIGALRM at some point more than 14 seconds in the future.
+ Only one timer may be counting at once. Each call disables the previous
+ timer, and an argument of 0 may be supplied to cancel the previous timer
+ without starting a new one.
+ The returned value is the amount of time remaining on the previous timer.
.Ip "atan2(X,Y)" 8 2
Returns the arctangent of X/Y in the range
.if t \-\(*p to \(*p.
***************
*** 334,345 ****
Saying undef %ARRAY is faster yet.)
.Ip "die(LIST)" 8
.Ip "die LIST" 8
! Prints the value of LIST to
.I STDERR
and exits with the current value of $!
(errno).
If $! is 0, exits with the value of ($? >> 8) (\`command\` status).
If ($? >> 8) is 0, exits with 255.
Equivalent examples:
.nf
--- 347,361 ----
Saying undef %ARRAY is faster yet.)
.Ip "die(LIST)" 8
.Ip "die LIST" 8
! Outside of an eval, prints the value of LIST to
.I STDERR
and exits with the current value of $!
(errno).
If $! is 0, exits with the value of ($? >> 8) (\`command\` status).
If ($? >> 8) is 0, exits with 255.
+ Inside an eval, the error message is stuffed into $@ and the eval is terminated
+ with the undefined value.
+ .Sp
Equivalent examples:
.nf
***************
*** 546,554 ****
any variable settings, subroutine or format definitions remain afterwards.
The value returned is the value of the last expression evaluated, just
as with subroutines.
! If there is a syntax error or runtime error, a null string is returned by
eval, and $@ is set to the error message.
! If there was no error, $@ is null.
If EXPR is omitted, evaluates $_.
The final semicolon, if any, may be omitted from the expression.
.Sp
--- 562,571 ----
any variable settings, subroutine or format definitions remain afterwards.
The value returned is the value of the last expression evaluated, just
as with subroutines.
! If there is a syntax error or runtime error, or a die statement is
! executed, an undefined value is returned by
eval, and $@ is set to the error message.
! If there was no error, $@ is guaranteed to be a null string.
If EXPR is omitted, evaluates $_.
The final semicolon, if any, may be omitted from the expression.
.Sp
***************
*** 555,560 ****
--- 572,579 ----
Note that, since eval traps otherwise-fatal errors, it is useful for
determining whether a particular feature
(such as dbmopen or symlink) is implemented.
+ It is also Perl's exception trapping mechanism, where the die operator is
+ used to raise exceptions.
.Ip "exec(LIST)" 8 8
.Ip "exec LIST" 8 6
If there is more than one argument in LIST, or if LIST is an array with
***************
*** 617,626 ****
.fi
first to get the correct function definitions.
! If fcntl.h doesn't exist or doesn't have the correct definitions
you'll have to roll
your own, based on your C header files such as <sys/fcntl.h>.
! (There is a perl script called makelib that comes with the perl kit
which may help you in this.)
Argument processing and value return works just like ioctl below.
Note that fcntl will produce a fatal error if used on a machine that doesn't implement
--- 636,645 ----
.fi
first to get the correct function definitions.
! If fcntl.ph doesn't exist or doesn't have the correct definitions
you'll have to roll
your own, based on your C header files such as <sys/fcntl.h>.
! (There is a perl script called h2ph that comes with the perl kit
which may help you in this.)
Argument processing and value return works just like ioctl below.
Note that fcntl will produce a fatal error if used on a machine that doesn't implement
***************
*** 861,870 ****
.fi
first to get the correct function definitions.
! If ioctl.h doesn't exist or doesn't have the correct definitions
you'll have to roll
your own, based on your C header files such as <sys/ioctl.h>.
! (There is a perl script called makelib that comes with the perl kit
which may help you in this.)
SCALAR will be read and/or written depending on the FUNCTION\*(--a pointer
to the string value of SCALAR will be passed as the third argument of
--- 880,889 ----
.fi
first to get the correct function definitions.
! If ioctl.ph doesn't exist or doesn't have the correct definitions
you'll have to roll
your own, based on your C header files such as <sys/ioctl.h>.
! (There is a perl script called h2ph that comes with the perl kit
which may help you in this.)
SCALAR will be read and/or written depending on the FUNCTION\*(--a pointer
to the string value of SCALAR will be passed as the third argument of
*** End of Patch 39 ***
More information about the Comp.sources.bugs
mailing list