perl 4.0 patch 31: patch #20, continued
authorLarry Wall <lwall@netlabs.com>
Mon, 8 Jun 1992 04:52:59 +0000 (04:52 +0000)
committerLarry Wall <lwall@netlabs.com>
Mon, 8 Jun 1992 04:52:59 +0000 (04:52 +0000)
See patch #20.

17 files changed:
atarist/test/sig [new file with mode: 0644]
atarist/test/tbinmode [new file with mode: 0644]
atarist/usersub.c [new file with mode: 0644]
hints/sco_2_3_3.sh
hints/sco_2_3_4.sh [new file with mode: 0644]
hints/sgi.sh
hints/ultrix_4.sh
hints/unisysdynix.sh [new file with mode: 0644]
lib/shellwords.pl
lib/syslog.pl
patchlevel.h
regcomp.c
regexec.c
stab.c
stab.h
str.c
x2p/s2p.SH

diff --git a/atarist/test/sig b/atarist/test/sig
new file mode 100644 (file)
index 0000000..ac1b2b2
--- /dev/null
@@ -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($_ = <ARGV>) {
+    print $_;
+}
diff --git a/atarist/test/tbinmode b/atarist/test/tbinmode
new file mode 100644 (file)
index 0000000..4cf4f78
--- /dev/null
@@ -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, "<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;
diff --git a/atarist/usersub.c b/atarist/usersub.c
new file mode 100644 (file)
index 0000000..aba53d7
--- /dev/null
@@ -0,0 +1,9 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include <stdio.h>
+
+int userinit()
+{
+    install_null();    /* install device /dev/null or NUL: */
+    return 0;
+}
index d1db39f..10baafd 100644 (file)
@@ -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 (file)
index 0000000..3a1b13c
--- /dev/null
@@ -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."
index b7db156..4252aaf 100644 (file)
@@ -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
index 91e5d7d..633e904 100644 (file)
@@ -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 (file)
index 0000000..4251ba8
--- /dev/null
@@ -0,0 +1 @@
+d_waitpid=undef
index 168991f..5d593da 100644 (file)
@@ -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;
            }
index d5f9812..842414e 100644 (file)
@@ -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 {
index 256548d..dd91c28 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 30
+#define PATCHLEVEL 31
index fd8d422..fa07260 100644 (file)
--- 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
  * 
 #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 != &regdummy) {
@@ -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;
 {
index 226aab4..d3cef20 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 .= <BAR> 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;
index 818d362..6bb8c51 100644 (file)
@@ -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 <<!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
 # 
@@ -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) {