From: Larry Wall Date: Mon, 8 Jun 1992 04:52:59 +0000 (+0000) Subject: perl 4.0 patch 31: patch #20, continued X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2b69d0c297460bce3a8d8eefe2bd0de0a6451872;p=p5sagit%2Fp5-mst-13.2.git perl 4.0 patch 31: patch #20, continued See patch #20. --- diff --git a/atarist/test/sig b/atarist/test/sig new file mode 100644 index 0000000..ac1b2b2 --- /dev/null +++ b/atarist/test/sig @@ -0,0 +1,12 @@ +sub handler { + local($sig) = @_; + print "Caught SIG$sig\n"; + exit(0); +} + +$SIG{'INT'} = 'handler'; + +print "Hit CRTL-C to see if it is trapped\n"; +while($_ = ) { + print $_; +} diff --git a/atarist/test/tbinmode b/atarist/test/tbinmode new file mode 100644 index 0000000..4cf4f78 --- /dev/null +++ b/atarist/test/tbinmode @@ -0,0 +1,12 @@ +open(FP, ">bintest") || die "Can't open bintest for write\n"; +binmode FP; +print FP pack("C*", 0xaa, 0x55, 0xaa, 0x55, + 0xff, 0x0d, 0x0a); +close FP; + +open(FP, "); +close FP; +printf "expect:\t7 elements: aa 55 aa 55 ff 0d 0a\n"; +printf "got:\t%d elements: %x %x %x %x %x %02x %02x\n", $#got+1-$[, @got; diff --git a/atarist/usersub.c b/atarist/usersub.c new file mode 100644 index 0000000..aba53d7 --- /dev/null +++ b/atarist/usersub.c @@ -0,0 +1,9 @@ +#include "EXTERN.h" +#include "perl.h" +#include + +int userinit() +{ + install_null(); /* install device /dev/null or NUL: */ + return 0; +} diff --git a/hints/sco_2_3_3.sh b/hints/sco_2_3_3.sh index d1db39f..10baafd 100644 --- a/hints/sco_2_3_3.sh +++ b/hints/sco_2_3_3.sh @@ -1,4 +1,3 @@ yacc='/usr/bin/yacc -Sm25000' -libswanted=`echo $libswanted | sed 's/ x / /'` echo "NOTE: you may have problems due to a spurious semicolon on the strerror()" echo "macro definition in /usr/include/string.h. If so, delete the semicolon." diff --git a/hints/sco_2_3_4.sh b/hints/sco_2_3_4.sh new file mode 100644 index 0000000..3a1b13c --- /dev/null +++ b/hints/sco_2_3_4.sh @@ -0,0 +1,5 @@ +yacc='/usr/bin/yacc -Sm25000' +ccflags="$ccflags -UM_I86" +d_mymalloc=define +echo "NOTE: you may have problems due to a spurious semicolon on the strerror()" +echo "macro definition in /usr/include/string.h. If so, delete the semicolon." diff --git a/hints/sgi.sh b/hints/sgi.sh index b7db156..4252aaf 100644 --- a/hints/sgi.sh +++ b/hints/sgi.sh @@ -1,6 +1,12 @@ optimize='-O1' -usemymalloc='y' +d_mymalloc=define mallocsrc='malloc.c' mallocobj='malloc.o' d_voidsig=define d_vfork=undef +d_charsprf=undef +case `(uname -r) 2>/dev/null` in +4*)libswanted=`echo $libswanted | sed 's/c_s \(.*\)/\1 c_s/'` + ccflags="$ccflags -DLANGUAGE_C -DBSD_SIGNALS -cckr -signed" + ;; +esac diff --git a/hints/ultrix_4.sh b/hints/ultrix_4.sh index 91e5d7d..633e904 100644 --- a/hints/ultrix_4.sh +++ b/hints/ultrix_4.sh @@ -18,5 +18,6 @@ case "$tmp" in toke_cflags='optimize="-g"' ttoke_cflags='optimize="-g"' ;; +*4.2*) libswanted=`echo $libswanted | sed 's/ malloc / /'` ;; esac diff --git a/hints/unisysdynix.sh b/hints/unisysdynix.sh new file mode 100644 index 0000000..4251ba8 --- /dev/null +++ b/hints/unisysdynix.sh @@ -0,0 +1 @@ +d_waitpid=undef diff --git a/lib/shellwords.pl b/lib/shellwords.pl index 168991f..5d593da 100644 --- a/lib/shellwords.pl +++ b/lib/shellwords.pl @@ -1,12 +1,12 @@ -#; shellwords.pl -#; -#; Usage: -#; require 'shellwords.pl'; -#; @words = &shellwords($line); -#; or -#; @words = &shellwords(@lines); -#; or -#; @words = &shellwords; # defaults to $_ (and clobbers it) +;# shellwords.pl +;# +;# Usage: +;# require 'shellwords.pl'; +;# @words = &shellwords($line); +;# or +;# @words = &shellwords(@lines); +;# or +;# @words = &shellwords; # defaults to $_ (and clobbers it) sub shellwords { package shellwords; @@ -17,12 +17,18 @@ sub shellwords { while ($_ ne '') { $field = ''; for (;;) { - if (s/^"(([^"\\]+|\\[\\"])*)"//) { + if (s/^"(([^"\\]|\\[\\"])*)"//) { ($snippet = $1) =~ s#\\(.)#$1#g; } - elsif (s/^'(([^'\\]+|\\[\\'])*)'//) { + elsif (/^"/) { + die "Unmatched double quote: $_\n"; + } + elsif (s/^'(([^'\\]|\\[\\'])*)'//) { ($snippet = $1) =~ s#\\(.)#$1#g; } + elsif (/^'/) { + die "Unmatched single quote: $_\n"; + } elsif (s/^\\(.)//) { $snippet = $1; } diff --git a/lib/syslog.pl b/lib/syslog.pl index d5f9812..842414e 100644 --- a/lib/syslog.pl +++ b/lib/syslog.pl @@ -2,6 +2,9 @@ # syslog.pl # # $Log: syslog.pl,v $ +# Revision 4.0.1.1 92/06/08 13:48:05 lwall +# patch20: new warning for ambiguous use of unary operators +# # Revision 4.0 91/03/20 01:26:24 lwall # 4.0 baseline. # @@ -164,7 +167,7 @@ sub xlate { $name =~ y/a-z/A-Z/; $name = "LOG_$name" unless $name =~ /^LOG_/; $name = "syslog'$name"; - eval &$name || -1; + eval(&$name) || -1; } sub connect { diff --git a/patchlevel.h b/patchlevel.h index 256548d..dd91c28 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 30 +#define PATCHLEVEL 31 diff --git a/regcomp.c b/regcomp.c index fd8d422..fa07260 100644 --- a/regcomp.c +++ b/regcomp.c @@ -7,9 +7,15 @@ * blame Henry for some of the lack of readability. */ -/* $RCSfile: regcomp.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 22:55:14 $ +/* $RCSfile: regcomp.c,v $$Revision: 4.0.1.5 $$Date: 92/06/08 15:23:36 $ * * $Log: regcomp.c,v $ + * Revision 4.0.1.5 92/06/08 15:23:36 lwall + * patch20: Perl now distinguishes overlapped copies from non-overlapped + * patch20: /^stuff/ wrongly assumed an implicit $* == 1 + * patch20: /x{0}/ was wrongly interpreted as /x{0,}/ + * patch20: added \W, \S and \D inside /[...]/ + * * Revision 4.0.1.4 91/11/05 22:55:14 lwall * patch11: Erratum * @@ -86,7 +92,11 @@ #define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?') #define ISMULT2(s) ((*s) == '*' || (*s) == '+' || (*s) == '?' || \ ((*s) == '{' && regcurly(s))) +#ifdef atarist +#define PERL_META "^$.[()|?+*\\" +#else #define META "^$.[()|?+*\\" +#endif #ifdef SPSTART #undef SPSTART /* dratted cpp namespace... */ @@ -160,10 +170,6 @@ int fold; int backest; int curback; int minlen; -#ifndef safemalloc - extern char *safemalloc(); -#endif - extern char *savestr(); int sawplus = 0; int sawopen = 0; @@ -198,7 +204,7 @@ int fold; /* Second pass: emit code. */ if (regsawbracket) - bcopy(regprecomp,exp,xend-exp); + Copy(regprecomp,exp,xend-exp,char); r->prelen = xend-exp; r->precomp = regprecomp; r->subbeg = r->subbase = NULL; @@ -243,9 +249,14 @@ int fold; r->regstclass = first; else if (OP(first) == BOUND || OP(first) == NBOUND) r->regstclass = first; - else if (OP(first) == BOL || - (OP(first) == STAR && OP(NEXTOPER(first)) == ANY) ) { - /* kinda turn .* into ^.* */ + else if (OP(first) == BOL) { + r->reganch = ROPT_ANCH; + first = NEXTOPER(first); + goto again; + } + else if ((OP(first) == STAR && OP(NEXTOPER(first)) == ANY) && + !(r->reganch & ROPT_ANCH) ) { + /* turn .* into ^.* with an implied $*=1 */ r->reganch = ROPT_ANCH | ROPT_IMPLICIT; first = NEXTOPER(first); goto again; @@ -564,6 +575,8 @@ int *flagp; else max = regparse; tmp = atoi(max); + if (!tmp && *max != '0') + tmp = 32767; /* meaning "infinity" */ if (tmp && tmp < iter) fatal("Can't do {n,m} with n > m"); if (regcode != ®dummy) { @@ -967,21 +980,27 @@ regclass() class = UCHARAT(regparse++); switch (class) { case 'w': - for (class = 'a'; class <= 'z'; class++) - regset(bits,def,class); - for (class = 'A'; class <= 'Z'; class++) + for (class = 0; class < 256; class++) + if (isALNUM(class)) regset(bits,def,class); - for (class = '0'; class <= '9'; class++) + lastclass = 1234; + continue; + case 'W': + for (class = 0; class < 256; class++) + if (!isALNUM(class)) regset(bits,def,class); - regset(bits,def,'_'); lastclass = 1234; continue; case 's': - regset(bits,def,' '); - regset(bits,def,'\t'); - regset(bits,def,'\r'); - regset(bits,def,'\f'); - regset(bits,def,'\n'); + for (class = 0; class < 256; class++) + if (isSPACE(class)) + regset(bits,def,class); + lastclass = 1234; + continue; + case 'S': + for (class = 0; class < 256; class++) + if (!isSPACE(class)) + regset(bits,def,class); lastclass = 1234; continue; case 'd': @@ -989,6 +1008,13 @@ regclass() regset(bits,def,class); lastclass = 1234; continue; + case 'D': + for (class = 0; class < '0'; class++) + regset(bits,def,class); + for (class = '9' + 1; class < 256; class++) + regset(bits,def,class); + lastclass = 1234; + continue; case 'n': class = '\n'; break; @@ -1184,6 +1210,9 @@ char *opnd; *place++ = '\0'; while (offset-- > 0) *place++ = '\0'; +#ifdef REGALIGN + *place++ = '\177'; +#endif } /* @@ -1420,6 +1449,7 @@ char *op; } #endif /* DEBUGGING */ +void regfree(r) struct regexp *r; { diff --git a/regexec.c b/regexec.c index 226aab4..d3cef20 100644 --- a/regexec.c +++ b/regexec.c @@ -7,9 +7,14 @@ * blame Henry for some of the lack of readability. */ -/* $RCSfile: regexec.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:23:55 $ +/* $RCSfile: regexec.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 15:25:50 $ * * $Log: regexec.c,v $ + * Revision 4.0.1.4 92/06/08 15:25:50 lwall + * patch20: pattern modifiers i and g didn't interact right + * patch20: in some cases $` and $' didn't get set by match + * patch20: /x{0}/ was wrongly interpreted as /x{0,}/ + * * Revision 4.0.1.3 91/11/05 18:23:55 lwall * patch11: prepared for ctype implementations that don't define isascii() * patch11: initial .* in pattern had dependency on value of $* @@ -140,10 +145,9 @@ int safebase; /* no need to remember string in subbase */ } if (prog->do_folding) { - safebase = FALSE; i = strend - string; New(1101,c,i+1,char); - (void)bcopy(string, c, i+1); + Copy(string, c, i+1, char); string = c; strend = string + i; for (s = string; s < strend; s++) @@ -441,6 +445,8 @@ int safebase; /* no need to remember string in subbase */ goto phooey; got_it: + prog->subbeg = strbeg; + prog->subend = strend; if ((!safebase && (prog->nparens || sawampersand)) || prog->do_folding){ strend += dontbother; /* uncheat */ if (safebase) /* no need for $digit later */ @@ -453,8 +459,11 @@ int safebase; /* no need to remember string in subbase */ prog->subbeg = prog->subbase = s; prog->subend = s+i; } - else - s = prog->subbase; + else { + i = strend - string + (stringarg - strbeg); + prog->subbeg = s = prog->subbase; + prog->subend = s+i; + } s += (stringarg - strbeg); for (i = 0; i <= prog->nparens; i++) { if (prog->endp[i]) { @@ -742,7 +751,7 @@ char *prog; goto repeat; case STAR: ln = 0; - n = 0; + n = 32767; scan = NEXTOPER(scan); goto repeat; case PLUS: @@ -751,7 +760,7 @@ char *prog; * when we know what character comes next. */ ln = 1; - n = 0; + n = 32767; scan = NEXTOPER(scan); repeat: if (OP(next) == EXACTLY) @@ -813,7 +822,7 @@ int max; register char *loceol = regeol; scan = reginput; - if (max && max < loceol - scan) + if (max != 32767 && max < loceol - scan) loceol = scan + max; opnd = OPERAND(p); switch (OP(p)) { diff --git a/stab.c b/stab.c index d141da3..f8e6f07 100644 --- a/stab.c +++ b/stab.c @@ -1,4 +1,4 @@ -/* $RCSfile: stab.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:35:33 $ +/* $RCSfile: stab.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 15:32:19 $ * * Copyright (c) 1991, Larry Wall * @@ -6,6 +6,13 @@ * License or the Artistic License, as specified in the README file. * * $Log: stab.c,v $ + * Revision 4.0.1.4 92/06/08 15:32:19 lwall + * patch20: fixed confusion between a *var's real name and its effective name + * patch20: the debugger now warns you on lines that can't set a breakpoint + * patch20: the debugger made perl forget the last pattern used by // + * patch20: paragraph mode now skips extra newlines automatically + * patch20: ($<,$>) = ... didn't work on some architectures + * * Revision 4.0.1.3 91/11/05 18:35:33 lwall * patch11: length($x) was sometimes wrong for numeric $x * patch11: perl now issues warning if $SIG{'ALARM'} is referenced @@ -91,7 +98,7 @@ STR *str; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '&': if (curspat) { - paren = atoi(stab_name(stab)); + paren = atoi(stab_ename(stab)); getparen: if (curspat->spat_regexp && paren <= curspat->spat_regexp->nparens && @@ -138,7 +145,7 @@ STR *str; break; case '.': #ifndef lint - if (last_in_stab) { + if (last_in_stab && stab_io(last_in_stab)) { str_numset(stab_val(stab),(double)stab_io(last_in_stab)->lines); } #endif @@ -151,14 +158,14 @@ STR *str; if (s) str_set(stab_val(stab),s); else { - str_set(stab_val(stab),stab_name(curoutstab)); + str_set(stab_val(stab),stab_ename(curoutstab)); str_cat(stab_val(stab),"_TOP"); } break; case '~': s = stab_io(curoutstab)->fmt_name; if (!s) - s = stab_name(curoutstab); + s = stab_ename(curoutstab); str_set(stab_val(stab),s); break; #ifndef lint @@ -172,6 +179,8 @@ STR *str; str_numset(stab_val(stab),(double)stab_io(curoutstab)->page); break; #endif + case ':': + break; case '/': break; case '[': @@ -260,7 +269,7 @@ STR *str; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '&': if (curspat) { - paren = atoi(stab_name(stab)); + paren = atoi(stab_ename(stab)); getparen: if (curspat->spat_regexp && paren <= curspat->spat_regexp->nparens && @@ -314,6 +323,7 @@ STR *str; } } +void stabset(mstr,str) register STR *mstr; STR *str; @@ -324,7 +334,7 @@ STR *str; switch (mstr->str_rare) { case 'E': - setenv(mstr->str_ptr,str_get(str)); + my_setenv(mstr->str_ptr,str_get(str)); /* And you'll never guess what the dog had */ /* in its mouth... */ #ifdef TAINT @@ -376,9 +386,12 @@ STR *str; stab = mstr->str_u.str_stab; i = str_true(str); str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE); - cmd = str->str_magic->str_u.str_cmd; - cmd->c_flags &= ~CF_OPTIMIZE; - cmd->c_flags |= i? CFT_D1 : CFT_D0; + if (str->str_magic && (cmd = str->str_magic->str_u.str_cmd)) { + cmd->c_flags &= ~CF_OPTIMIZE; + cmd->c_flags |= i? CFT_D1 : CFT_D0; + } + else + warn("Can't break at that line\n"); } break; case '#': @@ -405,7 +418,7 @@ STR *str; strcpy(stab_magic(stab),"StB"); stab_val(stab) = Str_new(70,0); stab_line(stab) = curcmd->c_line; - stab_stash(stab) = curcmd->c_stash; + stab_estab(stab) = stab; } else { stab = stabent(s,TRUE); @@ -459,10 +472,19 @@ STR *str; inplace = Nullch; break; case '\020': /* ^P */ - perldb = (int)str_gnum(str); + i = (int)str_gnum(str); + if (i != perldb) { + static SPAT *oldlastspat; + + if (perldb) + oldlastspat = lastspat; + else + lastspat = oldlastspat; + } + perldb = i; break; case '\024': /* ^T */ - basetime = (long)str_gnum(str); + basetime = (time_t)str_gnum(str); break; case '\027': /* ^W */ dowarn = (bool)str_gnum(str); @@ -508,7 +530,7 @@ STR *str; if (str->str_pok) { rs = str_get(str); rslen = str->str_cur; - if (!rslen) { + if (rspara = !rslen) { rs = "\n\n"; rslen = 2; } @@ -547,42 +569,35 @@ STR *str; break; case '<': uid = (int)str_gnum(str); -#if defined(HAS_SETREUID) || !defined(HAS_SETRUID) if (delaymagic) { - delaymagic |= DM_REUID; + delaymagic |= DM_RUID; break; /* don't do magic till later */ } -#endif /* HAS_SETREUID or not HASSETRUID */ #ifdef HAS_SETRUID - if (setruid((UIDTYPE)uid) < 0) - uid = (int)getuid(); + (void)setruid((UIDTYPE)uid); #else #ifdef HAS_SETREUID - if (setreuid((UIDTYPE)uid, (UIDTYPE)-1) < 0) - uid = (int)getuid(); + (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1); #else if (uid == euid) /* special case $< = $> */ - setuid(uid); + (void)setuid(uid); else fatal("setruid() not implemented"); #endif #endif + uid = (int)getuid(); break; case '>': euid = (int)str_gnum(str); -#if defined(HAS_SETREUID) || !defined(HAS_SETEUID) if (delaymagic) { - delaymagic |= DM_REUID; + delaymagic |= DM_EUID; break; /* don't do magic till later */ } -#endif /* HAS_SETREUID or not HAS_SETEUID */ #ifdef HAS_SETEUID - if (seteuid((UIDTYPE)euid) < 0) - euid = (int)geteuid(); + (void)seteuid((UIDTYPE)euid); #else #ifdef HAS_SETREUID - if (setreuid((UIDTYPE)-1, (UIDTYPE)euid) < 0) - euid = (int)geteuid(); + (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid); #else if (euid == uid) /* special case $> = $< */ setuid(euid); @@ -590,42 +605,47 @@ STR *str; fatal("seteuid() not implemented"); #endif #endif + euid = (int)geteuid(); break; case '(': gid = (int)str_gnum(str); -#if defined(HAS_SETREGID) || !defined(HAS_SETRGID) if (delaymagic) { - delaymagic |= DM_REGID; + delaymagic |= DM_RGID; break; /* don't do magic till later */ } -#endif /* HAS_SETREGID or not HAS_SETRGID */ #ifdef HAS_SETRGID (void)setrgid((GIDTYPE)gid); #else #ifdef HAS_SETREGID (void)setregid((GIDTYPE)gid, (GIDTYPE)-1); #else - fatal("setrgid() not implemented"); + if (gid == egid) /* special case $( = $) */ + (void)setgid(gid); + else + fatal("setrgid() not implemented"); #endif #endif + gid = (int)getgid(); break; case ')': egid = (int)str_gnum(str); -#if defined(HAS_SETREGID) || !defined(HAS_SETEGID) if (delaymagic) { - delaymagic |= DM_REGID; + delaymagic |= DM_EGID; break; /* don't do magic till later */ } -#endif /* HAS_SETREGID or not HAS_SETEGID */ #ifdef HAS_SETEGID (void)setegid((GIDTYPE)egid); #else #ifdef HAS_SETREGID (void)setregid((GIDTYPE)-1, (GIDTYPE)egid); #else - fatal("setegid() not implemented"); + if (egid == gid) /* special case $) = $( */ + (void)setgid(egid); + else + fatal("setegid() not implemented"); #endif #endif + egid = (int)getegid(); break; case ':': chopset = str_get(str); @@ -640,7 +660,8 @@ STR *str; s += strlen(++s); /* this one is ok too */ } if (origenviron[0] == s + 1) { /* can grab env area too? */ - setenv("NoNeSuCh", Nullch); /* force copy of environment */ + my_setenv("NoNeSuCh", Nullch); + /* force copy of environment */ for (i = 0; origenviron[i]; i++) if (origenviron[i] == s + 1) s += strlen(++s); @@ -653,10 +674,10 @@ STR *str; i = origalen; str->str_cur = i; str->str_ptr[i] = '\0'; - bcopy(s, origargv[0], i); + Copy(s, origargv[0], i, char); } else { - bcopy(s, origargv[0], i); + Copy(s, origargv[0], i, char); s = origargv[0]+i; *s++ = '\0'; while (++i < origalen) @@ -676,6 +697,7 @@ STR *str; } } +int whichsig(sig) char *sig; { @@ -725,7 +747,7 @@ int sig; if (!sub) { if (dowarn) warn("SIG%s handler \"%s\" not defined.\n", - sig_name[sig], stab_name(stab) ); + sig_name[sig], stab_ename(stab) ); return; } /*SUPPRESS 701*/ @@ -751,7 +773,7 @@ int sig; sub->depth++; if (sub->depth >= 2) { /* save temporaries on recursion? */ if (sub->depth == 100 && dowarn) - warn("Deep recursion on subroutine \"%s\"",stab_name(stab)); + warn("Deep recursion on subroutine \"%s\"",stab_ename(stab)); savelist(sub->tosave->ary_array,sub->tosave->ary_fill); } @@ -888,6 +910,7 @@ int add; strcpy(stab_magic(stab),"StB"); stab_val(stab) = Str_new(72,0); stab_line(stab) = curcmd->c_line; + stab_estab(stab) = stab; str_magic((STR*)stab, stab, '*', name, len); stab_stash(stab) = stash; if (isDIGIT(*name) && *name != '0') { @@ -900,6 +923,7 @@ int add; } } +void stab_fullname(str,stab) STR *str; STAB *stab; @@ -913,6 +937,20 @@ STAB *stab; str_scat(str,stab->str_magic); } +void +stab_efullname(str,stab) +STR *str; +STAB *stab; +{ + HASH *tb = stab_estash(stab); + + if (!tb) + return; + str_set(str,tb->tbl_name); + str_ncat(str,"'", 1); + str_scat(str,stab_estab(stab)->str_magic); +} + STIO * stio_new() { @@ -923,6 +961,7 @@ stio_new() return stio; } +void stab_check(min,max) int min; register int max; @@ -960,6 +999,8 @@ register STAB *stab; STIO *stio; SUBR *sub; + if (!stab || !stab->str_ptr) + return; afree(stab_xarray(stab)); stab_xarray(stab) = Null(ARRAY*); (void)hfree(stab_xhash(stab), FALSE); diff --git a/stab.h b/stab.h index 3025342..499a2a2 100644 --- a/stab.h +++ b/stab.h @@ -1,4 +1,4 @@ -/* $RCSfile: stab.h,v $$Revision: 4.0.1.2 $$Date: 91/11/05 18:36:15 $ +/* $RCSfile: stab.h,v $$Revision: 4.0.1.3 $$Date: 92/06/08 15:33:44 $ * * Copyright (c) 1991, Larry Wall * @@ -6,6 +6,10 @@ * License or the Artistic License, as specified in the README file. * * $Log: stab.h,v $ + * Revision 4.0.1.3 92/06/08 15:33:44 lwall + * patch20: fixed confusion between a *var's real name and its effective name + * patch20: ($<,$>) = ... didn't work on some architectures + * * Revision 4.0.1.2 91/11/05 18:36:15 lwall * patch11: length($x) was sometimes wrong for numeric $x * @@ -25,7 +29,7 @@ struct stabptrs { FCMD *stbp_form; /* format value */ ARRAY *stbp_array; /* array value */ HASH *stbp_hash; /* associative array value */ - HASH *stbp_stash; /* symbol table for this stab */ + STAB *stbp_stab; /* effective stab, if *glob */ SUBR *stbp_sub; /* subroutine value */ int stbp_lastexpr; /* used by nothing_in_common() */ line_t stbp_line; /* line first declared at (for -w) */ @@ -56,12 +60,19 @@ HASH *stab_hash(); ((STBP*)(stab->str_ptr))->stbp_hash : \ ((STBP*)(hadd(stab)->str_ptr))->stbp_hash) #endif /* Microport 2.4 hack */ -#define stab_stash(stab) (((STBP*)(stab->str_ptr))->stbp_stash) #define stab_sub(stab) (((STBP*)(stab->str_ptr))->stbp_sub) #define stab_lastexpr(stab) (((STBP*)(stab->str_ptr))->stbp_lastexpr) #define stab_line(stab) (((STBP*)(stab->str_ptr))->stbp_line) #define stab_flags(stab) (((STBP*)(stab->str_ptr))->stbp_flags) + +#define stab_stab(stab) (stab->str_magic->str_u.str_stab) +#define stab_estab(stab) (((STBP*)(stab->str_ptr))->stbp_stab) + #define stab_name(stab) (stab->str_magic->str_ptr) +#define stab_ename(stab) stab_name(stab_estab(stab)) + +#define stab_stash(stab) (stab->str_magic->str_u.str_stash) +#define stab_estash(stab) stab_stash(stab_estab(stab)) #define SF_VMAGIC 1 /* call routine to dereference STR val */ #define SF_MULTI 2 /* seen more than once */ @@ -114,10 +125,18 @@ EXT STAB *stab_index[128]; EXT unsigned short statusvalue; EXT int delaymagic INIT(0); -#define DM_DELAY 1 -#define DM_REUID 2 -#define DM_REGID 4 +#define DM_UID 0x003 +#define DM_RUID 0x001 +#define DM_EUID 0x002 +#define DM_GID 0x030 +#define DM_RGID 0x010 +#define DM_EGID 0x020 +#define DM_DELAY 0x100 STAB *aadd(); STAB *hadd(); STAB *fstab(); +void stabset(); +void stab_fullname(); +void stab_efullname(); +void stab_check(); diff --git a/str.c b/str.c index 4fdc063..1c0c00e 100644 --- a/str.c +++ b/str.c @@ -1,4 +1,4 @@ -/* $RCSfile: str.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 18:40:51 $ +/* $RCSfile: str.c,v $$Revision: 4.0.1.5 $$Date: 92/06/08 15:40:43 $ * * Copyright (c) 1991, Larry Wall * @@ -6,6 +6,16 @@ * License or the Artistic License, as specified in the README file. * * $Log: str.c,v $ + * Revision 4.0.1.5 92/06/08 15:40:43 lwall + * patch20: removed implicit int declarations on functions + * patch20: Perl now distinguishes overlapped copies from non-overlapped + * patch20: paragraph mode now skips extra newlines automatically + * patch20: fixed memory leak in doube-quote interpretation + * patch20: made /\$$foo/ look for literal '$foo' + * patch20: "$var{$foo'bar}" didn't scan subscript correctly + * patch20: a splice on non-existent array elements could dump core + * patch20: running taintperl explicitly now does checks even if $< == $> + * * Revision 4.0.1.4 91/11/05 18:40:51 lwall * patch11: $foo .= could overrun malloced memory * patch11: \$ didn't always make it through double-quoter to regexp routines @@ -32,6 +42,9 @@ #include "perl.h" #include "perly.h" +static void ucase(); +static void lcase(); + #ifndef str_get char * str_get(str) @@ -48,6 +61,7 @@ STR *str; * dlb the following functions are usually macros. */ #ifndef str_true +int str_true(Str) STR *Str; { @@ -81,7 +95,7 @@ STR *Str; char * str_grow(str,newlen) register STR *str; -#ifndef MSDOS +#ifndef DOSISH register int newlen; #else unsigned long newlen; @@ -99,7 +113,7 @@ unsigned long newlen; str->str_len += str->str_u.str_useful; str->str_ptr -= str->str_u.str_useful; str->str_u.str_useful = 0L; - bcopy(s, str->str_ptr, str->str_cur+1); + Move(s, str->str_ptr, str->str_cur+1, char); s = str->str_ptr; str->str_state = SS_NORM; /* normal again */ if (newlen > str->str_len) @@ -116,6 +130,7 @@ unsigned long newlen; return s; } +void str_numset(str,num) register STR *str; double num; @@ -212,6 +227,7 @@ register STR *str; * as temporary. */ +void str_sset(dstr,sstr) STR *dstr; register STR *sstr; @@ -273,6 +289,10 @@ register STR *sstr; char *tmps = dstr->str_ptr; if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) { + if (dstr->str_magic && dstr->str_magic->str_rare == 'X') { + str_free(dstr->str_magic); + dstr->str_magic = Nullstr; + } if (!dstr->str_magic) { dstr->str_magic = str_smake(sstr->str_magic); dstr->str_magic->str_rare = 'X'; @@ -296,6 +316,7 @@ register STR *sstr; } } +void str_nset(str,ptr,len) register STR *str; register char *ptr; @@ -305,7 +326,7 @@ register STRLEN len; return; STR_GROW(str, len + 1); if (ptr) - (void)bcopy(ptr,str->str_ptr,len); + Move(ptr,str->str_ptr,len,char); str->str_cur = len; *(str->str_ptr+str->str_cur) = '\0'; str->str_nok = 0; /* invalidate number */ @@ -315,6 +336,7 @@ register STRLEN len; #endif } +void str_set(str,ptr) register STR *str; register char *ptr; @@ -327,7 +349,7 @@ register char *ptr; ptr = ""; len = strlen(ptr); STR_GROW(str, len + 1); - (void)bcopy(ptr,str->str_ptr,len+1); + Move(ptr,str->str_ptr,len+1,char); str->str_cur = len; str->str_nok = 0; /* invalidate number */ str->str_pok = 1; /* validate pointer */ @@ -336,6 +358,7 @@ register char *ptr; #endif } +void str_chop(str,ptr) /* like set but assuming ptr is in str */ register STR *str; register char *ptr; @@ -358,6 +381,7 @@ register char *ptr; str->str_pok = 1; /* validate pointer (and unstudy str) */ } +void str_ncat(str,ptr,len) register STR *str; register char *ptr; @@ -368,7 +392,7 @@ register STRLEN len; if (!(str->str_pok)) (void)str_2ptr(str); STR_GROW(str, str->str_cur + len + 1); - (void)bcopy(ptr,str->str_ptr+str->str_cur,len); + Move(ptr,str->str_ptr+str->str_cur,len,char); str->str_cur += len; *(str->str_ptr+str->str_cur) = '\0'; str->str_nok = 0; /* invalidate number */ @@ -378,6 +402,7 @@ register STRLEN len; #endif } +void str_scat(dstr,sstr) STR *dstr; register STR *sstr; @@ -393,6 +418,7 @@ register STR *sstr; str_ncat(dstr,sstr->str_ptr,sstr->str_cur); } +void str_cat(str,ptr) register STR *str; register char *ptr; @@ -407,7 +433,7 @@ register char *ptr; (void)str_2ptr(str); len = strlen(ptr); STR_GROW(str, str->str_cur + len + 1); - (void)bcopy(ptr,str->str_ptr+str->str_cur,len+1); + Move(ptr,str->str_ptr+str->str_cur,len+1,char); str->str_cur += len; str->str_nok = 0; /* invalidate number */ str->str_pok = 1; /* validate pointer */ @@ -530,13 +556,13 @@ STRLEN littlelen; *bigend = '\0'; while (midend > mid) /* shove everything down */ *--bigend = *--midend; - (void)bcopy(little,big+offset,littlelen); + Move(little,big+offset,littlelen,char); bigstr->str_cur += i; STABSET(bigstr); return; } else if (i == 0) { - (void)bcopy(little,bigstr->str_ptr+offset,len); + Move(little,bigstr->str_ptr+offset,len,char); STABSET(bigstr); return; } @@ -551,12 +577,12 @@ STRLEN littlelen; if (mid - big > bigend - midend) { /* faster to shorten from end */ if (littlelen) { - (void)bcopy(little, mid, littlelen); + Move(little, mid, littlelen,char); mid += littlelen; } i = bigend - midend; if (i > 0) { - (void)bcopy(midend, mid, i); + Move(midend, mid, i,char); mid += i; } *mid = '\0'; @@ -571,12 +597,12 @@ STRLEN littlelen; while (i--) *--midend = *--big; if (littlelen) - (void)bcopy(little, mid, littlelen); + Move(little, mid, littlelen,char); } else if (littlelen) { midend -= littlelen; str_chop(bigstr,midend); - (void)bcopy(little,midend,littlelen); + Move(little,midend,littlelen,char); } else { str_chop(bigstr,midend); @@ -679,6 +705,7 @@ register STR *str; return 0; } +int str_eq(str1,str2) register STR *str1; register STR *str2; @@ -699,6 +726,7 @@ register STR *str2; return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur); } +int str_cmp(str1,str2) register STR *str1; register STR *str2; @@ -747,6 +775,15 @@ int append; if (str == &str_undef) return Nullch; + if (rspara) { /* have to do this both before and after */ + do { /* to make sure file boundaries work right */ + i = getc(fp); + if (i != '\n') { + ungetc(i,fp); + break; + } + } while (i != EOF); + } #ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */ cnt = fp->_cnt; /* get count into register */ str->str_nok = 0; /* invalidate number */ @@ -849,6 +886,15 @@ screamer: #endif /* STDSTDIO */ + if (rspara) { + while (i != EOF) { + i = getc(fp); + if (i != '\n') { + ungetc(i,fp); + break; + } + } + } return str->str_cur - append ? str->str_ptr : Nullch; } @@ -906,7 +952,8 @@ STR *str; if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST) fatal("panic: error in parselist %d %x %d", cmd->c_type, cmd->c_next, arg ? arg->arg_type : -1); - Safefree(cmd); + cmd->c_expr = Nullarg; + cmd_free(cmd); eval_root = Nullcmd; return arg; } @@ -945,10 +992,6 @@ STR *src; if (*nointrp) { /* in a regular expression */ if (*s == '@') /* always strip \@ */ /*SUPPRESS 530*/ ; - else if (*s == '$') { - if (s+1 >= send || index(nointrp, s[1])) - str_ncat(str,s-1,1); /* only strip \$ for vars */ - } else /* don't strip \\, \[, \{ etc. */ str_ncat(str,s-1,1); } @@ -988,27 +1031,30 @@ STR *src; do { switch (*s) { case '[': - if (s[-1] != '$') - brackets++; + brackets++; break; case '{': brackets++; break; case ']': - if (s[-1] != '$') - brackets--; + brackets--; break; case '}': brackets--; break; + case '$': + case '%': + case '@': + case '&': + case '*': + s = scanident(s,send,tokenbuf); + break; case '\'': case '"': - if (s[-1] != '$') { - /*SUPPRESS 68*/ - s = cpytill(tokenbuf,s+1,send,*s,&len); - if (s >= send) - fatal("Unterminated string"); - } + /*SUPPRESS 68*/ + s = cpytill(tokenbuf,s+1,send,*s,&len); + if (s >= send) + fatal("Unterminated string"); break; } s++; @@ -1254,6 +1300,7 @@ int sp; return str; } +static void ucase(s,send) register char *s; register char *send; @@ -1265,6 +1312,7 @@ register char *send; } } +static void lcase(s,send) register char *s; register char *send; @@ -1381,7 +1429,7 @@ STR * str_2mortal(str) register STR *str; { - if (str == &str_undef) + if (!str || str == &str_undef) return str; if (++tmps_max > tmps_size) { tmps_size = tmps_max; @@ -1439,7 +1487,7 @@ register STR *old; Str_Grow(old,0); if (new->str_ptr) Safefree(new->str_ptr); - Copy(old,new,1,STR); + StructCopy(old,new,STR); if (old->str_ptr) { new->str_ptr = nsavestr(old->str_ptr,old->str_len); new->str_pok &= ~SP_TEMP; @@ -1447,6 +1495,7 @@ register STR *old; return new; } +void str_reset(s,stash) register char *s; HASH *stash; @@ -1504,6 +1553,7 @@ HASH *stash; } #ifdef TAINT +void taintproper(s) char *s; { @@ -1511,7 +1561,7 @@ char *s; if (debug & 2048) fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid); #endif - if (tainted && (!euid || euid != uid || egid != gid)) { + if (tainted && (!euid || euid != uid || egid != gid || taintanyway)) { if (!unsafe) fatal("%s", s); else if (dowarn) @@ -1519,6 +1569,7 @@ char *s; } } +void taintenv() { register STR *envstr; diff --git a/x2p/s2p.SH b/x2p/s2p.SH index 818d362..6bb8c51 100644 --- a/x2p/s2p.SH +++ b/x2p/s2p.SH @@ -20,18 +20,27 @@ echo "Extracting s2p (with variable substitutions)" : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. : Protect any dollar signs and backticks that you do not want interpreted : by putting a backslash in front. You may delete these comments. +rm -f s2p $spitshell >s2p <>s2p <<'!NO!SUBS!' -# $RCSfile: s2p.SH,v $$Revision: 4.0.1.1 $$Date: 91/06/07 12:19:18 $ +# $RCSfile: s2p.SH,v $$Revision: 4.0.1.2 $$Date: 92/06/08 17:26:31 $ # # $Log: s2p.SH,v $ +# Revision 4.0.1.2 92/06/08 17:26:31 lwall +# patch20: s2p didn't output portable startup code +# patch20: added ... as variant on .. +# patch20: s2p didn't translate s/pat/\&/ or s/pat/\$/ or s/pat/\\1/ right +# # Revision 4.0.1.1 91/06/07 12:19:18 lwall # patch4: s2p now handles embedded newlines better and optimizes common idioms # @@ -162,7 +171,12 @@ while (<>) { } else { &Die("Invalid second address at line $.\n"); } - $addr1 .= " .. $addr2"; + if ($addr2 =~ /^\d+$/) { + $addr1 .= "..$addr2"; + } + else { + $addr1 .= "...$addr2"; + } } # Now we check for metacommands {, }, and ! and worry @@ -488,6 +502,19 @@ EOT substr($_,$i,1) =~ /^[<>]$/) { substr($_,$i,1) = 'b'; } + elsif ($repl && substr($_,$i,1) =~ /^\d$/) { + substr($_,$i-1,1) = '$'; + } + } + elsif ($c eq '&' && $repl) { + substr($_, $i, 0) = '$'; + $i++; + $len++; + } + elsif ($c eq '$' && $repl) { + substr($_, $i, 0) = '\\'; + $i++; + $len++; } elsif ($c eq '[' && !$repl) { $i++ if substr($_,$i,1) eq '^'; @@ -515,9 +542,6 @@ EOT $end = substr($_, $end + 1, 1000); &simplify($pat); $dol = '$'; - $repl =~ s/\$/\\$/; - $repl =~ s'&'$&'g; - $repl =~ s/[\\]([0-9])/$dol$1/g; $subst = "$pat$repl$delim"; $cmd = ''; while ($end) {