lroot@jpl-devvax.JPL.NASA.GOV (The Superuser) (08/04/88)
System: perl version 2.0 Patch #: 12 Subject: patch 11 continued... Description: See patch 11. 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: Configure make depend make make test make install 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@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: 11 1c1 < #define PATCHLEVEL 11 --- > #define PATCHLEVEL 12 Index: perl.man.1 Prereq: 2.0.1.3 *** perl.man.1.old Wed Aug 3 22:55:56 1988 --- perl.man.1 Wed Aug 3 22:56:00 1988 *************** *** 1,7 **** .rn '' }` ! ''' $Header: perl.man.1,v 2.0.1.3 88/07/15 01:31:24 root Exp $ ''' ''' $Log: perl.man.1,v $ ''' Revision 2.0.1.3 88/07/15 01:31:24 root ''' patch9: random cleanup ''' --- 1,10 ---- .rn '' }` ! ''' $Header: perl.man.1,v 2.0.1.4 88/08/03 22:21:28 root Exp $ ''' ''' $Log: perl.man.1,v $ + ''' Revision 2.0.1.4 88/08/03 22:21:28 root + ''' patch11: random typos and clarifications + ''' ''' Revision 2.0.1.3 88/07/15 01:31:24 root ''' patch9: random cleanup ''' *************** *** 383,389 **** .fi .PP ! Any of these five constructs may server as an lvalue, that is, may be assigned to. (You may also use an assignment to one of these lvalues as an lvalue in certain contexts\*(--see s, tr and chop.) --- 386,392 ---- .fi .PP ! Any of these five constructs may serve as an lvalue, that is, may be assigned to. (You may also use an assignment to one of these lvalues as an lvalue in certain contexts\*(--see s, tr and chop.) *************** *** 437,443 **** String literals are delimited by either single or double quotes. They work much like shell quotes: double-quoted string literals are subject to backslash and variable ! substitution; single-quoted strings are not. The usual backslash rules apply for making characters such as newline, tab, etc. You can also embed newlines directly in your strings, i.e. they can end on a different line than they begin. --- 440,446 ---- String literals are delimited by either single or double quotes. They work much like shell quotes: double-quoted string literals are subject to backslash and variable ! substitution; single-quoted strings are not (except for \e\' and \e\e). The usual backslash rules apply for making characters such as newline, tab, etc. You can also embed newlines directly in your strings, i.e. they can end on a different line than they begin. *************** *** 906,918 **** .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 Concatenation of two strings. .Ip .= 8 ! The corresponding assignment operator. .Ip eq 8 String equality (== is numeric equality). For a mnemonic just think of \*(L"eq\*(R" as a string. --- 909,921 ---- .Ip ** 8 2 The exponentiation operator. .Ip **= 8 ! The exponentiation assignment operator. .Ip (\|) 8 3 The null list, used to initialize an array to null. .Ip . 8 Concatenation of two strings. .Ip .= 8 ! The concatenation assignment operator. .Ip eq 8 String equality (== is numeric equality). For a mnemonic just think of \*(L"eq\*(R" as a string. *************** *** 959,965 **** .fi .Ip x= 8 ! The corresponding assignment operator. .Ip .\|. 8 The range operator, which is bistable. Each .\|. operator maintains its own boolean state. --- 962,968 ---- .fi .Ip x= 8 ! The repetition assignment operator. .Ip .\|. 8 The range operator, which is bistable. Each .\|. operator maintains its own boolean state. *************** *** 967,973 **** Once the left operand is true, the range operator stays true until the right operand is true, AFTER which the range operator becomes false again. ! (It doesn't become false till the next time the range operator evaluated. It can become false on the same evaluation it became true, but it still returns true once.) The right operand is not evaluated while the operator is in the \*(L"false\*(R" state, --- 970,976 ---- Once the left operand is true, the range operator stays true until the right operand is true, AFTER which the range operator becomes false again. ! (It doesn't become false till the next time the range operator is evaluated. It can become false on the same evaluation it became true, but it still returns true once.) The right operand is not evaluated while the operator is in the \*(L"false\*(R" state, *************** *** 1447,1452 **** --- 1450,1456 ---- 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, can be omitted from the expression. .Ip "exec LIST" 8 6 If there is more than one argument in LIST, calls execvp() with the arguments in LIST. Index: perl.man.2 Prereq: 2.0.1.3 *** perl.man.2.old Wed Aug 3 22:56:14 1988 --- perl.man.2 Wed Aug 3 22:56:19 1988 *************** *** 1,7 **** ''' Beginning of part 2 ! ''' $Header: perl.man.2,v 2.0.1.3 88/07/15 01:31:36 root Exp $ ''' ''' $Log: perl.man.2,v $ ''' Revision 2.0.1.3 88/07/15 01:31:36 root ''' patch9: random cleanup ''' --- 1,10 ---- ''' Beginning of part 2 ! ''' $Header: perl.man.2,v 2.0.1.4 88/08/03 22:22:48 root Exp $ ''' ''' $Log: perl.man.2,v $ + ''' Revision 2.0.1.4 88/08/03 22:22:48 root + ''' patch11: random typos and clarifications + ''' ''' Revision 2.0.1.3 88/07/15 01:31:36 root ''' patch9: random cleanup ''' *************** *** 27,33 **** the .IR sed -to- perl translator easier. ! Use at your own risk. .Ip "hex(EXPR)" 8 2 Returns the decimal value of EXPR interpreted as an hex string. (To interpret strings that might start with 0 or 0x see oct().) --- 30,42 ---- the .IR sed -to- perl translator easier. ! I may change its semantics at any time, consistent with support for translated ! .I sed ! scripts. ! Using it to exit loops bypasses the loop exit code and can cause core dumps ! after a while. ! Use it at your own risk. ! Better yet, don't use it at all. .Ip "hex(EXPR)" 8 2 Returns the decimal value of EXPR interpreted as an hex string. (To interpret strings that might start with 0 or 0x see oct().) *************** *** 194,201 **** --- 203,214 ---- real filehandle wanted. If EXPR is omitted, the scalar variable of the same name as the FILEHANDLE contains the filename. + If the filename begins with \*(L"<\*(R" or nothing, the file is opened for + input. If the filename begins with \*(L">\*(R", the file is opened for output. If the filename begins with \*(L">>\*(R", the file is opened for appending. + (You can put a \'+\' in front of the \'>\' or \'<\' to indicate that you + want both read and write access to the file.) If the filename begins with \*(L"|\*(R", the filename is interpreted as a command to which output is to be piped, and if the filename ends with a \*(L"|\*(R", the filename is interpreted as command which pipes *************** *** 456,462 **** $_ = \'abc123xyz\'; s/\ed+/$&*2/e; # yields \*(L'abc246xyz\*(R' s/\ed+/sprintf("%5d",$&)/e; # yields \*(L'abc 246xyz\*(R' ! s/\ew/$& x 2/e; # yields \*(L'aabbcc 246xxyyzz\*(R' s/\|([^ \|]*\|) *\|([^ \|]*\|)\|/\|$2 $1/; # reverse 1st two fields --- 469,475 ---- $_ = \'abc123xyz\'; s/\ed+/$&*2/e; # yields \*(L'abc246xyz\*(R' s/\ed+/sprintf("%5d",$&)/e; # yields \*(L'abc 246xyz\*(R' ! s/\ew/$& x 2/eg; # yields \*(L'aabbcc 224466xxyyzz\*(R' s/\|([^ \|]*\|) *\|([^ \|]*\|)\|/\|$2 $1/; # reverse 1st two fields *************** *** 545,550 **** --- 558,565 ---- .Ip "split(/PATTERN/)" 8 .Ip "split" 8 Splits a string into an array of strings, and returns it. + (If not in an array context, returns the number of fields found and splits + into the @_ array.) If EXPR is omitted, splits the $_ string. If PATTERN is also omitted, splits on whitespace (/[\ \et\en]+/). Anything matching PATTERN is taken to be a delimiter separating the fields. Index: perl.y Prereq: 2.0.1.2 *** perl.y.old Wed Aug 3 22:56:30 1988 --- perl.y Wed Aug 3 22:56:32 1988 *************** *** 1,6 **** ! /* $Header: perl.y,v 2.0.1.2 88/07/12 17:23:41 root Exp $ * * $Log: perl.y,v $ * Revision 2.0.1.2 88/07/12 17:23:41 root * patch6: simplified grammar to prevent indigestion in some yaccs * --- 1,10 ---- ! /* $Header: perl.y,v 2.0.1.3 88/08/03 22:25:12 root Exp $ * * $Log: perl.y,v $ + * Revision 2.0.1.3 88/08/03 22:25:12 root + * patch11: deleted fossilized join syntax + * patch11: fixed join('a','b') + * * Revision 2.0.1.2 88/07/12 17:23:41 root * patch6: simplified grammar to prevent indigestion in some yaccs * *************** *** 623,637 **** { $$ = mod_match(O_MATCH, stab2arg(A_STAB,defstab), make_split(defstab,$3) ); } - | JOIN '(' WORD ',' expr ')' - { $$ = make_op(O_JOIN, 2, - $5, - stab2arg(A_STAB,aadd(stabent($3,TRUE))), - Nullarg,0); } | JOIN '(' sexpr ',' expr ')' { $$ = make_op(O_JOIN, 2, $3, ! make_list($5), Nullarg,2); } | SPRINTF '(' expr ')' { $$ = make_op(O_SPRINTF, 1, --- 627,636 ---- { $$ = mod_match(O_MATCH, stab2arg(A_STAB,defstab), make_split(defstab,$3) ); } | JOIN '(' sexpr ',' expr ')' { $$ = make_op(O_JOIN, 2, $3, ! listish(make_list($5)), Nullarg,2); } | SPRINTF '(' expr ')' { $$ = make_op(O_SPRINTF, 1, Index: perly.c Prereq: 2.0.1.4 *** perly.c.old Wed Aug 3 22:56:41 1988 --- perly.c Wed Aug 3 22:56:45 1988 *************** *** 1,6 **** ! char rcsid[] = "$Header: perly.c,v 2.0.1.4 88/07/15 01:34:03 root Exp $"; /* * $Log: perly.c,v $ * Revision 2.0.1.4 88/07/15 01:34:03 root * patch9: optimization of && and || to if and unless occasionally failed * --- 1,19 ---- ! char rcsid[] = "$Header: perly.c,v 2.0.1.5 88/08/03 22:34:43 root Exp $"; /* * $Log: perly.c,v $ + * Revision 2.0.1.5 88/08/03 22:34:43 root + * patch11: + * patch11: + * patch11: + * patch11: + * patch11: suidperl would only run scripts setuid to something other than root + * patch11: removed a spurious call to safemalloc() + * patch11: support for Sun compiler that can't cast double to unsigned long + * patch11: support for busted compilers that can't cast relational to double + * patch11: new multiple subscript feature didn't work right + * patch11: fixed join('a','b'); + * patch11: do $filename; got mixed up in the eval cache + * * Revision 2.0.1.4 88/07/15 01:34:03 root * patch9: optimization of && and || to if and unless occasionally failed * *************** *** 295,301 **** for (s = tokenbuf+2; !isspace(*s); s++) ; if (strnNE(s-4,"perl",4)) /* sanity check */ fatal("Not a perl script"); ! while (*s && isspace(*s)) s++; /* * #! arg must be what we saw above. They can invoke it by * mentioning suidperl explicitly, but they may not add any strange --- 308,314 ---- for (s = tokenbuf+2; !isspace(*s); s++) ; if (strnNE(s-4,"perl",4)) /* sanity check */ fatal("Not a perl script"); ! while (*s == ' ' || *s == '\t') s++; /* * #! arg must be what we saw above. They can invoke it by * mentioning suidperl explicitly, but they may not add any strange *************** *** 304,310 **** len = strlen(validarg); if (strEQ(validarg," PHOOEY ") || strnNE(s,validarg,len) || !isspace(s[len])) ! fatal("Arg must be \"%s\"\n",s); if (euid) { /* oops, we're not the setuid root perl */ fclose(rsfp); --- 317,323 ---- len = strlen(validarg); if (strEQ(validarg," PHOOEY ") || strnNE(s,validarg,len) || !isspace(s[len])) ! fatal("Args must match #! line"); if (euid) { /* oops, we're not the setuid root perl */ fclose(rsfp); *************** *** 320,331 **** #else setgid(statbuf.st_gid); #endif ! if (statbuf.st_mode & S_ISUID && statbuf.st_uid != euid) #ifdef SETEUID ! seteuid(statbuf.st_uid); /* all that for this */ #else ! setuid(statbuf.st_uid); #endif else if (uid) /* oops, mustn't run as root */ #ifdef SETEUID seteuid(uid); --- 333,346 ---- #else setgid(statbuf.st_gid); #endif ! if (statbuf.st_mode & S_ISUID) { ! if (statbuf.st_uid != euid) #ifdef SETEUID ! seteuid(statbuf.st_uid); /* all that for this */ #else ! setuid(statbuf.st_uid); #endif + } else if (uid) /* oops, mustn't run as root */ #ifdef SETEUID seteuid(uid); *************** *** 466,472 **** register STAB *stab; register ARG *arg; { ! register SPAT *spat = (SPAT *) safemalloc(sizeof (SPAT)); if (arg->arg_type != O_MATCH) { spat = (SPAT *) safemalloc(sizeof (SPAT)); --- 481,487 ---- register STAB *stab; register ARG *arg; { ! register SPAT *spat; if (arg->arg_type != O_MATCH) { spat = (SPAT *) safemalloc(sizeof (SPAT)); *************** *** 1204,1213 **** str_numset(str,str_gnum(s1) / value); break; case O_MODULO: ! tmplong = (unsigned long)str_gnum(s2); if (tmplong == 0L) fatal("Illegal modulus of constant zero"); ! str_numset(str,(double)(((unsigned long)str_gnum(s1)) % tmplong)); break; case O_ADD: value = str_gnum(s1); --- 1219,1228 ---- str_numset(str,str_gnum(s1) / value); break; case O_MODULO: ! tmplong = (long)str_gnum(s2); if (tmplong == 0L) fatal("Illegal modulus of constant zero"); ! str_numset(str,(double)(((long)str_gnum(s1)) % tmplong)); break; case O_ADD: value = str_gnum(s1); *************** *** 1220,1270 **** case O_LEFT_SHIFT: value = str_gnum(s1); i = (int)str_gnum(s2); ! str_numset(str,(double)(((unsigned long)value) << i)); break; case O_RIGHT_SHIFT: value = str_gnum(s1); i = (int)str_gnum(s2); ! str_numset(str,(double)(((unsigned long)value) >> i)); break; case O_LT: value = str_gnum(s1); ! str_numset(str,(double)(value < str_gnum(s2))); break; case O_GT: value = str_gnum(s1); ! str_numset(str,(double)(value > str_gnum(s2))); break; case O_LE: value = str_gnum(s1); ! str_numset(str,(double)(value <= str_gnum(s2))); break; case O_GE: value = str_gnum(s1); ! str_numset(str,(double)(value >= str_gnum(s2))); break; case O_EQ: value = str_gnum(s1); ! str_numset(str,(double)(value == str_gnum(s2))); break; case O_NE: value = str_gnum(s1); ! str_numset(str,(double)(value != str_gnum(s2))); break; case O_BIT_AND: value = str_gnum(s1); ! str_numset(str,(double)(((unsigned long)value) & ! ((unsigned long)str_gnum(s2)))); break; case O_XOR: value = str_gnum(s1); ! str_numset(str,(double)(((unsigned long)value) ^ ! ((unsigned long)str_gnum(s2)))); break; case O_BIT_OR: value = str_gnum(s1); ! str_numset(str,(double)(((unsigned long)value) | ! ((unsigned long)str_gnum(s2)))); break; case O_AND: if (str_true(s1)) --- 1235,1282 ---- case O_LEFT_SHIFT: value = str_gnum(s1); i = (int)str_gnum(s2); ! str_numset(str,(double)(((long)value) << i)); break; case O_RIGHT_SHIFT: value = str_gnum(s1); i = (int)str_gnum(s2); ! str_numset(str,(double)(((long)value) >> i)); break; case O_LT: value = str_gnum(s1); ! str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0); break; case O_GT: value = str_gnum(s1); ! str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0); break; case O_LE: value = str_gnum(s1); ! str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0); break; case O_GE: value = str_gnum(s1); ! str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0); break; case O_EQ: value = str_gnum(s1); ! str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0); break; case O_NE: value = str_gnum(s1); ! str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0); break; case O_BIT_AND: value = str_gnum(s1); ! str_numset(str,(double)(((long)value) & ((long)str_gnum(s2)))); break; case O_XOR: value = str_gnum(s1); ! str_numset(str,(double)(((long)value) ^ ((long)str_gnum(s2)))); break; case O_BIT_OR: value = str_gnum(s1); ! str_numset(str,(double)(((long)value) | ((long)str_gnum(s2)))); break; case O_AND: if (str_true(s1)) *************** *** 1526,1532 **** arg = listish(arg); arg = make_op(O_JOIN, 2, stab2arg(A_STAB,stabent(";",TRUE)), ! arg, Nullarg, 0); } return arg; --- 1538,1544 ---- arg = listish(arg); arg = make_op(O_JOIN, 2, stab2arg(A_STAB,stabent(";",TRUE)), ! make_list(arg), Nullarg, 0); } return arg; *************** *** 1547,1553 **** arg->arg_type = O_LIST; } if (arg->arg_type != O_COMMA) { ! arg->arg_flags |= AF_LISTISH; /* see listish() below */ return arg; } for (i = 2, node = arg; ; i++) { --- 1559,1566 ---- arg->arg_type = O_LIST; } if (arg->arg_type != O_COMMA) { ! if (arg->arg_type != O_ARRAY) ! arg->arg_flags |= AF_LISTISH; /* see listish() below */ return arg; } for (i = 2, node = arg; ; i++) { *************** *** 1828,1833 **** --- 1841,1851 ---- str_cat(linestr,";"); /* be kind to them */ } else { + if (last_root) { + safefree(last_eval); + cmd_free(last_root); + last_root = Nullcmd; + } filename = savestr(str_get(str)); /* can't free this easily */ str_set(linestr,""); rsfp = fopen(filename,"r"); *************** *** 1857,1863 **** last_root = Nullcmd; } else { ! if (last_root && *bufptr == *last_eval && strEQ(bufptr,last_eval)) { retval = 0; eval_root = last_root; /* no point in reparsing */ } --- 1875,1883 ---- last_root = Nullcmd; } else { ! if (rsfp) ! retval = yyparse(); ! else if (last_root && *bufptr == *last_eval && strEQ(bufptr,last_eval)){ retval = 0; eval_root = last_root; /* no point in reparsing */ } Index: regexp.c Prereq: 2.0.1.3 *** regexp.c.old Wed Aug 3 22:56:58 1988 --- regexp.c Wed Aug 3 22:57:01 1988 *************** *** 7,15 **** * blame Henry for some of the lack of readability. */ ! /* $Header: regexp.c,v 2.0.1.3 88/07/15 18:10:47 root Exp $ * * $Log: regexp.c,v $ * Revision 2.0.1.3 88/07/15 18:10:47 root * patch9: finally nailed The Bug * patch9: UTS can't cast char to double --- 7,20 ---- * blame Henry for some of the lack of readability. */ ! /* $Header: regexp.c,v 2.0.1.4 88/08/03 22:37:26 root Exp $ * * $Log: regexp.c,v $ + * Revision 2.0.1.4 88/08/03 22:37:26 root + * patch11: deleted regchar() + * patch11: fixed some pointer arithmetic that didn't work on the 286 + * patch11: fixed $+ to work as documented + * * Revision 2.0.1.3 88/07/15 18:10:47 root * patch9: finally nailed The Bug * patch9: UTS can't cast char to double *************** *** 248,254 **** STATIC char *regpiece(); STATIC char *regatom(); STATIC char *regclass(); - STATIC char *regchar(); STATIC char *regnode(); STATIC char *regnext(); STATIC void regc(); --- 253,258 ---- *************** *** 600,607 **** return(ret); } - static int foo; - /* - regatom - the lowest level * --- 604,609 ---- *************** *** 1039,1060 **** } #endif /* NOTDEF */ - static char * - regchar(ch,flagp) - int ch; - int *flagp; - { - char *ret; - - ret = regnode(EXACTLY); - regc(1); - regc(ch); - regc('\0'); - regparse++; - *flagp |= HASWIDTH|SIMPLE; - return ret; - } - /* - regnode - emit a node */ --- 1041,1046 ---- *************** *** 1437,1447 **** if (prog->subbase) safefree(prog->subbase); prog->subbase = s; - tmp = prog->subbase - string; for (i = 0; i <= prog->nparens; i++) { if (prog->endp[i]) { ! prog->startp[i] += tmp; ! prog->endp[i] += tmp; } } if (prog->do_folding) { --- 1423,1432 ---- if (prog->subbase) safefree(prog->subbase); prog->subbase = s; for (i = 0; i <= prog->nparens; i++) { if (prog->endp[i]) { ! prog->startp[i] = s + (prog->startp[i] - string); ! prog->endp[i] = s + (prog->endp[i] - string); } } if (prog->do_folding) { *************** *** 1473,1478 **** --- 1458,1464 ---- regstartp = prog->startp; regendp = prog->endp; reglastparen = &prog->lastparen; + prog->lastparen = 0; sp = prog->startp; ep = prog->endp; *************** *** 1720,1726 **** */ if (regendp[n] == NULL) { regendp[n] = locinput; ! *reglastparen = n; } return(1); } else --- 1706,1713 ---- */ if (regendp[n] == NULL) { regendp[n] = locinput; ! if (n > *reglastparen) ! *reglastparen = n; } return(1); } else Index: stab.c Prereq: 2.0.1.3 *** stab.c.old Wed Aug 3 22:57:09 1988 --- stab.c Wed Aug 3 22:57:10 1988 *************** *** 1,6 **** ! /* $Header: stab.c,v 2.0.1.3 88/07/13 11:21:39 root Exp $ * * $Log: stab.c,v $ * Revision 2.0.1.3 88/07/13 11:21:39 root * patch7: botched signal ifdefs * --- 1,9 ---- ! /* $Header: stab.c,v 2.0.1.4 88/08/03 22:38:51 root Exp $ * * $Log: stab.c,v $ + * Revision 2.0.1.4 88/08/03 22:38:51 root + * patch11: added sanity check on $- going negative + * * Revision 2.0.1.3 88/07/13 11:21:39 root * patch7: botched signal ifdefs * *************** *** 270,275 **** --- 273,280 ---- break; case '-': curoutstab->stab_io->lines_left = (long)str_gnum(str); + if (curoutstab->stab_io->lines_left < 0L) + curoutstab->stab_io->lines_left = 0L; break; case '%': curoutstab->stab_io->page = (long)str_gnum(str); Index: str.c Prereq: 2.0.1.2 *** str.c.old Wed Aug 3 22:57:15 1988 --- str.c Wed Aug 3 22:57:16 1988 *************** *** 1,6 **** ! /* $Header: str.c,v 2.0.1.2 88/07/15 01:34:52 root Exp $ * * $Log: str.c,v $ * Revision 2.0.1.2 88/07/15 01:34:52 root * patch9: reset 'E' didn't wipe out the environment * --- 1,9 ---- ! /* $Header: str.c,v 2.0.1.3 88/08/03 22:39:56 root Exp $ * * $Log: str.c,v $ + * Revision 2.0.1.3 88/08/03 22:39:56 root + * patch11: support for incompetent compilers that can't parse str_get macro + * * Revision 2.0.1.2 88/07/15 01:34:52 root * patch9: reset 'E' didn't wipe out the environment * *************** *** 16,21 **** --- 19,33 ---- #include "perl.h" extern char **environ; + + #ifndef str_get + char * + str_get(str) + STR *str; + { + return str->str_pok ? str->str_ptr : str_2ptr(str); + } + #endif str_reset(s) register char *s; Index: str.h Prereq: 2.0 *** str.h.old Wed Aug 3 22:57:19 1988 --- str.h Wed Aug 3 22:57:20 1988 *************** *** 1,6 **** ! /* $Header: str.h,v 2.0 88/06/05 00:11:11 root Exp $ * * $Log: str.h,v $ * Revision 2.0 88/06/05 00:11:11 root * Baseline version 2.0. * --- 1,9 ---- ! /* $Header: str.h,v 2.0.1.1 88/08/03 22:43:53 root Exp $ * * $Log: str.h,v $ + * Revision 2.0.1.1 88/08/03 22:43:53 root + * patch11: support for botched C compilers that ungrok && outside of conditionals + * * Revision 2.0 88/06/05 00:11:11 root * Baseline version 2.0. * *************** *** 25,31 **** /* the following macro updates any magic values this str is associated with */ ! #define STABSET(x) (x->str_link.str_magic && stabset(x->str_link.str_magic,x)) EXT STR **tmps_list; EXT int tmps_max INIT(-1); --- 28,36 ---- /* the following macro updates any magic values this str is associated with */ ! #define STABSET(x) \ ! if ((x)->str_link.str_magic) \ ! stabset((x)->str_link.str_magic,(x)) EXT STR **tmps_list; EXT int tmps_max INIT(-1); Index: toke.c Prereq: 2.0.1.3 *** toke.c.old Wed Aug 3 22:57:41 1988 --- toke.c Wed Aug 3 22:57:43 1988 *************** *** 1,6 **** ! /* $Header: toke.c,v 2.0.1.3 88/07/12 17:37:19 root Exp $ * * $Log: toke.c,v $ * Revision 2.0.1.3 88/07/12 17:37:19 root * patch6: support for simplified yacc grammar * --- 1,9 ---- ! /* $Header: toke.c,v 2.0.1.4 88/08/03 22:47:39 root Exp $ * * $Log: toke.c,v $ + * Revision 2.0.1.4 88/08/03 22:47:39 root + * patch11: unterminated literal strings blew up tokener in eval + * * Revision 2.0.1.3 88/07/12 17:37:19 root * patch6: support for simplified yacc grammar * *************** *** 1161,1168 **** tmpstr = str_new(strlen(s)); s = str_append_till(tmpstr,s+1,term,leave); while (!*s) { /* multiple line string? */ ! s = str_gets(linestr, rsfp); ! if (!s) { line = sqstart; fatal("EOF in string"); } --- 1164,1170 ---- tmpstr = str_new(strlen(s)); s = str_append_till(tmpstr,s+1,term,leave); while (!*s) { /* multiple line string? */ ! if (!rsfp || !(s = str_gets(linestr, rsfp))) { line = sqstart; fatal("EOF in string"); } Index: util.c Prereq: 2.0.1.2 *** util.c.old Wed Aug 3 22:57:48 1988 --- util.c Wed Aug 3 22:57:49 1988 *************** *** 1,6 **** ! /* $Header: util.c,v 2.0.1.2 88/07/15 01:36:46 root Exp $ * * $Log: util.c,v $ * Revision 2.0.1.2 88/07/15 01:36:46 root * patch9: passing null value to setenv() now destroys environment variable * --- 1,9 ---- ! /* $Header: util.c,v 2.0.1.3 88/08/03 22:48:34 root Exp $ * * $Log: util.c,v $ + * Revision 2.0.1.3 88/08/03 22:48:34 root + * patch11: fiddled with declarations to keep some compilers happy + * * Revision 2.0.1.2 88/07/15 01:36:46 root * patch9: passing null value to setenv() now destroys environment variable * *************** *** 335,341 **** register char *olds; register char *oldlittle; register int min; - char *screaminstr(); if (littlestr->str_pok != 3) return instr(big,littlestr->str_ptr); --- 338,343 ---- *************** *** 440,445 **** --- 442,448 ---- /*VARARGS1*/ mess(pat,a1,a2,a3,a4) char *pat; + long a1, a2, a3, a4; { char *s; *************** *** 467,472 **** --- 470,476 ---- /*VARARGS1*/ fatal(pat,a1,a2,a3,a4) char *pat; + long a1, a2, a3, a4; { extern FILE *e_fp; extern char *e_tmpname; *************** *** 487,492 **** --- 491,497 ---- /*VARARGS1*/ warn(pat,a1,a2,a3,a4) char *pat; + long a1, a2, a3, a4; { mess(pat,a1,a2,a3,a4); fputs(buf,stderr); Index: x2p/walk.c Prereq: 2.0.1.2 *** x2p/walk.c.old Wed Aug 3 22:58:07 1988 --- x2p/walk.c Wed Aug 3 22:58:10 1988 *************** *** 1,6 **** ! /* $Header: walk.c,v 2.0.1.2 88/07/15 01:39:36 root Exp $ * * $Log: walk.c,v $ * Revision 2.0.1.2 88/07/15 01:39:36 root * patch9: gcc complained about "\$", so it's now "\\$" * --- 1,12 ---- ! /* $Header: walk.c,v 2.0.1.3 88/08/03 22:54:39 root Exp $ * * $Log: walk.c,v $ + * Revision 2.0.1.3 88/08/03 22:54:39 root + * patch11: a2p was being really stupid about comparisons with literal strings + * patch11: a2p tried to make a local declaration on a null argument list + * patch11: fixed possible null pointer dereference + * patch11: comma didn't allow newline after it + * * Revision 2.0.1.2 88/07/15 01:39:36 root * patch9: gcc complained about "\$", so it's now "\\$" * *************** *** 345,351 **** tmpstr = walk(0,level,ops[node+1].ival,&numarg); tmp2str = walk(1,level,ops[node+3].ival,&numarg); numeric |= numarg; ! if (!numeric) { t = tmpstr->str_ptr; if (strEQ(t,"==")) str_set(tmpstr,"eq"); --- 351,358 ---- tmpstr = walk(0,level,ops[node+1].ival,&numarg); tmp2str = walk(1,level,ops[node+3].ival,&numarg); numeric |= numarg; ! if (!numeric || ! (!numarg && (*tmp2str->str_cur == '"' || *tmp2str->str_cur == '\''))) { t = tmpstr->str_ptr; if (strEQ(t,"==")) str_set(tmpstr,"eq"); *************** *** 717,726 **** str_scat(str,tmpstr=walk(1,level,ops[node+1].ival,&numarg)); str_cat(str," {\n"); tab(str,++level); ! str_cat(str,"local("); ! str_scat(str,fstr); str_free(fstr); - str_cat(str,") = @_;"); str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg)); str_free(fstr); fixtab(str,level); --- 724,735 ---- str_scat(str,tmpstr=walk(1,level,ops[node+1].ival,&numarg)); str_cat(str," {\n"); tab(str,++level); ! if (fstr->str_cur) { ! str_cat(str,"local("); ! str_scat(str,fstr); ! str_cat(str,") = @_;"); ! } str_free(fstr); str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg)); str_free(fstr); fixtab(str,level); *************** *** 761,767 **** str_free(fstr); str_cat(str,"("); tmpstr = hfetch(symtab,str->str_ptr+3); ! if (tmpstr) numeric |= atoi(tmpstr->str_ptr); str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); str_free(fstr); --- 770,776 ---- str_free(fstr); str_cat(str,"("); tmpstr = hfetch(symtab,str->str_ptr+3); ! if (tmpstr && tmpstr->str_ptr) numeric |= atoi(tmpstr->str_ptr); str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); str_free(fstr); *************** *** 1014,1019 **** --- 1023,1030 ---- str_cat(str,", "); str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg)); str_free(fstr); + str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg)); + str_free(fstr); break; case OSEMICOLON: str = str_new(1); *************** *** 1776,1782 **** str_free(tmpstr); str_cat(tmp2str,"("); tmpstr = hfetch(symtab,tmp2str->str_ptr); ! if (tmpstr) numeric |= atoi(tmpstr->str_ptr); prewalk(0,level,ops[node+2].ival,&numarg); str_free(tmp2str); --- 1787,1793 ---- str_free(tmpstr); str_cat(tmp2str,"("); tmpstr = hfetch(symtab,tmp2str->str_ptr); ! if (tmpstr && tmpstr->str_ptr) numeric |= atoi(tmpstr->str_ptr); prewalk(0,level,ops[node+2].ival,&numarg); str_free(tmp2str); *************** *** 1827,1832 **** --- 1838,1844 ---- case OCOMMA: prewalk(0,level,ops[node+1].ival,&numarg); prewalk(0,level,ops[node+2].ival,&numarg); + prewalk(0,level,ops[node+3].ival,&numarg); break; case OSEMICOLON: break;