See patch #20.
--- /dev/null
+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($_ = <ARGV>) {
+ print $_;
+}
--- /dev/null
+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, "<bintest") || die "Can't open bintest for read\n";
+binmode FP;
+@got = unpack("C*", <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;
--- /dev/null
+#include "EXTERN.h"
+#include "perl.h"
+#include <stdio.h>
+
+int userinit()
+{
+ install_null(); /* install device /dev/null or NUL: */
+ return 0;
+}
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."
--- /dev/null
+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."
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
toke_cflags='optimize="-g"'
ttoke_cflags='optimize="-g"'
;;
+*4.2*) libswanted=`echo $libswanted | sed 's/ malloc / /'` ;;
esac
--- /dev/null
+d_waitpid=undef
-#; 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;
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;
}
# 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.
#
$name =~ y/a-z/A-Z/;
$name = "LOG_$name" unless $name =~ /^LOG_/;
$name = "syslog'$name";
- eval &$name || -1;
+ eval(&$name) || -1;
}
sub connect {
-#define PATCHLEVEL 30
+#define PATCHLEVEL 31
* 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
*
#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... */
int backest;
int curback;
int minlen;
-#ifndef safemalloc
- extern char *safemalloc();
-#endif
- extern char *savestr();
int sawplus = 0;
int sawopen = 0;
/* 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;
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;
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) {
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':
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;
*place++ = '\0';
while (offset-- > 0)
*place++ = '\0';
+#ifdef REGALIGN
+ *place++ = '\177';
+#endif
}
/*
}
#endif /* DEBUGGING */
+void
regfree(r)
struct regexp *r;
{
* 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 $*
}
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++)
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 */
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]) {
goto repeat;
case STAR:
ln = 0;
- n = 0;
+ n = 32767;
scan = NEXTOPER(scan);
goto repeat;
case PLUS:
* when we know what character comes next.
*/
ln = 1;
- n = 0;
+ n = 32767;
scan = NEXTOPER(scan);
repeat:
if (OP(next) == EXACTLY)
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)) {
-/* $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
*
* 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
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 &&
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
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
str_numset(stab_val(stab),(double)stab_io(curoutstab)->page);
break;
#endif
+ case ':':
+ break;
case '/':
break;
case '[':
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 &&
}
}
+void
stabset(mstr,str)
register STR *mstr;
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
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 '#':
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);
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);
if (str->str_pok) {
rs = str_get(str);
rslen = str->str_cur;
- if (!rslen) {
+ if (rspara = !rslen) {
rs = "\n\n";
rslen = 2;
}
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);
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);
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);
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)
}
}
+int
whichsig(sig)
char *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*/
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);
}
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') {
}
}
+void
stab_fullname(str,stab)
STR *str;
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()
{
return stio;
}
+void
stab_check(min,max)
int min;
register int max;
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);
-/* $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
*
* 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
*
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) */
((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 */
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();
-/* $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
*
* 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 .= <BAR> could overrun malloced memory
* patch11: \$ didn't always make it through double-quoter to regexp routines
#include "perl.h"
#include "perly.h"
+static void ucase();
+static void lcase();
+
#ifndef str_get
char *
str_get(str)
* dlb the following functions are usually macros.
*/
#ifndef str_true
+int
str_true(Str)
STR *Str;
{
char *
str_grow(str,newlen)
register STR *str;
-#ifndef MSDOS
+#ifndef DOSISH
register int newlen;
#else
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)
return s;
}
+void
str_numset(str,num)
register STR *str;
double num;
* as temporary.
*/
+void
str_sset(dstr,sstr)
STR *dstr;
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';
}
}
+void
str_nset(str,ptr,len)
register STR *str;
register char *ptr;
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 */
#endif
}
+void
str_set(str,ptr)
register STR *str;
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 */
#endif
}
+void
str_chop(str,ptr) /* like set but assuming ptr is in str */
register STR *str;
register char *ptr;
str->str_pok = 1; /* validate pointer (and unstudy str) */
}
+void
str_ncat(str,ptr,len)
register STR *str;
register char *ptr;
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 */
#endif
}
+void
str_scat(dstr,sstr)
STR *dstr;
register STR *sstr;
str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
}
+void
str_cat(str,ptr)
register STR *str;
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 */
*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;
}
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';
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);
return 0;
}
+int
str_eq(str1,str2)
register STR *str1;
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;
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 */
#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;
}
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;
}
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);
}
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++;
return str;
}
+static void
ucase(s,send)
register char *s;
register char *send;
}
}
+static void
lcase(s,send)
register char *s;
register char *send;
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;
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;
return new;
}
+void
str_reset(s,stash)
register char *s;
HASH *stash;
}
#ifdef TAINT
+void
taintproper(s)
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)
}
}
+void
taintenv()
{
register STR *envstr;
: 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 <<!GROK!THIS!
#!$bin/perl
+eval 'exec $bin/perl -S \$0 \${1+"\$@"}'
+ if \$running_under_some_shell;
+
\$bin = '$bin';
!GROK!THIS!
: In the following dollars and backticks do not need the extra backslash.
$spitshell >>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
#
} 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
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 '^';
$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) {
projects / p5sagit/p5-mst-13.2.git / commitdiff