perl 2.0 patch #2
The Superuser
lroot at devvax.JPL.NASA.GOV
Wed Jul 13 10:54:13 AEST 1988
System: perl version 2.0
Patch #: 2
Priority: MEDIUM
Subject: Configure now checks for MANIFEST files
Subject: second search in s/// could malf if $<digit> or $& in use
Subject: removed length restriction on inplace edit filename
Subject: added ATAN2, SIN, COS, RAND, SRAND, POW and RETURN
Subject: $& not set right due to optimization (also added $` and $')
Subject: fixed list-in-list bug
Subject: removed size restriction on glob pattern
Subject: no longer blows yacc stack on long LISTs (made ',' left associative)
Subject: doubled possible size of error message
Subject: fixed bogus copy into string space
Subject: kludged in a join around multiple subscripts, just like awk
Subject: portabilized some structure copies in make_list()
Subject: put 1-deep cache of last expression eval'ed to save reparse on s///e
Subject: eval no longer needs trailing ;
Subject: LIB/*.pl in "do" may now be > 256 chars
Subject: added Hokey's workaround for 68000 addlepation
Subject: changed some savestr's to avoid recalculating length when we know it
Subject: fixed core dumper in regexp dumper
Subject: maximum length of groups list can now exceed 256 chars
Subject: increased maximum error message size from 256 to 1024
Subject: upgraded a2p to support translation of 1985 awk
Subject: a2p now fixes any perl reserved words it finds
Subject: a2p now checks for overflow of ops storage area
Subject: s2p didn't put a proper prologue on output script
Subject: a2p handles multiple opens to same file better
Subject: a2p now handles absence of line actions
Subject: a2p now takes advantage of perl's filehandle indirection
Subject: a2p uses keys() instead of each() to protect against deletes in loop
Description:
Almost all of these changes relate to the upgrade of a2p from
translating 1977 awk to translating 1985 awk, and the additions
to perl to support some of the functions of 1985 awk.
In addition, Configure now checks to see that all files listed in
MANIFEST exist, and exits if not. Many arbitrary restrictions
on length were relaxed. The string passed to eval no longer
needs to have the trailing semicolon--it will be added if missing.
Various bugs were also fixed. Among these, a global substitution
could fail if $& was used and certain patterns were in use, due
to forgetting where the end of the string to match was. Certain
optimizations of patterns caused $& not to get set properly because
they bypassed the search routines.
Last but not least, there is a workaround for certain machines
that dump core when trying to run TEST due to a code generation
error (or possibly a buggy chip error).
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--apply patch 3 as a continuation of this one
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 2.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.8.43).
Index: patchlevel.h
Prereq: 1
1c1
< #define PATCHLEVEL 1
---
> #define PATCHLEVEL 2
Index: Configure
Prereq: 2.0.1.1
*** Configure.old Mon Jul 11 23:36:15 1988
--- Configure Mon Jul 11 23:36:17 1988
***************
*** 8,14 ****
# and edit it to reflect your system. Some packages may include samples
# of config.h for certain machines, so you might look for one of those.)
#
! # $Header: Configure,v 2.0.1.1 88/06/28 16:24:02 root Exp $
#
# Yes, you may rip this off to use in other distribution packages.
# (Note: this Configure script was generated automatically. Rather than
--- 8,14 ----
# and edit it to reflect your system. Some packages may include samples
# of config.h for certain machines, so you might look for one of those.)
#
! # $Header: Configure,v 2.0.1.2 88/07/11 22:16:34 root Exp $
#
# Yes, you may rip this off to use in other distribution packages.
# (Note: this Configure script was generated automatically. Rather than
***************
*** 115,120 ****
--- 115,121 ----
n=''
c=''
package=''
+ randbits=''
spitshell=''
shsharp=''
sharpbang=''
***************
*** 149,154 ****
--- 150,159 ----
eunicefix=/etc/unixtovms.exe
fi
+ : Now test for existence of everything in MANIFEST
+
+ (cd ..; cat `awk 'NR>4{print $1}' MANIFEST` >/dev/null || kill $$)
+
attrlist="mc68000 sun gcos unix ibm gimpel interdata tss os mert pyr"
attrlist="$attrlist vax pdp11 i8086 z8000 u3b2 u3b5 u3b20 u3b200"
attrlist="$attrlist ns32000 ns16000 iAPX286 mc300 mc500 mc700 sparc"
***************
*** 1154,1159 ****
--- 1159,1203 ----
. myread
privlib=`filexp $ans`
+ : check for size of random number generator
+ echo " "
+ case "$randbits" in
+ '')
+ echo "Checking to see how many bits your rand function produces..."
+ $cat >try.c <<'EOCP'
+ #include <stdio.h>
+ main()
+ {
+ register int i;
+ register unsigned long tmp;
+ register unsigned long max;
+
+ for (i=1000; i; i--) {
+ tmp = (unsigned long)rand();
+ if (tmp > max) max = tmp;
+ }
+ for (i=0; max; i++)
+ max /= 2;
+ printf("%d\n",i);
+ }
+ EOCP
+ if cc try.c -o try >/dev/null 2>&1 ; then
+ dflt=`try`
+ else
+ dflt='?'
+ echo "(I can't seem to compile the test program...)"
+ fi
+ ;;
+ *)
+ dflt="$randbits"
+ ;;
+ esac
+ rp="How many bits does your rand() function produce? [$dflt]"
+ $echo $n "$rp $c"
+ . myread
+ randbits="$ans"
+ $rm -f try.c try
+
: see what type of char stdio uses.
echo " "
if $contains 'unsigned.*char.*_ptr;' /usr/include/stdio.h >/dev/null 2>&1 ; then
***************
*** 1672,1677 ****
--- 1716,1722 ----
n='$n'
c='$c'
package='$package'
+ randbits='$randbits'
spitshell='$spitshell'
shsharp='$shsharp'
sharpbang='$sharpbang'
Index: Makefile.SH
Prereq: 2.0.1.1
*** Makefile.SH.old Mon Jul 11 23:36:27 1988
--- Makefile.SH Mon Jul 11 23:36:29 1988
***************
*** 25,33 ****
echo "Extracting Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 2.0.1.1 88/06/28 16:26:04 root Exp $
#
# $Log: Makefile.SH,v $
# Revision 2.0.1.1 88/06/28 16:26:04 root
# patch1: support for DOSUID
# patch1: realclean now knows about ~ extension
--- 25,37 ----
echo "Extracting Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 2.0.1.2 88/07/11 22:19:00 root Exp $
#
# $Log: Makefile.SH,v $
+ # Revision 2.0.1.2 88/07/11 22:19:00 root
+ # patch2: forced DOSUID if IAMSUID
+ # patch2: now we expect 39 shift/reduce errors
+ #
# Revision 2.0.1.1 88/06/28 16:26:04 root
# patch1: support for DOSUID
# patch1: realclean now knows about ~ extension
***************
*** 108,114 ****
sperly.o: perly.c
/bin/rm -f sperly.c
ln perly.c sperly.c
! $(CC) -c -DIAMSUID $(CFLAGS) $(LARGE) sperly.c
/bin/rm -f sperly.c
!NO!SUBS!
;;
--- 112,118 ----
sperly.o: perly.c
/bin/rm -f sperly.c
ln perly.c sperly.c
! $(CC) -c -DIAMSUID -DDOSUID $(CFLAGS) $(LARGE) sperly.c
/bin/rm -f sperly.c
!NO!SUBS!
;;
***************
*** 117,123 ****
cat >>Makefile <<'!NO!SUBS!'
perl.c perly.h: perl.y
! @ echo Expect 37 shift/reduce errors...
yacc -d perl.y
mv y.tab.c perl.c
mv y.tab.h perly.h
--- 121,127 ----
cat >>Makefile <<'!NO!SUBS!'
perl.c perly.h: perl.y
! @ echo Expect 39 shift/reduce errors...
yacc -d perl.y
mv y.tab.c perl.c
mv y.tab.h perly.h
Index: arg.c
Prereq: 2.0
*** arg.c.old Mon Jul 11 23:36:39 1988
--- arg.c Mon Jul 11 23:36:41 1988
***************
*** 1,6 ****
! /* $Header: arg.c,v 2.0 88/06/05 00:08:04 root Exp $
*
* $Log: arg.c,v $
* Revision 2.0 88/06/05 00:08:04 root
* Baseline version 2.0.
*
--- 1,11 ----
! /* $Header: arg.c,v 2.0.1.1 88/07/11 22:24:19 root Exp $
*
* $Log: arg.c,v $
+ * Revision 2.0.1.1 88/07/11 22:24:19 root
+ * patch2: $& not set right due to optimization
+ * patch2: second search in s/// could malf if $<digit> or $& in use
+ * patch2: removed length restriction on inplace edit filename
+ *
* Revision 2.0 88/06/05 00:08:04 root
* Baseline version 2.0.
*
***************
*** 158,163 ****
--- 163,178 ----
yup:
++*(long*)&spat->spat_short->str_nval;
+ if (sawampersand) {
+ char *tmps;
+
+ tmps = spat->spat_regexp->subbase =
+ safemalloc((MEM_SIZE)(strend - t + 1));
+ bcopy(t, tmps, strend - t + 1);
+ tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
+ spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
+ curspat = spat;
+ }
return &str_yes;
nope:
***************
*** 241,251 ****
curspat = spat;
lastspat = spat;
do {
- m = spat->spat_regexp->startp[0];
if (iters++ > 10000)
fatal("Substitution loop");
! if (spat->spat_regexp->subbase)
s = spat->spat_regexp->subbase;
str_ncat(dstr,s,m-s);
s = spat->spat_regexp->endp[0];
str_scat(dstr,eval(spat->spat_repl,Null(STR***),-1));
--- 256,269 ----
curspat = spat;
lastspat = spat;
do {
if (iters++ > 10000)
fatal("Substitution loop");
! if (spat->spat_regexp->subbase) {
! m = s;
s = spat->spat_regexp->subbase;
+ strend = s + (strend - m);
+ }
+ m = spat->spat_regexp->startp[0];
str_ncat(dstr,s,m-s);
s = spat->spat_regexp->endp[0];
str_scat(dstr,eval(spat->spat_repl,Null(STR***),-1));
***************
*** 357,365 ****
else {
while (*s && regexec(spat->spat_regexp, s, strend, (iters == 0), 1,
Nullstr)) {
! m = spat->spat_regexp->startp[0];
! if (spat->spat_regexp->subbase)
s = spat->spat_regexp->subbase;
dstr = str_new(m-s);
str_nset(dstr,s,m-s);
astore(ary, iters++, dstr);
--- 375,386 ----
else {
while (*s && regexec(spat->spat_regexp, s, strend, (iters == 0), 1,
Nullstr)) {
! if (spat->spat_regexp->subbase) {
! m = s;
s = spat->spat_regexp->subbase;
+ strend = s + (strend - m);
+ }
+ m = spat->spat_regexp->startp[0];
dstr = str_new(m-s);
str_nset(dstr,s,m-s);
astore(ary, iters++, dstr);
***************
*** 613,621 ****
else {
UNLINK(oldname);
}
! sprintf(tokenbuf,">%s",oldname);
errno = 0; /* in case sprintf set errno */
! do_open(argvoutstab,tokenbuf);
defoutstab = argvoutstab;
#ifdef FCHMOD
fchmod(fileno(argvoutstab->stab_io->fp),filemode);
--- 634,644 ----
else {
UNLINK(oldname);
}
!
! str_nset(str,">",1);
! str_cat(str,oldname);
errno = 0; /* in case sprintf set errno */
! do_open(argvoutstab,str->str_ptr);
defoutstab = argvoutstab;
#ifdef FCHMOD
fchmod(fileno(argvoutstab->stab_io->fp),filemode);
***************
*** 1831,1834 ****
--- 1854,1864 ----
opargs[O_SORT] = A(1,0,0);
opargs[O_STUDY] = A(1,0,0);
opargs[O_DELETE] = A(1,0,0);
+ opargs[O_ATAN2] = A(1,1,0);
+ opargs[O_SIN] = A(1,0,0);
+ opargs[O_COS] = A(1,0,0);
+ opargs[O_RAND] = A(1,0,0);
+ opargs[O_SRAND] = A(1,0,0);
+ opargs[O_POW] = A(1,1,0);
+ opargs[O_RETURN] = A(1,0,0);
}
Index: arg.h
Prereq: 2.0
*** arg.h.old Mon Jul 11 23:36:52 1988
--- arg.h Mon Jul 11 23:36:53 1988
***************
*** 1,6 ****
! /* $Header: arg.h,v 2.0 88/06/05 00:08:14 root Exp $
*
* $Log: arg.h,v $
* Revision 2.0 88/06/05 00:08:14 root
* Baseline version 2.0.
*
--- 1,9 ----
! /* $Header: arg.h,v 2.0.1.1 88/07/11 22:25:55 root Exp $
*
* $Log: arg.h,v $
+ * Revision 2.0.1.1 88/07/11 22:25:55 root
+ * patch2: added ATAN2, SIN, COS, RAND, SRAND, POW and RETURN
+ *
* Revision 2.0 88/06/05 00:08:14 root
* Baseline version 2.0.
*
***************
*** 143,149 ****
#define O_SORT 134
#define O_DELETE 135
#define O_STUDY 136
! #define MAXO 137
#ifndef DOINIT
extern char *opname[];
--- 146,159 ----
#define O_SORT 134
#define O_DELETE 135
#define O_STUDY 136
! #define O_ATAN2 137
! #define O_SIN 138
! #define O_COS 139
! #define O_RAND 140
! #define O_SRAND 141
! #define O_POW 142
! #define O_RETURN 143
! #define MAXO 144
#ifndef DOINIT
extern char *opname[];
***************
*** 286,292 ****
"SORT",
"DELETE",
"STUDY",
! "135"
};
#endif
--- 296,309 ----
"SORT",
"DELETE",
"STUDY",
! "ATAN2",
! "SIN",
! "COS",
! "RAND",
! "SRAND",
! "POW",
! "RETURN",
! "144"
};
#endif
Index: cmd.c
Prereq: 2.0
*** cmd.c.old Mon Jul 11 23:36:58 1988
--- cmd.c Mon Jul 11 23:37:00 1988
***************
*** 1,6 ****
! /* $Header: cmd.c,v 2.0 88/06/05 00:08:24 root Exp $
*
* $Log: cmd.c,v $
* Revision 2.0 88/06/05 00:08:24 root
* Baseline version 2.0.
*
--- 1,9 ----
! /* $Header: cmd.c,v 2.0.1.1 88/07/11 22:27:13 root Exp $
*
* $Log: cmd.c,v $
+ * Revision 2.0.1.1 88/07/11 22:27:13 root
+ * patch2: $& not set right due to optimization (also added $` and $')
+ *
* Revision 2.0 88/06/05 00:08:24 root
* Baseline version 2.0.
*
***************
*** 236,241 ****
--- 239,255 ----
strnEQ(cmd->c_short->str_ptr, str_get(retstr),
cmd->c_slen) ) {
if (cmdflags & CF_EQSURE) {
+ if (sawampersand && cmd->c_slen < 30000) {
+ curspat = Nullspat;
+ if (leftstab)
+ str_nset(leftstab->stab_val,"",0);
+ if (amperstab)
+ str_sset(amperstab->stab_val,cmd->c_short);
+ if (rightstab)
+ str_nset(rightstab->stab_val,
+ retstr->str_ptr + cmd->c_slen,
+ retstr->str_cur - cmd->c_slen);
+ }
match = !(cmdflags & CF_FIRSTNEG);
retstr = &str_yes;
goto flipmaybe;
***************
*** 263,268 ****
--- 277,295 ----
if (tmps) {
if (cmdflags & CF_EQSURE) {
++*(long*)&cmd->c_short->str_nval;
+ if (sawampersand) {
+ curspat = Nullspat;
+ if (leftstab)
+ str_nset(leftstab->stab_val,retstr->str_ptr,
+ tmps - retstr->str_ptr);
+ if (amperstab)
+ str_sset(amperstab->stab_val,cmd->c_short);
+ if (rightstab)
+ str_nset(rightstab->stab_val,
+ tmps + cmd->c_short->str_cur,
+ retstr->str_cur - (tmps - retstr->str_ptr) -
+ cmd->c_short->str_cur);
+ }
match = !(cmdflags & CF_FIRSTNEG);
retstr = &str_yes;
goto flipmaybe;
Index: t/cmd.subval
Prereq: 2.0
*** t/cmd.subval.old Mon Jul 11 23:38:52 1988
--- t/cmd.subval Mon Jul 11 23:38:53 1988
***************
*** 1,6 ****
#!./perl
! # $Header: cmd.subval,v 2.0 88/06/05 00:12:26 root Exp $
sub foo1 {
'true1';
--- 1,6 ----
#!./perl
! # $Header: cmd.subval,v 2.0.1.1 88/07/11 23:08:24 root Exp $
sub foo1 {
'true1';
***************
*** 9,15 ****
sub foo2 {
'true1';
! if ($_[0]) { 'true2'; } else { 'true3'; }
}
sub foo3 {
--- 9,16 ----
sub foo2 {
'true1';
! if ($_[0]) { return 'true2'; } else { return 'true3'; }
! 'true0';
}
sub foo3 {
Index: config.h.SH
*** config.h.SH.old Mon Jul 11 23:37:06 1988
--- config.h.SH Mon Jul 11 23:37:09 1988
***************
*** 220,225 ****
--- 220,231 ----
*/
#define GIDTYPE $gidtype /**/
+ /* RANDBITS:
+ * This symbol contains the number of bits of random number the rand()
+ * function produces. Usual values are 15, 16, and 31.
+ */
+ #define RANDBITS $randbits /**/
+
/* STDCHAR:
* This symbol is defined to be the type of char used in stdio.h.
* It has the values "unsigned char" or "char".
Index: eval.c
Prereq: 2.0
*** eval.c.old Mon Jul 11 23:37:16 1988
--- eval.c Mon Jul 11 23:37:18 1988
***************
*** 1,6 ****
! /* $Header: eval.c,v 2.0 88/06/05 00:08:48 root Exp $
*
* $Log: eval.c,v $
* Revision 2.0 88/06/05 00:08:48 root
* Baseline version 2.0.
*
--- 1,11 ----
! /* $Header: eval.c,v 2.0.1.1 88/07/11 22:32:51 root Exp $
*
* $Log: eval.c,v $
+ * Revision 2.0.1.1 88/07/11 22:32:51 root
+ * patch2: added ATAN2, SIN, COS, RAND, SRAND and RETURN
+ * patch2: fixed list-in-list bug
+ * patch2: removed size restriction on glob pattern
+ *
* Revision 2.0 88/06/05 00:08:48 root
* Baseline version 2.0.
*
***************
*** 25,30 ****
--- 30,37 ----
ARG *debarg;
STR str_args;
+ double sin(), cos(), atan2(), pow();
+
STR *
eval(arg,retary,sargoff)
register ARG *arg;
***************
*** 118,123 ****
--- 125,131 ----
(maxsarg+2+cushion) * sizeof(STR*));
}
sarg += sargoff;
+ maxsarg -= sargoff;
}
else
sarg[anum] = eval(argptr.arg_arg, Null(STR***),-1);
***************
*** 262,279 ****
}
else if (argtype == A_GLOB) {
(void) interp(str,str_get(last_in_stab->stab_val));
! tmps = str->str_ptr;
if (*tmps == '!')
! sprintf(tokenbuf,"%s|",tmps+1);
else {
if (*tmps == ';')
! sprintf(tokenbuf, "%s", tmps+1);
else
! sprintf(tokenbuf, "echo %s", tmps);
! strcat(tokenbuf,
"|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
}
! do_open(last_in_stab,tokenbuf);
fp = last_in_stab->stab_io->fp;
}
}
--- 270,287 ----
}
else if (argtype == A_GLOB) {
(void) interp(str,str_get(last_in_stab->stab_val));
! tmpstr = str_new(0);
if (*tmps == '!')
! str_sset(tmpstr,str),str_cat(tmpstr,"|");
else {
if (*tmps == ';')
! str_set(tmpstr,str->str_ptr+1);
else
! str_set(tmpstr, "echo "), str_scat(tmpstr,str);
! str_cat(tmpstr,
"|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
}
! do_open(last_in_stab,tmpstr->str_ptr);
fp = last_in_stab->stab_io->fp;
}
}
***************
*** 425,430 ****
--- 433,442 ----
value = (double)do_study(str);
str = arg->arg_ptr.arg_str;
goto donumset;
+ case O_POW:
+ value = str_gnum(sarg[1]);
+ value = pow(value,str_gnum(sarg[2]));
+ goto donumset;
case O_MULTIPLY:
value = str_gnum(sarg[1]);
value *= str_gnum(sarg[2]);
***************
*** 875,882 ****
str = sarg[maxsarg]; /* unwanted list, return last item */
else
str = &str_no;
! if (retary)
goto array_return;
break;
case O_EOF:
if (maxarg <= 0)
--- 887,896 ----
str = sarg[maxsarg]; /* unwanted list, return last item */
else
str = &str_no;
! if (retary) {
! maxsarg += sargoff;
goto array_return;
+ }
break;
case O_EOF:
if (maxarg <= 0)
***************
*** 907,917 ****
--- 921,937 ----
(long)value, (int)str_gnum(sarg[3]) ) ? Yes : No);
STABSET(str);
break;
+ case O_RETURN:
+ tmps = "SUB"; /* just fake up a "last SUB" */
+ optype = O_LAST;
+ lastretstr = str_static(sarg[1]);
+ goto dopop;
case O_REDO:
case O_NEXT:
case O_LAST:
if (maxarg > 0) {
tmps = str_get(sarg[1]);
+ dopop:
while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
#ifdef DEBUGGING
***************
*** 987,992 ****
--- 1007,1043 ----
"The crypt() function is unimplemented due to excessive paranoia.");
#endif
break;
+ case O_ATAN2:
+ value = str_gnum(sarg[1]);
+ value = atan2(value,str_gnum(sarg[2]));
+ goto donumset;
+ case O_SIN:
+ value = sin(str_gnum(sarg[1]));
+ goto donumset;
+ case O_COS:
+ value = cos(str_gnum(sarg[1]));
+ goto donumset;
+ case O_RAND:
+ value = str_gnum(sarg[1]);
+ if (value == 0.0)
+ value = 1.0;
+ #if RANDBITS == 31
+ value = rand() * value / 2147483648.0;
+ #else
+ #if RANDBITS == 16
+ value = rand() * value / 65536.0;
+ #else
+ #if RANDBITS == 15
+ value = rand() * value / 32768.0;
+ #else
+ value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
+ #endif
+ #endif
+ #endif
+ goto donumset;
+ case O_SRAND:
+ value = (double)srand((int)str_gnum(sarg[1]));
+ goto donumset;
case O_EXP:
value = exp(str_gnum(sarg[1]));
goto donumset;
Index: t/op.list
Prereq: 2.0
*** t/op.list.old Mon Jul 11 23:39:00 1988
--- t/op.list Mon Jul 11 23:39:01 1988
***************
*** 1,8 ****
#!./perl
! # $Header: op.list,v 2.0 88/06/05 00:14:09 root Exp $
! print "1..18\n";
@foo = (1, 2, 3, 4);
if ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
--- 1,8 ----
#!./perl
! # $Header: op.list,v 2.0.1.1 88/07/11 23:08:42 root Exp $
! print "1..24\n";
@foo = (1, 2, 3, 4);
if ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
***************
*** 57,59 ****
--- 57,66 ----
@a = ($x == $x || (4,5,6));
if (join('', at a) eq '1') {print "ok 18\n";} else {print "not ok 18\n";}
+
+ if (join('',1,2,(3,4,5)) eq '12345'){print "ok 19\n";}else{print "not ok 19\n";}
+ if (join('',(1,2,3,4,5)) eq '12345'){print "ok 20\n";}else{print "not ok 20\n";}
+ if (join('',(1,2,3,4),5) eq '12345'){print "ok 21\n";}else{print "not ok 21\n";}
+ if (join('',1,(2,3,4),5) eq '12345'){print "ok 22\n";}else{print "not ok 22\n";}
+ if (join('',1,2,(3,4),5) eq '12345'){print "ok 23\n";}else{print "not ok 23\n";}
+ if (join('',1,2,3,(4),5) eq '12345'){print "ok 24\n";}else{print "not ok 24\n";}
Index: t/op.pat
Prereq: 2.0
*** t/op.pat.old Mon Jul 11 23:39:05 1988
--- t/op.pat Mon Jul 11 23:39:06 1988
***************
*** 1,8 ****
#!./perl
! # $Header: op.pat,v 2.0 88/06/05 00:14:20 root Exp $
! print "1..30\n";
$x = "abc\ndef\n";
--- 1,8 ----
#!./perl
! # $Header: op.pat,v 2.0.1.1 88/07/11 23:09:57 root Exp $
! print "1..33\n";
$x = "abc\ndef\n";
***************
*** 93,95 ****
--- 93,105 ----
'cde' =~ /$foo/;
'xyz' =~ /$null/;
if ($& eq 'xyz') {print "ok 30\n";} else {print "not ok 30\n";}
+
+ $_ = 'abcdefghi';
+ /def/; # optimized up to cmd
+ if ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 31\n";} else {print "not ok 31\n";}
+
+ /cde/ + 0; # optimized only to spat
+ if ("$`:$&:$'" eq 'ab:cde:fghi') {print "ok 32\n";} else {print "not ok 32\n";}
+
+ /[d][e][f]/; # not optimized
+ if ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 33\n";} else {print "not ok 33\n";}
Index: perl.h
Prereq: 2.0
*** perl.h.old Mon Jul 11 23:37:26 1988
--- perl.h Mon Jul 11 23:37:26 1988
***************
*** 1,6 ****
! /* $Header: perl.h,v 2.0 88/06/05 00:09:21 root Exp $
*
* $Log: perl.h,v $
* Revision 2.0 88/06/05 00:09:21 root
* Baseline version 2.0.
*
--- 1,9 ----
! /* $Header: perl.h,v 2.0.1.1 88/07/11 22:34:31 root Exp $
*
* $Log: perl.h,v $
+ * Revision 2.0.1.1 88/07/11 22:34:31 root
+ * patch2: added $`, $& and $'
+ *
* Revision 2.0 88/06/05 00:09:21 root
* Baseline version 2.0.
*
***************
*** 187,192 ****
--- 190,198 ----
EXT STAB *curoutstab INIT(Nullstab);
EXT STAB *argvoutstab INIT(Nullstab);
EXT STAB *incstab INIT(Nullstab);
+ EXT STAB *leftstab INIT(Nullstab);
+ EXT STAB *amperstab INIT(Nullstab);
+ EXT STAB *rightstab INIT(Nullstab);
EXT STR *freestrroot INIT(Nullstr);
EXT STR *lastretstr INIT(Nullstr);
Index: perl.man.1
Prereq: 2.0.1.1
*** perl.man.1.old Mon Jul 11 23:37:33 1988
--- perl.man.1 Mon Jul 11 23:37:36 1988
***************
*** 1,7 ****
.rn '' }`
! ''' $Header: perl.man.1,v 2.0.1.1 88/06/28 16:28:09 root Exp $
'''
''' $Log: perl.man.1,v $
''' Revision 2.0.1.1 88/06/28 16:28:09 root
''' patch1: fixed some quotes
''' patch1: clarified syntax of LIST
--- 1,11 ----
.rn '' }`
! ''' $Header: perl.man.1,v 2.0.1.2 88/07/11 22:36:49 root Exp $
'''
''' $Log: perl.man.1,v $
+ ''' Revision 2.0.1.2 88/07/11 22:36:49 root
+ ''' patch2: documented multidimensional array emulation
+ ''' patch2: documented **, cos and atan2
+ '''
''' Revision 2.0.1.1 88/06/28 16:28:09 root
''' patch1: fixed some quotes
''' patch1: clarified syntax of LIST
***************
*** 367,372 ****
--- 371,380 ----
.fi
.PP
+ Multi-dimensional arrays are not directly supported, but see the discussion
+ of the $; variable later for a means of emulating multiple subscripts with
+ an associative array.
+ .PP
Every data type has its own namespace.
You can, without fear of conflict, use the same name for a scalar variable,
an array, an associative array, a filehandle, a subroutine name, and/or
***************
*** 780,786 ****
}
.fi
! It's also nice for exiting subroutines early.
Note the double curly brackets:
.nf
--- 788,794 ----
}
.fi
! It also could be used to exit a subroutine early.
Note the double curly brackets:
.nf
***************
*** 795,800 ****
--- 803,810 ----
}}
.fi
+ Note, however, that there is a return statement that does the same thing
+ without the extra curly brackets.
.Sh "Simple statements"
The only kind of simple statement is an expression evaluated for its side
effects.
***************
*** 850,855 ****
--- 860,869 ----
Here's what
.I perl
has that C doesn't:
+ .Ip ** 8 2
+ The exponentiation operator.
+ .Ip **= 8
+ The corresponding assignment operator.
.Ip (\|) 8 3
The null list, used to initialize an array to null.
.Ip . 8
***************
*** 1103,1108 ****
--- 1117,1124 ----
operator.
This is a useful optimization when you only want to see the first occurence of
something in each file of a set of files, for instance.
+ .Ip "atan2(X,Y)" 8 2
+ Returns the arctangent of X/Y in the range -PI to PI.
.Ip "chdir EXPR" 8 2
Changes the working directory to EXPR, if possible.
Returns 1 upon success, 0 otherwise.
***************
*** 1140,1145 ****
--- 1156,1162 ----
.nf
chop($cwd = `pwd`);
+ chop($answer = <stdin>);
.fi
.Ip "chown LIST" 8 2
***************
*** 1204,1209 ****
--- 1221,1228 ----
.fi
FILEHANDLE may be an expression whose value gives the real filehandle name.
+ .Ip "cos(EXPR)" 8 6
+ Returns the cosine of EXPR (expressed in radians).
.Ip "crypt(PLAINTEXT,SALT)" 8 6
Encrypts a string exactly like the crypt() function in the C library.
Useful for checking the password file for lousy passwords.
Index: perl.man.2
Prereq: 2.0.1.1
*** perl.man.2.old Mon Jul 11 23:37:48 1988
--- perl.man.2 Mon Jul 11 23:37:51 1988
***************
*** 1,7 ****
''' Beginning of part 2
! ''' $Header: perl.man.2,v 2.0.1.1 88/06/28 16:31:49 root Exp $
'''
''' $Log: perl.man.2,v $
''' Revision 2.0.1.1 88/06/28 16:31:49 root
''' patch1: fixed some quotes
''' patch1: clarified semantics of study
--- 1,11 ----
''' Beginning of part 2
! ''' $Header: perl.man.2,v 2.0.1.2 88/07/11 22:41:50 root Exp $
'''
''' $Log: perl.man.2,v $
+ ''' Revision 2.0.1.2 88/07/11 22:41:50 root
+ ''' patch2: documented sin, rand, srand, return, $`, $', $; and s///e
+ ''' patch2: added awk variable equivalent table
+ '''
''' Revision 2.0.1.1 88/06/28 16:31:49 root
''' patch1: fixed some quotes
''' patch1: clarified semantics of study
***************
*** 324,329 ****
--- 328,339 ----
.fi
but is more efficient.
+ .Ip "rand EXPR" 8 8
+ .Ip "rand" 8
+ Returns a random fractional number between 0 and the value of EXPR.
+ (EXPR should be positive.)
+ If EXPR is omitted, returns a value between 0 and 1.
+ See also srand().
.Ip "redo LABEL" 8 8
.Ip "redo" 8
The
***************
*** 382,388 ****
.fi
Note: resetting "A-Z" is not recommended since you'll wipe out your ARGV and ENV
arrays.
! .Ip "s/PATTERN/REPLACEMENT/gi" 8 3
Searches a string for a pattern, and if found, replaces that pattern with the
replacement text and returns the number of substitutions made.
Otherwise it returns false (0).
--- 392,404 ----
.fi
Note: resetting "A-Z" is not recommended since you'll wipe out your ARGV and ENV
arrays.
! .Ip "return EXPR" 8 3
! Returns from a subroutine with the value specified.
! If no EXPR is given, returns with the value of $_.
! (Note that a subroutine can automatically return
! the value of the last expression evaluated.
! It's the preferred method\*(--use of an explicit return is a bit slower.)
! .Ip "s/PATTERN/REPLACEMENT/gie" 8 3
Searches a string for a pattern, and if found, replaces that pattern with the
replacement text and returns the number of substitutions made.
Otherwise it returns false (0).
***************
*** 390,397 ****
of the pattern are to be replaced.
The \*(L"i\*(R" is also optional, and if present, indicates that matching
is to be done in a case-insensitive manner.
Any delimiter may replace the slashes; if single quotes are used, no
! interpretation is done on the replacement string.
If no string is specified via the =~ or !~ operator,
the $_ string is searched and modified.
(The string specified with =~ must be a scalar variable, an array element,
--- 406,417 ----
of the pattern are to be replaced.
The \*(L"i\*(R" is also optional, and if present, indicates that matching
is to be done in a case-insensitive manner.
+ The \*(L"e\*(R" is likewise optional, and if present, indicates that
+ the replacement string is to be evaluated as an expression rather than just
+ as a double-quoted string.
Any delimiter may replace the slashes; if single quotes are used, no
! interpretation is done on the replacement string (the e modifier overrides
! this, however).
If no string is specified via the =~ or !~ operator,
the $_ string is searched and modified.
(The string specified with =~ must be a scalar variable, an array element,
***************
*** 409,418 ****
s/Login: $foo/Login: $bar/; # run-time pattern
- s/\|([^ \|]*\|) *\|([^ \|]*\|)\|/\|$2 $1/; # reverse 1st two fields
-
($foo = $bar) =~ s/bar/foo/;
.fi
(Note the use of $ instead of \|\e\| in the last example. See section
on regular expressions.)
--- 429,443 ----
s/Login: $foo/Login: $bar/; # run-time pattern
($foo = $bar) =~ s/bar/foo/;
+ $_ = 'abc123xyz';
+ s/\ed+/$&*2/e; # yields 'abc246xyz'
+ s/\ed+/sprintf("%5d",$&)/e; # yields 'abc 246xyz'
+ s/\w/$& x 2/e; # yields 'aabbcc 246xxyyzz'
+
+ s/\|([^ \|]*\|) *\|([^ \|]*\|)\|/\|$2 $1/; # reverse 1st two fields
+
.fi
(Note the use of $ instead of \|\e\| in the last example. See section
on regular expressions.)
***************
*** 453,458 ****
--- 478,485 ----
See also unshift(), push() and pop().
Shift() and unshift() do the same thing to the left end of an array that push()
and pop() do to the right end.
+ .Ip "sin(EXPR)" 8 6
+ Returns the sine of EXPR (expressed in radians).
.Ip "sleep EXPR" 8 6
.Ip "sleep" 8
Causes the script to sleep for EXPR seconds, or forever if no EXPR.
***************
*** 547,552 ****
--- 574,581 ----
The * character is not supported.
.Ip "sqrt(EXPR)" 8 3
Return the square root of EXPR.
+ .Ip "srand(EXPR)" 8 3
+ Sets the random number seed for the rand operator.
.Ip "stat(FILEHANDLE)" 8 6
.Ip "stat(EXPR)" 8
Returns a 13-element array giving the statistics for a file, either the file
***************
*** 772,778 ****
nonassoc\h'|1i'print printf exec system sort
\h'1.5i'chmod chown kill unlink utime
left\h'|1i',
! right\h'|1i'=
right\h'|1i'?:
nonassoc\h'|1i'..
left\h'|1i'||
--- 801,807 ----
nonassoc\h'|1i'print printf exec system sort
\h'1.5i'chmod chown kill unlink utime
left\h'|1i',
! right\h'|1i'= += -= *= etc.
right\h'|1i'?:
nonassoc\h'|1i'..
left\h'|1i'||
***************
*** 781,787 ****
left\h'|1i'&
nonassoc\h'|1i'== != eq ne
nonassoc\h'|1i'< > <= >= lt gt le ge
! nonassoc\h'|1i'chdir die exit eval reset sleep
nonassoc\h'|1i'-r -w -x etc.
left\h'|1i'<< >>
left\h'|1i'+ - .
--- 810,816 ----
left\h'|1i'&
nonassoc\h'|1i'== != eq ne
nonassoc\h'|1i'< > <= >= lt gt le ge
! nonassoc\h'|1i'chdir die exit eval reset sleep rand
nonassoc\h'|1i'-r -w -x etc.
left\h'|1i'<< >>
left\h'|1i'+ - .
***************
*** 788,793 ****
--- 817,823 ----
left\h'|1i'* / % x
left\h'|1i'=~ !~
right\h'|1i'! ~ and unary minus
+ right\h'|1i'**
nonassoc\h'|1i'++ --
left\h'|1i''('
***************
*** 817,822 ****
--- 847,854 ----
that is ($_[0], $_[1], .\|.\|.).
The return value of the subroutine is the value of the last expression
evaluated.
+ Alternately, a return statement may be used to specify the returned value and
+ exit the subroutine.
To create local variables see the \*(L"local\*(R" operator.
.PP
A subroutine is called using the
***************
*** 885,890 ****
--- 917,923 ----
You may use \ew, \es and \ed within character classes.
Also, \en, \er, \ef, \et and \eNNN have their normal interpretations.
Within character classes \eb represents backspace rather than a word boundary.
+ Alternatives may be separated by |.
The bracketing construct \|(\ .\|.\|.\ \|) may also be used, in which case \e<digit>
matches the digit'th substring, where digit can range from 1 to 9.
(Outside of patterns, use $ instead of \e in front of the digit.
***************
*** 893,899 ****
$+ returns whatever the last bracket match matched.
$& returns the entire matched string.
($0 normally returns the same thing, but don't depend on it.)
! Alternatives may be separated by |.
Examples:
.nf
--- 926,933 ----
$+ returns whatever the last bracket match matched.
$& returns the entire matched string.
($0 normally returns the same thing, but don't depend on it.)
! $` returns everything before the matched string.
! $' returns everything after the matched string.
Examples:
.nf
***************
*** 1166,1171 ****
--- 1200,1220 ----
.Ip $& 8 4
The string matched by the last pattern match.
(Mnemonic: like & in some editors.)
+ .Ip $` 8 4
+ The string preceding what was matched by the last pattern match.
+ (Mnemonic: ` often precedes a quoted string.)
+ .Ip $' 8 4
+ The string following what was matched by the last pattern match.
+ (Mnemonic: ' often follows a quoted string.)
+ Example:
+ .nf
+
+ .ne 3
+ $_ = 'abcdefghi';
+ /def/;
+ print "$`:$&:$'\n"; # prints abc:def:ghi
+
+ .fi
.Ip $+ 8 4
The last bracket matched by the last search pattern.
This is useful if you don't know which of a set of alternative patterns
***************
*** 1204,1209 ****
--- 1253,1273 ----
(or Fortran)
when subscripting and when evaluating the index() and substr() functions.
(Mnemonic: [ begins subscripts.)
+ .Ip $; 8 2
+ The subscript separator for multi-dimensional array emulation.
+ If you refer to an associative array element as
+ .nf
+ $foo{$a,$b,$c}
+
+ it really means
+
+ $foo{join($;, $a, $b, $c)}
+
+ .fi
+ Default is "\e034", the same as SUBSEP in awk.
+ (Mnemonic: comma (the syntactic subscript separator) is a semi-semicolon.
+ Yeah, I know, it's pretty lame, but $, is already taken for something more
+ important.)
.Ip $! 8 2
If used in a numeric context, yields the current value of errno, with all the
usual caveats.
***************
*** 1361,1368 ****
(The comma operator works as in C.)
.Ip * 4 2
The match operator is \*(L"=~\*(R", not \*(L"~\*(R".
! (\*(L"~\*(R" is the one's complement operator.)
.Ip * 4 2
The concatenation operator is \*(L".\*(R", not the null string.
(Using the null string would render \*(L"/pat/ /pat/\*(R" unparseable,
since the third slash would be interpreted as a division operator\*(--the
--- 1425,1435 ----
(The comma operator works as in C.)
.Ip * 4 2
The match operator is \*(L"=~\*(R", not \*(L"~\*(R".
! (\*(L"~\*(R" is the one's complement operator, as in C.)
.Ip * 4 2
+ The exponentiation operator is \*(L"**\*(R", not \*(L"^\*(R".
+ (\*(L"^\*(R" is the XOR operator, as in C.)
+ .Ip * 4 2
The concatenation operator is \*(L".\*(R", not the null string.
(Using the null string would render \*(L"/pat/ /pat/\*(R" unparseable,
since the third slash would be interpreted as a division operator\*(--the
***************
*** 1371,1376 ****
--- 1438,1464 ----
.Ip * 4 2
Next, exit, and continue work differently.
.Ip * 4 2
+ The following variables work differently
+ .nf
+
+ Awk \h'|2.5i'Perl
+ ARGC \h'|2.5i'$#ARGV
+ ARGV[0] \h'|2.5i'$0
+ FILENAME\h'|2.5i'$ARGV
+ FNR \h'|2.5i'$.
+ FS \h'|2.5i'(whatever you like)
+ NF \h'|2.5i'$#Fld, or some such
+ NR \h'|2.5i'$. sometimes
+ OFMT \h'|2.5i'$#
+ OFS \h'|2.5i'$,
+ ORS \h'|2.5i'$\e
+ RLENGTH \h'|2.5i'length($&)
+ RS \h'|2.5i'$/
+ RSTART \h'|2.5i'length($`)
+ SUBSEP \h'|2.5i'$;
+
+ .fi
+ .Ip * 4 2
When in doubt, run the awk construct through a2p and see what it gives you.
.PP
Cerebral C programmers should take note of the following:
***************
*** 1433,1438 ****
--- 1521,1534 ----
Perl is at the mercy of the C compiler's definitions of various operations
such as % and atof().
In particular, don't trust % on negative numbers.
+ .PP
+ While none of the built-in data types have any arbitrary size limits (apart
+ from memory size), there are still a few arbitrary limits:
+ a given token may not be longer than 255 characters;
+ sprintf is limited on many machines to 128 characters per field (unless the format
+ specifier is exactly %s);
+ block nesting depth is limited when tracing is turned on; and
+ no component of your PATH may be longer than 255 if you use -S.
.PP
.I Perl
actually stands for Pathologically Eclectic Rubbish Lister, but don't tell
More information about the Comp.sources.bugs
mailing list