home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume25 / perl / patch14 < prev    next >
Encoding:
Text File  |  1991-11-13  |  46.4 KB  |  1,894 lines
  1. Newsgroups: comp.sources.misc
  2. From: lwall@netlabs.com (Larry Wall)
  3. Subject:  v25i063:  perl - The perl programming language, Patch14
  4. Message-ID: <1991Nov13.214352.3713@sparky.imd.sterling.com>
  5. X-Md4-Signature: f49d5027096cbbf2407192e85e45826c
  6. Date: Wed, 13 Nov 1991 21:43:52 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: lwall@netlabs.com (Larry Wall)
  10. Posting-number: Volume 25, Issue 63
  11. Archive-name: perl/patch14
  12. Environment: UNIX, MS-DOS, OS2
  13. Patch-To: perl: Volume 18, Issue 19-54
  14.  
  15. System: perl version 4.0
  16. Patch #: 14
  17. Priority: MED-HIGH
  18. Subject: patch #11, continued
  19.  
  20. Description:
  21.     See patch #11.
  22.  
  23. Fix:    From rn, say "| patch -p -N -d DIR", where DIR is your perl source
  24.     directory.  Outside of rn, say "cd DIR; patch -p -N <thisarticle".
  25.     If you don't have the patch program, apply the following by hand,
  26.     or get patch (version 2.0, latest patchlevel).
  27.  
  28.     After patching:
  29.         *** DO NOTHING--INSTALL ALL PATCHES UP THROUGH #18 FIRST ***
  30.  
  31.     If patch indicates that patchlevel is the wrong version, you may need
  32.     to apply one or more previous patches, or the patch may already
  33.     have been applied.  See the patchlevel.h file to find out what has or
  34.     has not been applied.  In any event, don't continue with the patch.
  35.  
  36.     If you are missing previous patches they can be obtained from me:
  37.  
  38.     Larry Wall
  39.     lwall@netlabs.com
  40.  
  41.     If you send a mail message of the following form it will greatly speed
  42.     processing:
  43.  
  44.     Subject: Command
  45.     @SH mailpatch PATH perl 4.0 LIST
  46.            ^ note the c
  47.  
  48.     where PATH is a return path FROM ME TO YOU either in Internet notation,
  49.     or in bang notation from some well-known host, and LIST is the number
  50.     of one or more patches you need, separated by spaces, commas, and/or
  51.     hyphens.  Saying 35- says everything from 35 to the end.
  52.  
  53.  
  54. Index: patchlevel.h
  55. Prereq: 13
  56. 1c1
  57. < #define PATCHLEVEL 13
  58. ---
  59. > #define PATCHLEVEL 14
  60.  
  61. Index: doio.c
  62. *** doio.c.old    Tue Nov  5 19:26:02 1991
  63. --- doio.c    Tue Nov  5 19:26:03 1991
  64. ***************
  65. *** 1,4 ****
  66. ! /* $RCSfile: doio.c,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:21:19 $
  67.    *
  68.    *    Copyright (c) 1991, Larry Wall
  69.    *
  70. --- 1,4 ----
  71. ! /* $RCSfile: doio.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 16:51:43 $
  72.    *
  73.    *    Copyright (c) 1991, Larry Wall
  74.    *
  75. ***************
  76. *** 6,11 ****
  77. --- 6,20 ----
  78.    *    License or the Artistic License, as specified in the README file.
  79.    *
  80.    * $Log:    doio.c,v $
  81. +  * Revision 4.0.1.4  91/11/05  16:51:43  lwall
  82. +  * patch11: prepared for ctype implementations that don't define isascii()
  83. +  * patch11: perl mistook some streams for sockets because they return mode 0 too
  84. +  * patch11: reopening STDIN, STDOUT and STDERR failed on some machines
  85. +  * patch11: certain perl errors should set EBADF so that $! looks better
  86. +  * patch11: truncate on a closed filehandle could dump
  87. +  * patch11: stats of _ forgot whether prior stat was actually lstat
  88. +  * patch11: -T returned true on NFS directory
  89. +  * 
  90.    * Revision 4.0.1.3  91/06/10  01:21:19  lwall
  91.    * patch10: read didn't work from character special files open for writing
  92.    * patch10: close-on-exec wrongly set on system file descriptors
  93. ***************
  94. *** 93,99 ****
  95.   
  96.       name = myname;
  97.       forkprocess = 1;        /* assume true if no fork */
  98. !     while (len && isspace(name[len-1]))
  99.       name[--len] = '\0';
  100.       if (!stio)
  101.       stio = stab_io(stab) = stio_new();
  102. --- 102,108 ----
  103.   
  104.       name = myname;
  105.       forkprocess = 1;        /* assume true if no fork */
  106. !     while (len && isSPACE(name[len-1]))
  107.       name[--len] = '\0';
  108.       if (!stio)
  109.       stio = stab_io(stab) = stio_new();
  110. ***************
  111. *** 135,141 ****
  112.       }
  113.       stio->type = *name;
  114.       if (*name == '|') {
  115. !     for (name++; isspace(*name); name++) ;
  116.   #ifdef TAINT
  117.       taintenv();
  118.       taintproper("Insecure dependency in piped open");
  119. --- 144,151 ----
  120.       }
  121.       stio->type = *name;
  122.       if (*name == '|') {
  123. !     /*SUPPRESS 530*/
  124. !     for (name++; isSPACE(*name); name++) ;
  125.   #ifdef TAINT
  126.       taintenv();
  127.       taintproper("Insecure dependency in piped open");
  128. ***************
  129. *** 158,166 ****
  130.       if (*name == '&') {
  131.         duplicity:
  132.           name++;
  133. !         while (isspace(*name))
  134.           name++;
  135. !         if (isdigit(*name))
  136.           fd = atoi(name);
  137.           else {
  138.           stab = stabent(name,FALSE);
  139. --- 168,176 ----
  140.       if (*name == '&') {
  141.         duplicity:
  142.           name++;
  143. !         while (isSPACE(*name))
  144.           name++;
  145. !         if (isDIGIT(*name))
  146.           fd = atoi(name);
  147.           else {
  148.           stab = stabent(name,FALSE);
  149. ***************
  150. *** 183,189 ****
  151.           }
  152.       }
  153.       else {
  154. !         while (isspace(*name))
  155.           name++;
  156.           if (strEQ(name,"-")) {
  157.           fp = stdout;
  158. --- 193,199 ----
  159.           }
  160.       }
  161.       else {
  162. !         while (isSPACE(*name))
  163.           name++;
  164.           if (strEQ(name,"-")) {
  165.           fp = stdout;
  166. ***************
  167. *** 198,204 ****
  168.       if (*name == '<') {
  169.           mode[0] = 'r';
  170.           name++;
  171. !         while (isspace(*name))
  172.           name++;
  173.           if (*name == '&')
  174.           goto duplicity;
  175. --- 208,214 ----
  176.       if (*name == '<') {
  177.           mode[0] = 'r';
  178.           name++;
  179. !         while (isSPACE(*name))
  180.           name++;
  181.           if (*name == '&')
  182.           goto duplicity;
  183. ***************
  184. *** 215,229 ****
  185.           taintproper("Insecure dependency in piped open");
  186.   #endif
  187.           name[--len] = '\0';
  188. !         while (len && isspace(name[len-1]))
  189.           name[--len] = '\0';
  190. !         for (; isspace(*name); name++) ;
  191.           fp = mypopen(name,"r");
  192.           stio->type = '|';
  193.       }
  194.       else {
  195.           stio->type = '<';
  196. !         for (; isspace(*name); name++) ;
  197.           if (strEQ(name,"-")) {
  198.           fp = stdin;
  199.           stio->type = '-';
  200. --- 225,241 ----
  201.           taintproper("Insecure dependency in piped open");
  202.   #endif
  203.           name[--len] = '\0';
  204. !         while (len && isSPACE(name[len-1]))
  205.           name[--len] = '\0';
  206. !         /*SUPPRESS 530*/
  207. !         for (; isSPACE(*name); name++) ;
  208.           fp = mypopen(name,"r");
  209.           stio->type = '|';
  210.       }
  211.       else {
  212.           stio->type = '<';
  213. !         /*SUPPRESS 530*/
  214. !         for (; isSPACE(*name); name++) ;
  215.           if (strEQ(name,"-")) {
  216.           fp = stdin;
  217.           stio->type = '-';
  218. ***************
  219. *** 243,252 ****
  220.       }
  221.       if (S_ISSOCK(statbuf.st_mode))
  222.           stio->type = 's';    /* in case a socket was passed in to us */
  223.   #ifdef S_IFMT
  224. !     else if (!(statbuf.st_mode & S_IFMT))
  225. !         stio->type = 's';    /* some OS's return 0 on fstat()ed socket */
  226.   #endif
  227.       }
  228.       if (saveifp) {        /* must use old fp? */
  229.       fd = fileno(saveifp);
  230. --- 255,273 ----
  231.       }
  232.       if (S_ISSOCK(statbuf.st_mode))
  233.           stio->type = 's';    /* in case a socket was passed in to us */
  234. + #ifdef HAS_SOCKET
  235. +     else if (
  236.   #ifdef S_IFMT
  237. !         !(statbuf.st_mode & S_IFMT)
  238. ! #else
  239. !         !statbuf.st_mode
  240.   #endif
  241. +     ) {
  242. +         if (getsockname(fileno(fp), tokenbuf, 0) >= 0 || errno != ENOTSOCK)
  243. +         stio->type = 's'; /* some OS's return 0 on fstat()ed socket */
  244. +                 /* but some return 0 for streams too, sigh */
  245. +     }
  246. + #endif
  247.       }
  248.       if (saveifp) {        /* must use old fp? */
  249.       fd = fileno(saveifp);
  250. ***************
  251. *** 254,260 ****
  252.           fflush(saveofp);        /* emulate fclose() */
  253.           if (saveofp != saveifp) {    /* was a socket? */
  254.           fclose(saveofp);
  255. !         Safefree(saveofp);
  256.           }
  257.       }
  258.       if (fd != fileno(fp)) {
  259. --- 275,282 ----
  260.           fflush(saveofp);        /* emulate fclose() */
  261.           if (saveofp != saveifp) {    /* was a socket? */
  262.           fclose(saveofp);
  263. !         if (fd > 2)
  264. !             Safefree(saveofp);
  265.           }
  266.       }
  267.       if (fd != fileno(fp)) {
  268. ***************
  269. *** 294,301 ****
  270. --- 316,325 ----
  271.   register STAB *stab;
  272.   {
  273.       register STR *str;
  274. + #ifndef FLEXFILENAMES
  275.       int filedev;
  276.       int fileino;
  277. + #endif
  278.       int fileuid;
  279.       int filegid;
  280.       static int filemode = 0;
  281. ***************
  282. *** 328,335 ****
  283. --- 352,361 ----
  284.               defoutstab = stabent("STDOUT",TRUE);
  285.               return stab_io(stab)->ifp;
  286.           }
  287. + #ifndef FLEXFILENAMES
  288.           filedev = statbuf.st_dev;
  289.           fileino = statbuf.st_ino;
  290. + #endif
  291.           filemode = statbuf.st_mode;
  292.           fileuid = statbuf.st_uid;
  293.           filegid = statbuf.st_gid;
  294. ***************
  295. *** 503,510 ****
  296.   
  297.       if (!stab)
  298.       stab = argvstab;
  299. !     if (!stab)
  300.       return FALSE;
  301.       stio = stab_io(stab);
  302.       if (!stio) {        /* never opened */
  303.       if (dowarn && explicit)
  304. --- 529,538 ----
  305.   
  306.       if (!stab)
  307.       stab = argvstab;
  308. !     if (!stab) {
  309. !     errno = EBADF;
  310.       return FALSE;
  311. +     }
  312.       stio = stab_io(stab);
  313.       if (!stio) {        /* never opened */
  314.       if (dowarn && explicit)
  315. ***************
  316. *** 601,606 ****
  317. --- 629,635 ----
  318.   phooey:
  319.       if (dowarn)
  320.       warn("tell() on unopened file");
  321. +     errno = EBADF;
  322.       return -1L;
  323.   }
  324.   
  325. ***************
  326. *** 627,632 ****
  327. --- 656,662 ----
  328.   nuts:
  329.       if (dowarn)
  330.       warn("seek() on unopened file");
  331. +     errno = EBADF;
  332.       return FALSE;
  333.   }
  334.   
  335. ***************
  336. *** 641,651 ****
  337.       register char *s;
  338.       int retval;
  339.   
  340. !     if (!stab || !argstr)
  341.       return -1;
  342. !     stio = stab_io(stab);
  343. !     if (!stio)
  344. !     return -1;
  345.   
  346.       if (argstr->str_pok || !argstr->str_nok) {
  347.       if (!argstr->str_pok)
  348. --- 671,680 ----
  349.       register char *s;
  350.       int retval;
  351.   
  352. !     if (!stab || !argstr || !(stio = stab_io(stab)) || !stio->ifp) {
  353. !     errno = EBADF;    /* well, sort of... */
  354.       return -1;
  355. !     }
  356.   
  357.       if (argstr->str_pok || !argstr->str_nok) {
  358.       if (!argstr->str_pok)
  359. ***************
  360. *** 847,853 ****
  361.   }
  362.   #endif /* F_FREESP */
  363.   
  364. ! int
  365.   do_truncate(str,arg,gimme,arglast)
  366.   STR *str;
  367.   register ARG *arg;
  368. --- 876,882 ----
  369.   }
  370.   #endif /* F_FREESP */
  371.   
  372. ! int                    /*SUPPRESS 590*/
  373.   do_truncate(str,arg,gimme,arglast)
  374.   STR *str;
  375.   register ARG *arg;
  376. ***************
  377. *** 864,870 ****
  378.   #ifdef HAS_TRUNCATE
  379.       if ((arg[1].arg_type & A_MASK) == A_WORD) {
  380.       tmpstab = arg[1].arg_ptr.arg_stab;
  381. !     if (!stab_io(tmpstab) ||
  382.         ftruncate(fileno(stab_io(tmpstab)->ifp), len) < 0)
  383.           result = 0;
  384.       }
  385. --- 893,899 ----
  386.   #ifdef HAS_TRUNCATE
  387.       if ((arg[1].arg_type & A_MASK) == A_WORD) {
  388.       tmpstab = arg[1].arg_ptr.arg_stab;
  389. !     if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
  390.         ftruncate(fileno(stab_io(tmpstab)->ifp), len) < 0)
  391.           result = 0;
  392.       }
  393. ***************
  394. *** 873,879 ****
  395.   #else
  396.       if ((arg[1].arg_type & A_MASK) == A_WORD) {
  397.       tmpstab = arg[1].arg_ptr.arg_stab;
  398. !     if (!stab_io(tmpstab) ||
  399.         chsize(fileno(stab_io(tmpstab)->ifp), len) < 0)
  400.           result = 0;
  401.       }
  402. --- 902,908 ----
  403.   #else
  404.       if ((arg[1].arg_type & A_MASK) == A_WORD) {
  405.       tmpstab = arg[1].arg_ptr.arg_stab;
  406. !     if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
  407.         chsize(fileno(stab_io(tmpstab)->ifp), len) < 0)
  408.           result = 0;
  409.       }
  410. ***************
  411. *** 913,925 ****
  412.       return TRUE;
  413.       s = str->str_ptr; 
  414.       send = s + str->str_cur;
  415. !     while (isspace(*s))
  416.       s++;
  417.       if (s >= send)
  418.       return FALSE;
  419.       if (*s == '+' || *s == '-')
  420.       s++;
  421. !     while (isdigit(*s))
  422.       s++;
  423.       if (s == send)
  424.       return TRUE;
  425. --- 942,954 ----
  426.       return TRUE;
  427.       s = str->str_ptr; 
  428.       send = s + str->str_cur;
  429. !     while (isSPACE(*s))
  430.       s++;
  431.       if (s >= send)
  432.       return FALSE;
  433.       if (*s == '+' || *s == '-')
  434.       s++;
  435. !     while (isDIGIT(*s))
  436.       s++;
  437.       if (s == send)
  438.       return TRUE;
  439. ***************
  440. *** 927,933 ****
  441.       s++;
  442.       else if (s == str->str_ptr)
  443.       return FALSE;
  444. !     while (isdigit(*s))
  445.       s++;
  446.       if (s == send)
  447.       return TRUE;
  448. --- 956,962 ----
  449.       s++;
  450.       else if (s == str->str_ptr)
  451.       return FALSE;
  452. !     while (isDIGIT(*s))
  453.       s++;
  454.       if (s == send)
  455.       return TRUE;
  456. ***************
  457. *** 935,944 ****
  458.       s++;
  459.       if (*s == '+' || *s == '-')
  460.           s++;
  461. !     while (isdigit(*s))
  462.           s++;
  463.       }
  464. !     while (isspace(*s))
  465.       s++;
  466.       if (s >= send)
  467.       return TRUE;
  468. --- 964,973 ----
  469.       s++;
  470.       if (*s == '+' || *s == '-')
  471.           s++;
  472. !     while (isDIGIT(*s))
  473.           s++;
  474.       }
  475. !     while (isSPACE(*s))
  476.       s++;
  477.       if (s >= send)
  478.       return TRUE;
  479. ***************
  480. *** 955,960 ****
  481. --- 984,990 ----
  482.       if (!fp) {
  483.       if (dowarn)
  484.           warn("print to unopened file");
  485. +     errno = EBADF;
  486.       return FALSE;
  487.       }
  488.       if (!str)
  489. ***************
  490. *** 995,1000 ****
  491. --- 1025,1031 ----
  492.       if (!fp) {
  493.       if (dowarn)
  494.           warn("print to unopened file");
  495. +     errno = EBADF;
  496.       return FALSE;
  497.       }
  498.       st += ++sp;
  499. ***************
  500. *** 1028,1039 ****
  501.   {
  502.       STIO *stio;
  503.   
  504. -     laststype = O_STAT;
  505.       if (arg[1].arg_type & A_DONT) {
  506.       stio = stab_io(arg[1].arg_ptr.arg_stab);
  507.       if (stio && stio->ifp) {
  508.           statstab = arg[1].arg_ptr.arg_stab;
  509.           str_set(statname,"");
  510.           return (laststatval = fstat(fileno(stio->ifp), &statcache));
  511.       }
  512.       else {
  513. --- 1059,1070 ----
  514.   {
  515.       STIO *stio;
  516.   
  517.       if (arg[1].arg_type & A_DONT) {
  518.       stio = stab_io(arg[1].arg_ptr.arg_stab);
  519.       if (stio && stio->ifp) {
  520.           statstab = arg[1].arg_ptr.arg_stab;
  521.           str_set(statname,"");
  522. +         laststype = O_STAT;
  523.           return (laststatval = fstat(fileno(stio->ifp), &statcache));
  524.       }
  525.       else {
  526. ***************
  527. *** 1050,1055 ****
  528. --- 1081,1087 ----
  529.       else {
  530.       statstab = Nullstab;
  531.       str_set(statname,str_get(str));
  532. +     laststype = O_STAT;
  533.       return (laststatval = stat(str_get(str),&statcache));
  534.       }
  535.   }
  536. ***************
  537. *** 1107,1112 ****
  538. --- 1139,1146 ----
  539.       if (stio && stio->ifp) {
  540.   #ifdef STDSTDIO
  541.           fstat(fileno(stio->ifp),&statcache);
  542. +         if (S_ISDIR(statcache.st_mode))    /* handle NFS glitch */
  543. +         return arg->arg_type == O_FTTEXT ? &str_no : &str_yes;
  544.           if (stio->ifp->_cnt <= 0) {
  545.           i = getc(stio->ifp);
  546.           if (i != EOF)
  547. ***************
  548. *** 1117,1123 ****
  549.           len = stio->ifp->_cnt + (stio->ifp->_ptr - stio->ifp->_base);
  550.           s = stio->ifp->_base;
  551.   #else
  552. !         fatal("-T and -B not implemented on filehandles\n");
  553.   #endif
  554.       }
  555.       else {
  556. --- 1151,1157 ----
  557.           len = stio->ifp->_cnt + (stio->ifp->_ptr - stio->ifp->_base);
  558.           s = stio->ifp->_base;
  559.   #else
  560. !         fatal("-T and -B not implemented on filehandles");
  561.   #endif
  562.       }
  563.       else {
  564. ***************
  565. *** 1124,1129 ****
  566. --- 1158,1164 ----
  567.           if (dowarn)
  568.           warn("Test on unopened file <%s>",
  569.             stab_name(arg[1].arg_ptr.arg_stab));
  570. +         errno = EBADF;
  571.           return &str_undef;
  572.       }
  573.       }
  574. ***************
  575. *** 1137,1144 ****
  576.       fstat(i,&statcache);
  577.       len = read(i,tbuf,512);
  578.       (void)close(i);
  579. !     if (len <= 0)        /* null file is anything */
  580. !         return &str_yes;
  581.       s = tbuf;
  582.       }
  583.   
  584. --- 1172,1182 ----
  585.       fstat(i,&statcache);
  586.       len = read(i,tbuf,512);
  587.       (void)close(i);
  588. !     if (len <= 0) {
  589. !         if (S_ISDIR(statcache.st_mode) && arg->arg_type == O_FTTEXT)
  590. !         return &str_no;        /* special case NFS directories */
  591. !         return &str_yes;        /* null file is anything */
  592. !     }
  593.       s = tbuf;
  594.       }
  595.   
  596. ***************
  597. *** 1253,1263 ****
  598.   
  599.       /* see if there are shell metacharacters in it */
  600.   
  601. !     for (s = cmd; *s && isalpha(*s); s++) ;    /* catch VAR=val gizmo */
  602.       if (*s == '=')
  603.       goto doshell;
  604.       for (s = cmd; *s; s++) {
  605. !     if (*s != ' ' && !isalpha(*s) && index("$&*(){}[]'\";\\|?<>~`\n",*s)) {
  606.           if (*s == '\n' && !s[1]) {
  607.           *s = '\0';
  608.           break;
  609. --- 1291,1302 ----
  610.   
  611.       /* see if there are shell metacharacters in it */
  612.   
  613. !     /*SUPPRESS 530*/
  614. !     for (s = cmd; *s && isALPHA(*s); s++) ;    /* catch VAR=val gizmo */
  615.       if (*s == '=')
  616.       goto doshell;
  617.       for (s = cmd; *s; s++) {
  618. !     if (*s != ' ' && !isALPHA(*s) && index("$&*(){}[]'\";\\|?<>~`\n",*s)) {
  619.           if (*s == '\n' && !s[1]) {
  620.           *s = '\0';
  621.           break;
  622. ***************
  623. *** 1271,1280 ****
  624.       Cmd = nsavestr(cmd, s-cmd);
  625.       a = Argv;
  626.       for (s = Cmd; *s;) {
  627. !     while (*s && isspace(*s)) s++;
  628.       if (*s)
  629.           *(a++) = s;
  630. !     while (*s && !isspace(*s)) s++;
  631.       if (*s)
  632.           *s++ = '\0';
  633.       }
  634. --- 1310,1319 ----
  635.       Cmd = nsavestr(cmd, s-cmd);
  636.       a = Argv;
  637.       for (s = Cmd; *s;) {
  638. !     while (*s && isSPACE(*s)) s++;
  639.       if (*s)
  640.           *(a++) = s;
  641. !     while (*s && !isSPACE(*s)) s++;
  642.       if (*s)
  643.           *s++ = '\0';
  644.       }
  645. ***************
  646. *** 1301,1308 ****
  647.       register STIO *stio;
  648.       int domain, type, protocol, fd;
  649.   
  650. !     if (!stab)
  651.       return FALSE;
  652.   
  653.       stio = stab_io(stab);
  654.       if (!stio)
  655. --- 1340,1349 ----
  656.       register STIO *stio;
  657.       int domain, type, protocol, fd;
  658.   
  659. !     if (!stab) {
  660. !     errno = EBADF;
  661.       return FALSE;
  662. +     }
  663.   
  664.       stio = stab_io(stab);
  665.       if (!stio)
  666. ***************
  667. *** 1358,1363 ****
  668. --- 1399,1405 ----
  669.   nuts:
  670.       if (dowarn)
  671.       warn("bind() on closed fd");
  672. +     errno = EBADF;
  673.       return FALSE;
  674.   
  675.   }
  676. ***************
  677. *** 1388,1393 ****
  678. --- 1430,1436 ----
  679.   nuts:
  680.       if (dowarn)
  681.       warn("connect() on closed fd");
  682. +     errno = EBADF;
  683.       return FALSE;
  684.   
  685.   }
  686. ***************
  687. *** 1415,1420 ****
  688. --- 1458,1464 ----
  689.   nuts:
  690.       if (dowarn)
  691.       warn("listen() on closed fd");
  692. +     errno = EBADF;
  693.       return FALSE;
  694.   }
  695.   
  696. ***************
  697. *** 1463,1468 ****
  698. --- 1507,1513 ----
  699.   nuts:
  700.       if (dowarn)
  701.       warn("accept() on closed fd");
  702. +     errno = EBADF;
  703.   badexit:
  704.       str_sset(str,&str_undef);
  705.       return;
  706. ***************
  707. *** 1491,1496 ****
  708. --- 1536,1542 ----
  709.   nuts:
  710.       if (dowarn)
  711.       warn("shutdown() on closed fd");
  712. +     errno = EBADF;
  713.       return FALSE;
  714.   
  715.   }
  716. ***************
  717. *** 1520,1526 ****
  718.       optname = (int)str_gnum(st[sp+2]);
  719.       switch (optype) {
  720.       case O_GSOCKOPT:
  721. !     st[sp] = str_2mortal(str_new(257));
  722.       st[sp]->str_cur = 256;
  723.       st[sp]->str_pok = 1;
  724.       if (getsockopt(fd, lvl, optname, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
  725. --- 1566,1572 ----
  726.       optname = (int)str_gnum(st[sp+2]);
  727.       switch (optype) {
  728.       case O_GSOCKOPT:
  729. !     st[sp] = str_2mortal(Str_new(22,257));
  730.       st[sp]->str_cur = 256;
  731.       st[sp]->str_pok = 1;
  732.       if (getsockopt(fd, lvl, optname, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
  733. ***************
  734. *** 1540,1545 ****
  735. --- 1586,1592 ----
  736.       if (dowarn)
  737.       warn("[gs]etsockopt() on closed fd");
  738.       st[sp] = &str_undef;
  739. +     errno = EBADF;
  740.       return sp;
  741.   
  742.   }
  743. ***************
  744. *** 1562,1568 ****
  745.       if (!stio || !stio->ifp)
  746.       goto nuts;
  747.   
  748. !     st[sp] = str_2mortal(str_new(257));
  749.       st[sp]->str_cur = 256;
  750.       st[sp]->str_pok = 1;
  751.       fd = fileno(stio->ifp);
  752. --- 1609,1615 ----
  753.       if (!stio || !stio->ifp)
  754.       goto nuts;
  755.   
  756. !     st[sp] = str_2mortal(Str_new(22,257));
  757.       st[sp]->str_cur = 256;
  758.       st[sp]->str_pok = 1;
  759.       fd = fileno(stio->ifp);
  760. ***************
  761. *** 1582,1587 ****
  762. --- 1629,1635 ----
  763.   nuts:
  764.       if (dowarn)
  765.       warn("get{sock,peer}name() on closed fd");
  766. +     errno = EBADF;
  767.   nuts2:
  768.       st[sp] = &str_undef;
  769.       return sp;
  770. ***************
  771. *** 2208,2213 ****
  772. --- 2256,2262 ----
  773.       case O_READDIR:
  774.       if (gimme == G_ARRAY) {
  775.           --sp;
  776. +         /*SUPPRESS 560*/
  777.           while (dp = readdir(stio->dirp)) {
  778.   #ifdef DIRNAMLEN
  779.           (void)astore(ary,++sp,
  780. ***************
  781. *** 2258,2263 ****
  782. --- 2307,2314 ----
  783.   
  784.   nope:
  785.       st[sp] = &str_undef;
  786. +     if (!errno)
  787. +     errno = EBADF;
  788.       return sp;
  789.   
  790.   #else
  791. ***************
  792. *** 2323,2329 ****
  793.       if (--items > 0) {
  794.           tot = items;
  795.           s = str_get(st[++sp]);
  796. !         if (isupper(*s)) {
  797.           if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
  798.               s += 3;
  799.           if (!(val = whichsig(s)))
  800. --- 2374,2380 ----
  801.       if (--items > 0) {
  802.           tot = items;
  803.           s = str_get(st[++sp]);
  804. !         if (isUPPER(*s)) {
  805.           if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
  806.               s += 3;
  807.           if (!(val = whichsig(s)))
  808.  
  809. Index: dolist.c
  810. *** dolist.c.old    Tue Nov  5 19:26:07 1991
  811. --- dolist.c    Tue Nov  5 19:26:08 1991
  812. ***************
  813. *** 1,4 ****
  814. ! /* $RCSfile: dolist.c,v $$Revision: 4.0.1.2 $$Date: 91/06/10 01:22:15 $
  815.    *
  816.    *    Copyright (c) 1991, Larry Wall
  817.    *
  818. --- 1,4 ----
  819. ! /* $RCSfile: dolist.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:07:02 $
  820.    *
  821.    *    Copyright (c) 1991, Larry Wall
  822.    *
  823. ***************
  824. *** 6,11 ****
  825. --- 6,22 ----
  826.    *    License or the Artistic License, as specified in the README file.
  827.    *
  828.    * $Log:    dolist.c,v $
  829. +  * Revision 4.0.1.3  91/11/05  17:07:02  lwall
  830. +  * patch11: prepared for ctype implementations that don't define isascii()
  831. +  * patch11: /$foo/o optimizer could access deallocated data
  832. +  * patch11: certain optimizations of //g in array context returned too many values
  833. +  * patch11: regexp with no parens in array context returned wacky $`, $& and $'
  834. +  * patch11: $' not set right on some //g
  835. +  * patch11: added some support for 64-bit integers
  836. +  * patch11: grep of a split lost its values
  837. +  * patch11: added sort {} LIST
  838. +  * patch11: multiple reallocations now avoided in 1 .. 100000
  839. +  * 
  840.    * Revision 4.0.1.2  91/06/10  01:22:15  lwall
  841.    * patch10: //g only worked first time through
  842.    * 
  843. ***************
  844. *** 94,103 ****
  845.       if (!spat->spat_regexp->prelen && lastspat)
  846.           spat = lastspat;
  847.       if (spat->spat_flags & SPAT_KEEP) {
  848.           if (spat->spat_runtime)
  849.           arg_free(spat->spat_runtime);    /* it won't change, so */
  850.           spat->spat_runtime = Nullarg;    /* no point compiling again */
  851. -         scanconst(spat, t, tmpstr->str_cur);
  852.           hoistmust(spat);
  853.           if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
  854.           curcmd->c_flags &= ~CF_OPTIMIZE;
  855. --- 105,114 ----
  856.       if (!spat->spat_regexp->prelen && lastspat)
  857.           spat = lastspat;
  858.       if (spat->spat_flags & SPAT_KEEP) {
  859. +         scanconst(spat,spat->spat_regexp->precomp, spat->spat_regexp->prelen);
  860.           if (spat->spat_runtime)
  861.           arg_free(spat->spat_runtime);    /* it won't change, so */
  862.           spat->spat_runtime = Nullarg;    /* no point compiling again */
  863.           hoistmust(spat);
  864.           if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
  865.           curcmd->c_flags &= ~CF_OPTIMIZE;
  866. ***************
  867. *** 145,151 ****
  868.       t = s;
  869.       play_it_again:
  870.       if (global && spat->spat_regexp->startp[0])
  871. !         s = spat->spat_regexp->endp[0];
  872.       if (myhint) {
  873.           if (myhint < s || myhint > strend)
  874.           fatal("panic: hint in do_match");
  875. --- 156,162 ----
  876.       t = s;
  877.       play_it_again:
  878.       if (global && spat->spat_regexp->startp[0])
  879. !         t = s = spat->spat_regexp->endp[0];
  880.       if (myhint) {
  881.           if (myhint < s || myhint > strend)
  882.           fatal("panic: hint in do_match");
  883. ***************
  884. *** 192,199 ****
  885.           spat->spat_short = Nullstr;    /* opt is being useless */
  886.           }
  887.       }
  888. !     if (!spat->spat_regexp->nparens && !global)
  889.           gimme = G_SCALAR;            /* accidental array context? */
  890.       if (regexec(spat->spat_regexp, s, strend, t, 0,
  891.         srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
  892.         safebase)) {
  893. --- 203,212 ----
  894.           spat->spat_short = Nullstr;    /* opt is being useless */
  895.           }
  896.       }
  897. !     if (!spat->spat_regexp->nparens && !global) {
  898.           gimme = G_SCALAR;            /* accidental array context? */
  899. +         safebase = FALSE;
  900. +     }
  901.       if (regexec(spat->spat_regexp, s, strend, t, 0,
  902.         srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
  903.         safebase)) {
  904. ***************
  905. *** 233,238 ****
  906. --- 246,252 ----
  907.   
  908.       for (i = !i; i <= iters; i++) {
  909.           st[++sp] = str_mortal(&str_no);
  910. +         /*SUPPRESS 560*/
  911.           if (s = spat->spat_regexp->startp[i]) {
  912.           len = spat->spat_regexp->endp[i] - s;
  913.           if (len > 0)
  914. ***************
  915. *** 256,261 ****
  916. --- 270,277 ----
  917.       if (spat->spat_flags & SPAT_ONCE)
  918.       spat->spat_flags |= SPAT_USED;
  919.       if (global) {
  920. +     spat->spat_regexp->subbeg = t;
  921. +     spat->spat_regexp->subend = strend;
  922.       spat->spat_regexp->startp[0] = s;
  923.       spat->spat_regexp->endp[0] = s + spat->spat_short->str_cur;
  924.       curspat = spat;
  925. ***************
  926. *** 363,369 ****
  927.       ary = stack;
  928.       orig = s;
  929.       if (spat->spat_flags & SPAT_SKIPWHITE) {
  930. !     while (isascii(*s) && isspace(*s))
  931.           s++;
  932.       }
  933.       if (!limit)
  934. --- 379,385 ----
  935.       ary = stack;
  936.       orig = s;
  937.       if (spat->spat_flags & SPAT_SKIPWHITE) {
  938. !     while (isSPACE(*s))
  939.           s++;
  940.       }
  941.       if (!limit)
  942. ***************
  943. *** 370,376 ****
  944.       limit = maxiters + 2;
  945.       if (strEQ("\\s+",spat->spat_regexp->precomp)) {
  946.       while (--limit) {
  947. !         for (m = s; m < strend && !(isascii(*m)&&isspace(*m)); m++) ;
  948.           if (m >= strend)
  949.           break;
  950.           dstr = Str_new(30,m-s);
  951. --- 386,393 ----
  952.       limit = maxiters + 2;
  953.       if (strEQ("\\s+",spat->spat_regexp->precomp)) {
  954.       while (--limit) {
  955. !         /*SUPPRESS 530*/
  956. !         for (m = s; m < strend && !isSPACE(*m); m++) ;
  957.           if (m >= strend)
  958.           break;
  959.           dstr = Str_new(30,m-s);
  960. ***************
  961. *** 378,388 ****
  962.           if (!realarray)
  963.           str_2mortal(dstr);
  964.           (void)astore(ary, ++sp, dstr);
  965. !         for (s = m + 1; s < strend && isascii(*s) && isspace(*s); s++) ;
  966.       }
  967.       }
  968.       else if (strEQ("^",spat->spat_regexp->precomp)) {
  969.       while (--limit) {
  970.           for (m = s; m < strend && *m != '\n'; m++) ;
  971.           m++;
  972.           if (m >= strend)
  973. --- 395,407 ----
  974.           if (!realarray)
  975.           str_2mortal(dstr);
  976.           (void)astore(ary, ++sp, dstr);
  977. !         /*SUPPRESS 530*/
  978. !         for (s = m + 1; s < strend && isSPACE(*s); s++) ;
  979.       }
  980.       }
  981.       else if (strEQ("^",spat->spat_regexp->precomp)) {
  982.       while (--limit) {
  983. +         /*SUPPRESS 530*/
  984.           for (m = s; m < strend && *m != '\n'; m++) ;
  985.           m++;
  986.           if (m >= strend)
  987. ***************
  988. *** 401,417 ****
  989.           int fold = (spat->spat_flags & SPAT_FOLD);
  990.   
  991.           i = *spat->spat_short->str_ptr;
  992. !         if (fold && isupper(i))
  993.           i = tolower(i);
  994.           while (--limit) {
  995.           if (fold) {
  996.               for ( m = s;
  997.                 m < strend && *m != i &&
  998. !                 (!isupper(*m) || tolower(*m) != i);
  999. !               m++)
  1000.               ;
  1001.           }
  1002. !         else
  1003.               for (m = s; m < strend && *m != i; m++) ;
  1004.           if (m >= strend)
  1005.               break;
  1006. --- 420,436 ----
  1007.           int fold = (spat->spat_flags & SPAT_FOLD);
  1008.   
  1009.           i = *spat->spat_short->str_ptr;
  1010. !         if (fold && isUPPER(i))
  1011.           i = tolower(i);
  1012.           while (--limit) {
  1013.           if (fold) {
  1014.               for ( m = s;
  1015.                 m < strend && *m != i &&
  1016. !                 (!isUPPER(*m) || tolower(*m) != i);
  1017. !               m++)            /*SUPPRESS 530*/
  1018.               ;
  1019.           }
  1020. !         else                /*SUPPRESS 530*/
  1021.               for (m = s; m < strend && *m != i; m++) ;
  1022.           if (m >= strend)
  1023.               break;
  1024. ***************
  1025. *** 548,556 ****
  1026. --- 567,581 ----
  1027.       short ashort;
  1028.       int aint;
  1029.       long along;
  1030. + #ifdef QUAD
  1031. +     quad aquad;
  1032. + #endif
  1033.       unsigned short aushort;
  1034.       unsigned int auint;
  1035.       unsigned long aulong;
  1036. + #ifdef QUAD
  1037. +     unsigned quad auquad;
  1038. + #endif
  1039.       char *aptr;
  1040.       float afloat;
  1041.       double adouble;
  1042. ***************
  1043. *** 559,568 ****
  1044.       double cdouble;
  1045.   
  1046.       if (gimme != G_ARRAY) {        /* arrange to do first one only */
  1047. !     for (patend = pat; !isalpha(*patend); patend++);
  1048.       if (index("aAbBhH", *patend) || *pat == '%') {
  1049.           patend++;
  1050. !         while (isdigit(*patend) || *patend == '*')
  1051.           patend++;
  1052.       }
  1053.       else
  1054. --- 584,594 ----
  1055.       double cdouble;
  1056.   
  1057.       if (gimme != G_ARRAY) {        /* arrange to do first one only */
  1058. !     /*SUPPRESS 530*/
  1059. !     for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
  1060.       if (index("aAbBhH", *patend) || *pat == '%') {
  1061.           patend++;
  1062. !         while (isDIGIT(*patend) || *patend == '*')
  1063.           patend++;
  1064.       }
  1065.       else
  1066. ***************
  1067. *** 578,586 ****
  1068.           len = strend - strbeg;    /* long enough */
  1069.           pat++;
  1070.       }
  1071. !     else if (isdigit(*pat)) {
  1072.           len = *pat++ - '0';
  1073. !         while (isdigit(*pat))
  1074.           len = (len * 10) + (*pat++ - '0');
  1075.       }
  1076.       else
  1077. --- 604,612 ----
  1078.           len = strend - strbeg;    /* long enough */
  1079.           pat++;
  1080.       }
  1081. !     else if (isDIGIT(*pat)) {
  1082.           len = *pat++ - '0';
  1083. !         while (isDIGIT(*pat))
  1084.           len = (len * 10) + (*pat++ - '0');
  1085.       }
  1086.       else
  1087. ***************
  1088. *** 624,630 ****
  1089.           if (datumtype == 'A') {
  1090.           aptr = s;    /* borrow register */
  1091.           s = str->str_ptr + len - 1;
  1092. !         while (s >= str->str_ptr && (!*s || (isascii(*s)&&isspace(*s))))
  1093.               s--;
  1094.           *++s = '\0';
  1095.           str->str_cur = s - str->str_ptr;
  1096. --- 650,656 ----
  1097.           if (datumtype == 'A') {
  1098.           aptr = s;    /* borrow register */
  1099.           s = str->str_ptr + len - 1;
  1100. !         while (s >= str->str_ptr && (!*s || isSPACE(*s)))
  1101.               s--;
  1102.           *++s = '\0';
  1103.           str->str_cur = s - str->str_ptr;
  1104. ***************
  1105. *** 644,650 ****
  1106.           if (datumtype == 'b') {
  1107.           aint = len;
  1108.           for (len = 0; len < aint; len++) {
  1109. !             if (len & 7)
  1110.               bits >>= 1;
  1111.               else
  1112.               bits = *s++;
  1113. --- 670,676 ----
  1114.           if (datumtype == 'b') {
  1115.           aint = len;
  1116.           for (len = 0; len < aint; len++) {
  1117. !             if (len & 7)        /*SUPPRESS 595*/
  1118.               bits >>= 1;
  1119.               else
  1120.               bits = *s++;
  1121. ***************
  1122. *** 912,917 ****
  1123. --- 938,971 ----
  1124.           (void)astore(stack, ++sp, str_2mortal(str));
  1125.           }
  1126.           break;
  1127. + #ifdef QUAD
  1128. +     case 'q':
  1129. +         while (len-- > 0) {
  1130. +         if (s + sizeof(quad) > strend)
  1131. +             aquad = 0;
  1132. +         else {
  1133. +             bcopy(s,(char*)&aquad,sizeof(quad));
  1134. +             s += sizeof(quad);
  1135. +         }
  1136. +         str = Str_new(42,0);
  1137. +         str_numset(str,(double)aquad);
  1138. +         (void)astore(stack, ++sp, str_2mortal(str));
  1139. +         }
  1140. +         break;
  1141. +     case 'Q':
  1142. +         while (len-- > 0) {
  1143. +         if (s + sizeof(unsigned quad) > strend)
  1144. +             auquad = 0;
  1145. +         else {
  1146. +             bcopy(s,(char*)&auquad,sizeof(unsigned quad));
  1147. +             s += sizeof(unsigned quad);
  1148. +         }
  1149. +         str = Str_new(43,0);
  1150. +         str_numset(str,(double)auquad);
  1151. +         (void)astore(stack, ++sp, str_2mortal(str));
  1152. +         }
  1153. +         break;
  1154. + #endif
  1155.       /* float and double added gnb@melba.bby.oz.au 22/11/89 */
  1156.       case 'f':
  1157.       case 'F':
  1158. ***************
  1159. *** 1158,1168 ****
  1160.           length = 0;
  1161.       }
  1162.       else
  1163. !         length = ary->ary_max;        /* close enough to infinity */
  1164.       }
  1165.       else {
  1166.       offset = 0;
  1167. !     length = ary->ary_max;
  1168.       }
  1169.       if (offset < 0) {
  1170.       length += offset;
  1171. --- 1212,1222 ----
  1172.           length = 0;
  1173.       }
  1174.       else
  1175. !         length = ary->ary_max + 1;        /* close enough to infinity */
  1176.       }
  1177.       else {
  1178.       offset = 0;
  1179. !     length = ary->ary_max + 1;
  1180.       }
  1181.       if (offset < 0) {
  1182.       length += offset;
  1183. ***************
  1184. *** 1335,1342 ****
  1185.       }
  1186.       arg = arg[1].arg_ptr.arg_arg;
  1187.       while (i-- > 0) {
  1188. !     if (st[src])
  1189.           stab_val(defstab) = st[src];
  1190.       else
  1191.           stab_val(defstab) = str_mortal(&str_undef);
  1192.       (void)eval(arg,G_SCALAR,sp);
  1193. --- 1389,1398 ----
  1194.       }
  1195.       arg = arg[1].arg_ptr.arg_arg;
  1196.       while (i-- > 0) {
  1197. !     if (st[src]) {
  1198. !         st[src]->str_pok &= ~SP_TEMP;
  1199.           stab_val(defstab) = st[src];
  1200. +     }
  1201.       else
  1202.           stab_val(defstab) = str_mortal(&str_undef);
  1203.       (void)eval(arg,G_SCALAR,sp);
  1204. ***************
  1205. *** 1407,1415 ****
  1206.   static STAB *secondstab = Nullstab;
  1207.   
  1208.   int
  1209. ! do_sort(str,stab,gimme,arglast)
  1210.   STR *str;
  1211. ! STAB *stab;
  1212.   int gimme;
  1213.   int *arglast;
  1214.   {
  1215. --- 1463,1471 ----
  1216.   static STAB *secondstab = Nullstab;
  1217.   
  1218.   int
  1219. ! do_sort(str,arg,gimme,arglast)
  1220.   STR *str;
  1221. ! ARG *arg;
  1222.   int gimme;
  1223.   int *arglast;
  1224.   {
  1225. ***************
  1226. *** 1423,1428 ****
  1227. --- 1479,1485 ----
  1228.       STR *oldfirst;
  1229.       STR *oldsecond;
  1230.       ARRAY *oldstack;
  1231. +     HASH *stash;
  1232.       static ARRAY *sortstack = Null(ARRAY*);
  1233.   
  1234.       if (gimme != G_ARRAY) {
  1235. ***************
  1236. *** 1434,1439 ****
  1237. --- 1491,1497 ----
  1238.       up = &st[sp];
  1239.       st += sp;        /* temporarily make st point to args */
  1240.       for (i = 1; i <= max; i++) {
  1241. +     /*SUPPRESS 560*/
  1242.       if (*up = st[i]) {
  1243.           if (!(*up)->str_pok)
  1244.           (void)str_2ptr(*up);
  1245. ***************
  1246. *** 1446,1456 ****
  1247.       max = up - &st[sp];
  1248.       sp--;
  1249.       if (max > 1) {
  1250. !     if (stab) {
  1251.           int oldtmps_base = tmps_base;
  1252.   
  1253. -         if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
  1254. -         fatal("Undefined subroutine \"%s\" in sort", stab_name(stab));
  1255.           if (!sortstack) {
  1256.           sortstack = anew(Nullstab);
  1257.           astore(sortstack, 0, Nullstr);
  1258. --- 1504,1534 ----
  1259.       max = up - &st[sp];
  1260.       sp--;
  1261.       if (max > 1) {
  1262. !     STAB *stab;
  1263. ! 
  1264. !     if (arg[1].arg_type == (A_CMD|A_DONT)) {
  1265. !         sortcmd = arg[1].arg_ptr.arg_cmd;
  1266. !         stash = curcmd->c_stash;
  1267. !     }
  1268. !     else {
  1269. !         if ((arg[1].arg_type & A_MASK) == A_WORD)
  1270. !         stab = arg[1].arg_ptr.arg_stab;
  1271. !         else
  1272. !         stab = stabent(str_get(st[sp+1]),TRUE);
  1273. ! 
  1274. !         if (stab) {
  1275. !         if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
  1276. !             fatal("Undefined subroutine \"%s\" in sort", 
  1277. !             stab_name(stab));
  1278. !         stash = stab_stash(stab);
  1279. !         }
  1280. !         else
  1281. !         sortcmd = Nullcmd;
  1282. !     }
  1283. ! 
  1284. !     if (sortcmd) {
  1285.           int oldtmps_base = tmps_base;
  1286.   
  1287.           if (!sortstack) {
  1288.           sortstack = anew(Nullstab);
  1289.           astore(sortstack, 0, Nullstr);
  1290. ***************
  1291. *** 1460,1469 ****
  1292.           oldstack = stack;
  1293.           stack = sortstack;
  1294.           tmps_base = tmps_max;
  1295. !         if (sortstash != stab_stash(stab)) {
  1296.           firststab = stabent("a",TRUE);
  1297.           secondstab = stabent("b",TRUE);
  1298. !         sortstash = stab_stash(stab);
  1299.           }
  1300.           oldfirst = stab_val(firststab);
  1301.           oldsecond = stab_val(secondstab);
  1302. --- 1538,1547 ----
  1303.           oldstack = stack;
  1304.           stack = sortstack;
  1305.           tmps_base = tmps_max;
  1306. !         if (sortstash != stash) {
  1307.           firststab = stabent("a",TRUE);
  1308.           secondstab = stabent("b",TRUE);
  1309. !         sortstash = stash;
  1310.           }
  1311.           oldfirst = stab_val(firststab);
  1312.           oldsecond = stab_val(secondstab);
  1313. ***************
  1314. *** 1505,1515 ****
  1315. --- 1583,1595 ----
  1316.       int retval;
  1317.   
  1318.       if (str1->str_cur < str2->str_cur) {
  1319. +     /*SUPPRESS 560*/
  1320.       if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
  1321.           return retval;
  1322.       else
  1323.           return -1;
  1324.       }
  1325. +     /*SUPPRESS 560*/
  1326.       else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
  1327.       return retval;
  1328.       else if (str1->str_cur == str2->str_cur)
  1329. ***************
  1330. *** 1537,1542 ****
  1331. --- 1617,1624 ----
  1332.         (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) {
  1333.       i = (int)str_gnum(st[sp+1]);
  1334.       max = (int)str_gnum(st[sp+2]);
  1335. +     if (max > i)
  1336. +         (void)astore(ary, sp + max - i + 1, Nullstr);
  1337.       while (i <= max) {
  1338.           (void)astore(ary, ++sp, str = str_mortal(&str_no));
  1339.           str_numset(str,(double)i++);
  1340. ***************
  1341. *** 1567,1573 ****
  1342.       register int sp = arglast[0];
  1343.       register int items = arglast[1] - sp;
  1344.       register int count = (int) str_gnum(st[arglast[2]]);
  1345. -     register ARRAY *ary = stack;
  1346.       register int i;
  1347.       int max;
  1348.   
  1349. --- 1649,1654 ----
  1350. ***************
  1351. *** 1639,1645 ****
  1352.         str_2mortal(str_nmake((double)csv->wantarray)) );
  1353.       if (csv->hasargs) {
  1354.       ARRAY *ary = csv->argarray;
  1355. -     STAB *tmpstab;
  1356.   
  1357.       if (!dbargs)
  1358.           dbargs = stab_xarray(aadd(stabent("DB'args", TRUE)));
  1359. --- 1720,1725 ----
  1360. ***************
  1361. *** 1750,1755 ****
  1362. --- 1830,1836 ----
  1363.       return sp;
  1364.       }
  1365.       (void)hiterinit(hash);
  1366. +     /*SUPPRESS 560*/
  1367.       while (entry = hiternext(hash)) {
  1368.       if (dokeys) {
  1369.           tmps = hiterkey(entry,&i);
  1370.  
  1371. Index: eval.c
  1372. *** eval.c.old    Tue Nov  5 19:26:12 1991
  1373. --- eval.c    Tue Nov  5 19:26:13 1991
  1374. ***************
  1375. *** 1,4 ****
  1376. ! /* $RCSfile: eval.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 11:07:23 $
  1377.    *
  1378.    *    Copyright (c) 1991, Larry Wall
  1379.    *
  1380. --- 1,4 ----
  1381. ! /* $RCSfile: eval.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 17:15:21 $
  1382.    *
  1383.    *    Copyright (c) 1991, Larry Wall
  1384.    *
  1385. ***************
  1386. *** 6,11 ****
  1387. --- 6,21 ----
  1388.    *    License or the Artistic License, as specified in the README file.
  1389.    *
  1390.    * $Log:    eval.c,v $
  1391. +  * Revision 4.0.1.3  91/11/05  17:15:21  lwall
  1392. +  * patch11: prepared for ctype implementations that don't define isascii()
  1393. +  * patch11: various portability fixes
  1394. +  * patch11: added sort {} LIST
  1395. +  * patch11: added eval {}
  1396. +  * patch11: sysread() in socket was substituting recv()
  1397. +  * patch11: a last statement outside any block caused occasional core dumps
  1398. +  * patch11: missing arguments caused core dump in -D8 code
  1399. +  * patch11: eval 'stuff' now optimized to eval {stuff}
  1400. +  * 
  1401.    * Revision 4.0.1.2  91/06/07  11:07:23  lwall
  1402.    * patch4: new copyright notice
  1403.    * patch4: length($`), length($&), length($') now optimized to avoid string copy
  1404. ***************
  1405. *** 326,331 ****
  1406. --- 336,342 ----
  1407.           if (fp) {
  1408.           if (gimme == G_SCALAR) {
  1409.               while (str_gets(str,fp,str->str_cur) != Nullch)
  1410. +             /*SUPPRESS 530*/
  1411.               ;
  1412.           }
  1413.           else {
  1414. ***************
  1415. *** 490,496 ****
  1416.               else
  1417.               str->str_cur++;
  1418.               for (tmps = str->str_ptr; *tmps; tmps++)
  1419. !             if (!isalpha(*tmps) && !isdigit(*tmps) &&
  1420.                   index("$&*(){}[]'\";\\|?<>~`",*tmps))
  1421.                   break;
  1422.               if (*tmps && stat(str->str_ptr,&statbuf) < 0)
  1423. --- 501,507 ----
  1424.               else
  1425.               str->str_cur++;
  1426.               for (tmps = str->str_ptr; *tmps; tmps++)
  1427. !             if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
  1428.                   index("$&*(){}[]'\";\\|?<>~`",*tmps))
  1429.                   break;
  1430.               if (*tmps && stat(str->str_ptr,&statbuf) < 0)
  1431. ***************
  1432. *** 694,700 ****
  1433.       case O_DIVIDE:
  1434.       if ((value = str_gnum(st[2])) == 0.0)
  1435.           fatal("Illegal division by zero");
  1436. ! #ifdef cray
  1437.       /* insure that 20./5. == 4. */
  1438.       {
  1439.           double x;
  1440. --- 705,711 ----
  1441.       case O_DIVIDE:
  1442.       if ((value = str_gnum(st[2])) == 0.0)
  1443.           fatal("Illegal division by zero");
  1444. ! #ifdef SLOPPYDIVIDE
  1445.       /* insure that 20./5. == 4. */
  1446.       {
  1447.           double x;
  1448. ***************
  1449. *** 884,890 ****
  1450. --- 895,905 ----
  1451.       value = -str_gnum(st[1]);
  1452.       goto donumset;
  1453.       case O_NOT:
  1454. + #ifdef NOTNOT
  1455. +     { char xxx = str_true(st[1]); value = (double) !xxx; }
  1456. + #else
  1457.       value = (double) !str_true(st[1]);
  1458. + #endif
  1459.       goto donumset;
  1460.       case O_COMPLEMENT:
  1461.       if (!sawvec || st[1]->str_nok) {
  1462. ***************
  1463. *** 1179,1184 ****
  1464. --- 1194,1200 ----
  1465.       case O_SUBSTR:
  1466.       anum = ((int)str_gnum(st[2])) - arybase;    /* anum=where to start*/
  1467.       tmps = str_get(st[1]);        /* force conversion to string */
  1468. +     /*SUPPRESS 560*/
  1469.       if (argtype = (str == st[1]))
  1470.           str = arg->arg_ptr.arg_str;
  1471.       if (anum < 0)
  1472. ***************
  1473. *** 1204,1209 ****
  1474. --- 1220,1226 ----
  1475.       }
  1476.       break;
  1477.       case O_PACK:
  1478. +     /*SUPPRESS 701*/
  1479.       (void)do_pack(str,arglast);
  1480.       break;
  1481.       case O_GREP:
  1482. ***************
  1483. *** 1253,1263 ****
  1484.       st = stack->ary_array + arglast[0];        /* maybe realloced */
  1485.       goto array_return;
  1486.       case O_SORT:
  1487. !     if ((arg[1].arg_type & A_MASK) == A_WORD)
  1488. !         stab = arg[1].arg_ptr.arg_stab;
  1489. !     else
  1490. !         stab = stabent(str_get(st[1]),TRUE);
  1491. !     sp = do_sort(str,stab,
  1492.         gimme,arglast);
  1493.       goto array_return;
  1494.       case O_REVERSE:
  1495. --- 1270,1276 ----
  1496.       st = stack->ary_array + arglast[0];        /* maybe realloced */
  1497.       goto array_return;
  1498.       case O_SORT:
  1499. !     sp = do_sort(str,arg,
  1500.         gimme,arglast);
  1501.       goto array_return;
  1502.       case O_REVERSE:
  1503. ***************
  1504. *** 1451,1456 ****
  1505. --- 1464,1473 ----
  1506.           goto badsock;
  1507.   #endif
  1508.       STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2]));  /* sneaky */
  1509. +     if (optype == O_SYSREAD) {
  1510. +         anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
  1511. +     }
  1512. +     else
  1513.   #ifdef HAS_SOCKET
  1514.       if (stab_io(stab)->type == 's') {
  1515.           argtype = sizeof buf;
  1516. ***************
  1517. *** 1459,1468 ****
  1518.       }
  1519.       else
  1520.   #endif
  1521. -     if (optype == O_SYSREAD) {
  1522. -         anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum);
  1523. -     }
  1524. -     else
  1525.           anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp);
  1526.       if (anum < 0)
  1527.           goto say_undef;
  1528. --- 1476,1481 ----
  1529. ***************
  1530. *** 1541,1546 ****
  1531. --- 1554,1560 ----
  1532.       case O_REDO:
  1533.       case O_NEXT:
  1534.       case O_LAST:
  1535. +     tmps = Nullch;
  1536.       if (maxarg > 0) {
  1537.           tmps = str_get(arg[1].arg_ptr.arg_str);
  1538.         dopop:
  1539. ***************
  1540. *** 1887,1895 ****
  1541.       if (anum < 0)
  1542.           goto say_undef;
  1543.       if (!anum) {
  1544.           if (tmpstab = stabent("$",allstabs))
  1545.           str_numset(STAB_STR(tmpstab),(double)getpid());
  1546. !         hclear(pidstatus);    /* no kids, so don't wait for 'em */
  1547.       }
  1548.       value = (double)anum;
  1549.       goto donumset;
  1550. --- 1901,1910 ----
  1551.       if (anum < 0)
  1552.           goto say_undef;
  1553.       if (!anum) {
  1554. +         /*SUPPRESS 560*/
  1555.           if (tmpstab = stabent("$",allstabs))
  1556.           str_numset(STAB_STR(tmpstab),(double)getpid());
  1557. !         hclear(pidstatus, FALSE);    /* no kids, so don't wait for 'em */
  1558.       }
  1559.       value = (double)anum;
  1560.       goto donumset;
  1561. ***************
  1562. *** 2005,2011 ****
  1563.           tmps = str_get(stab_val(defstab));
  1564.       else
  1565.           tmps = str_get(st[1]);
  1566. !     while (*tmps && isascii(*tmps) && (isspace(*tmps) || *tmps == '0'))
  1567.           tmps++;
  1568.       if (*tmps == 'x')
  1569.           value = (double)scanhex(++tmps, 99, &argtype);
  1570. --- 2020,2026 ----
  1571.           tmps = str_get(stab_val(defstab));
  1572.       else
  1573.           tmps = str_get(st[1]);
  1574. !     while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
  1575.           tmps++;
  1576.       if (*tmps == 'x')
  1577.           value = (double)scanhex(++tmps, 99, &argtype);
  1578. ***************
  1579. *** 2014,2020 ****
  1580.       goto donumset;
  1581.   
  1582.   /* These common exits are hidden here in the middle of the switches for the
  1583. ! /* benefit of those machines with limited branch addressing.  Sigh.  */
  1584.   
  1585.   array_return:
  1586.   #ifdef DEBUGGING
  1587. --- 2029,2035 ----
  1588.       goto donumset;
  1589.   
  1590.   /* These common exits are hidden here in the middle of the switches for the
  1591. !    benefit of those machines with limited branch addressing.  Sigh.  */
  1592.   
  1593.   array_return:
  1594.   #ifdef DEBUGGING
  1595. ***************
  1596. *** 2027,2038 ****
  1597.           deb("%s RETURNS ()\n",opname[optype]);
  1598.           break;
  1599.           case 1:
  1600. !         deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1]));
  1601.           break;
  1602.           default:
  1603. !         tmps = str_get(st[1]);
  1604.           deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
  1605. !           anum,tmps,anum==2?"":"...,",str_get(st[anum]));
  1606.           break;
  1607.           }
  1608.       }
  1609. --- 2042,2055 ----
  1610.           deb("%s RETURNS ()\n",opname[optype]);
  1611.           break;
  1612.           case 1:
  1613. !         deb("%s RETURNS (\"%s\")\n",opname[optype],
  1614. !             st[1] ? str_get(st[1]) : "");
  1615.           break;
  1616.           default:
  1617. !         tmps = st[1] ? str_get(st[1]) : "";
  1618.           deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
  1619. !           anum,tmps,anum==2?"":"...,",
  1620. !             st[anum] ? str_get(st[anum]) : "");
  1621.           break;
  1622.           }
  1623.       }
  1624. ***************
  1625. *** 2410,2415 ****
  1626. --- 2427,2448 ----
  1627.       value = (double)(ary->ary_fill + 1);
  1628.       goto donumset;
  1629.   
  1630. +     case O_TRY:
  1631. +     sp = do_try(arg[1].arg_ptr.arg_cmd,
  1632. +         gimme,arglast);
  1633. +     goto array_return;
  1634. + 
  1635. +     case O_EVALONCE:
  1636. +     sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE,
  1637. +         gimme,arglast);
  1638. +     if (eval_root) {
  1639. +         str_free(arg[1].arg_ptr.arg_str);
  1640. +         arg[1].arg_ptr.arg_cmd = eval_root;
  1641. +         arg[1].arg_type = (A_CMD|A_DONT);
  1642. +         arg[0].arg_type = O_TRY;
  1643. +     }
  1644. +     goto array_return;
  1645. + 
  1646.       case O_REQUIRE:
  1647.       case O_DOFILE:
  1648.       case O_EVAL:
  1649. ***************
  1650. *** 2422,2428 ****
  1651.       tainted |= tmpstr->str_tainted;
  1652.       taintproper("Insecure dependency in eval");
  1653.   #endif
  1654. !     sp = do_eval(tmpstr, optype, curcmd->c_stash,
  1655.           gimme,arglast);
  1656.       goto array_return;
  1657.   
  1658. --- 2455,2461 ----
  1659.       tainted |= tmpstr->str_tainted;
  1660.       taintproper("Insecure dependency in eval");
  1661.   #endif
  1662. !     sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE,
  1663.           gimme,arglast);
  1664.       goto array_return;
  1665.   
  1666. ***************
  1667. *** 2598,2604 ****
  1668.           stab = stabent(tmps = str_get(st[1]),FALSE);
  1669.       if (stab && stab_io(stab) && stab_io(stab)->ifp)
  1670.           anum = fileno(stab_io(stab)->ifp);
  1671. !     else if (isdigit(*tmps))
  1672.           anum = atoi(tmps);
  1673.       else
  1674.           goto say_undef;
  1675. --- 2631,2637 ----
  1676.           stab = stabent(tmps = str_get(st[1]),FALSE);
  1677.       if (stab && stab_io(stab) && stab_io(stab)->ifp)
  1678.           anum = fileno(stab_io(stab)->ifp);
  1679. !     else if (isDIGIT(*tmps))
  1680.           anum = atoi(tmps);
  1681.       else
  1682.           goto say_undef;
  1683.  
  1684. Index: t/op/eval.t
  1685. Prereq: 4.0
  1686. *** t/op/eval.t.old    Tue Nov  5 19:28:02 1991
  1687. --- t/op/eval.t    Tue Nov  5 19:28:02 1991
  1688. ***************
  1689. *** 1,8 ****
  1690.   #!./perl
  1691.   
  1692. ! # $Header: eval.t,v 4.0 91/03/20 01:52:20 lwall Locked $
  1693.   
  1694. ! print "1..10\n";
  1695.   
  1696.   eval 'print "ok 1\n";';
  1697.   
  1698. --- 1,8 ----
  1699.   #!./perl
  1700.   
  1701. ! # $RCSfile: eval.t,v $$Revision: 4.0.1.1 $$Date: 91/11/05 18:43:19 $
  1702.   
  1703. ! print "1..16\n";
  1704.   
  1705.   eval 'print "ok 1\n";';
  1706.   
  1707. ***************
  1708. *** 40,42 ****
  1709. --- 40,57 ----
  1710.   close try;
  1711.   
  1712.   do 'Op.eval'; print $@;
  1713. + 
  1714. + # Test the singlequoted eval optimizer
  1715. + 
  1716. + $i = 11;
  1717. + for (1..3) {
  1718. +     eval 'print "ok ", $i++, "\n"';
  1719. + }
  1720. + 
  1721. + eval {
  1722. +     print "ok 14\n";
  1723. +     die "ok 16\n";
  1724. +     1;
  1725. + } || print "ok 15\n$@";
  1726. + 
  1727. + 
  1728.  
  1729. Index: lib/exceptions.pl
  1730. *** lib/exceptions.pl.old    Tue Nov  5 19:26:56 1991
  1731. --- lib/exceptions.pl    Tue Nov  5 19:26:56 1991
  1732. ***************
  1733. *** 0 ****
  1734. --- 1,54 ----
  1735. + # exceptions.pl
  1736. + # tchrist@convex.com
  1737. + # 
  1738. + # Here's a little code I use for exception handling.  It's really just
  1739. + # glorfied eval/die.  The way to use use it is when you might otherwise
  1740. + # exit, use &throw to raise an exception.  The first enclosing &catch
  1741. + # handler looks at the exception and decides whether it can catch this kind
  1742. + # (catch takes a list of regexps to catch), and if so, it returns the one it
  1743. + # caught.  If it *can't* catch it, then it will reraise the exception
  1744. + # for someone else to possibly see, or to die otherwise.
  1745. + # 
  1746. + # I use oddly named variables in order to make darn sure I don't conflict 
  1747. + # with my caller.  I also hide in my own package, and eval the code in his.
  1748. + # 
  1749. + # The EXCEPTION: prefix is so you can tell whether it's a user-raised
  1750. + # exception or a perl-raised one (eval error).
  1751. + # 
  1752. + # --tom
  1753. + #
  1754. + # examples:
  1755. + #    if (&catch('/$user_input/', 'regexp', 'syntax error') {
  1756. + #        warn "oops try again";
  1757. + #        redo;
  1758. + #    }
  1759. + #
  1760. + #    if ($error = &catch('&subroutine()')) { # catches anything
  1761. + #
  1762. + #    &throw('bad input') if /^$/;
  1763. + 
  1764. + sub catch {
  1765. +     package exception;
  1766. +     local($__code__, @__exceptions__) = @_;
  1767. +     local($__package__) = caller;
  1768. +     local($__exception__);
  1769. + 
  1770. +     eval "package $__package__; $__code__";
  1771. +     if ($__exception__ = &'thrown) {
  1772. +     for (@__exceptions__) {
  1773. +         return $__exception__ if /$__exception__/;
  1774. +     } 
  1775. +     &'throw($__exception__);
  1776. +     } 
  1777. + } 
  1778. + 
  1779. + sub throw {
  1780. +     local($exception) = @_;
  1781. +     die "EXCEPTION: $exception\n";
  1782. + } 
  1783. + 
  1784. + sub thrown {
  1785. +     $@ =~ /^(EXCEPTION: )+(.+)/ && $2;
  1786. + } 
  1787. + 
  1788. + 1;
  1789.  
  1790. Index: lib/fastcwd.pl
  1791. *** lib/fastcwd.pl.old    Tue Nov  5 19:26:57 1991
  1792. --- lib/fastcwd.pl    Tue Nov  5 19:26:58 1991
  1793. ***************
  1794. *** 0 ****
  1795. --- 1,35 ----
  1796. + # By John Bazik
  1797. + #
  1798. + # Usage: $cwd = &fastcwd;
  1799. + #
  1800. + # This is a faster version of getcwd.  It's also more dangerous because
  1801. + # you might chdir out of a directory that you can't chdir back into.
  1802. + 
  1803. + sub fastcwd {
  1804. +     local($odev, $oino, $cdev, $cino, $tdev, $tino);
  1805. +     local(@path, $path);
  1806. +     local(*DIR);
  1807. + 
  1808. +     ($cdev, $cino) = stat('.');
  1809. +     for (;;) {
  1810. +         ($odev, $oino) = ($cdev, $cino);
  1811. +         chdir('..');
  1812. +         ($cdev, $cino) = stat('.');
  1813. +         last if $odev == $cdev && $oino == $cino;
  1814. +         opendir(DIR, '.');
  1815. +         for (;;) {
  1816. +             $_ = readdir(DIR);
  1817. +             next if $_ eq '.';
  1818. +             next if $_ eq '..';
  1819. + 
  1820. +             last unless $_;
  1821. +             ($tdev, $tino) = lstat($_);
  1822. +             last unless $tdev != $odev || $tino != $oino;
  1823. +         }
  1824. +         closedir(DIR);
  1825. +         unshift(@path, $_);
  1826. +     }
  1827. +     chdir($path = '/' . join('/', @path));
  1828. +     $path;
  1829. + }
  1830. + 1;
  1831.  
  1832. Index: x2p/find2perl.SH
  1833. *** x2p/find2perl.SH.old    Tue Nov  5 19:28:35 1991
  1834. --- x2p/find2perl.SH    Tue Nov  5 19:28:36 1991
  1835. ***************
  1836. *** 96,102 ****
  1837.       }
  1838.       elsif ($_ eq 'group') {
  1839.       $gname = shift;
  1840. !     $out .= &tab . "\$gid == \$gid('$gname')";
  1841.       $initgroup++;
  1842.       }
  1843.       elsif ($_ eq 'nouser') {
  1844. --- 96,102 ----
  1845.       }
  1846.       elsif ($_ eq 'group') {
  1847.       $gname = shift;
  1848. !     $out .= &tab . "\$gid == \$gid{'$gname'}";
  1849.       $initgroup++;
  1850.       }
  1851.       elsif ($_ eq 'nouser') {
  1852. ***************
  1853. *** 381,387 ****
  1854.       ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  1855.         $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  1856.       if (-f _) {
  1857. !         open(IN, $_) || do {
  1858.           warn "Couldn't open $name: $!\n";
  1859.           return;
  1860.           };
  1861. --- 381,387 ----
  1862.       ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
  1863.         $atime,$mtime,$ctime,$blksize,$blocks) = lstat(_);
  1864.       if (-f _) {
  1865. !         open(IN, "./$_\0") || do {
  1866.           warn "Couldn't open $name: $!\n";
  1867.           return;
  1868.           };
  1869. ***************
  1870. *** 471,477 ****
  1871.       }
  1872.       }
  1873.       if (-f _) {
  1874. !     open(IN, $_) || do {
  1875.           warn "Couldn't open $name: $!\n";
  1876.           return;
  1877.       };
  1878. --- 471,477 ----
  1879.       }
  1880.       }
  1881.       if (-f _) {
  1882. !     open(IN, "./$_\0") || do {
  1883.           warn "Couldn't open $name: $!\n";
  1884.           return;
  1885.       };
  1886.  
  1887. *** End of Patch 14 ***
  1888. exit 0 # Just in case...
  1889. -- 
  1890. Kent Landfield                   INTERNET: kent@sparky.IMD.Sterling.COM
  1891. Sterling Software, IMD           UUCP:     uunet!sparky!kent
  1892. Phone:    (402) 291-8300         FAX:      (402) 291-4362
  1893. Please send comp.sources.misc-related mail to kent@uunet.uu.net.
  1894.