home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume30 / perl / patch32 < prev    next >
Encoding:
Text File  |  1992-06-11  |  47.7 KB  |  1,845 lines
  1. Newsgroups: comp.sources.misc
  2. From: lwall@netlabs.com (Larry Wall)
  3. Subject:  v30i043:  perl - The perl programming language, Patch32
  4. Message-ID: <1992Jun11.180910.1586@sparky.imd.sterling.com>
  5. X-Md4-Signature: 900872f2ef4fa2bfde2abdf13c1965c7
  6. Date: Thu, 11 Jun 1992 18:09:10 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: lwall@netlabs.com (Larry Wall)
  10. Posting-number: Volume 30, Issue 43
  11. Archive-name: perl/patch32
  12. Environment: UNIX, MS-DOS, OS2
  13. Patch-To: perl: Volume 18, Issue 19-54
  14.  
  15. System: perl version 4.0
  16. Patch #: 32
  17. Priority: highish
  18. Subject: patch #20, continued
  19.  
  20. Description:
  21.     See patch #20.
  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 #33 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: 31
  56. 1c1
  57. < #define PATCHLEVEL 31
  58. ---
  59. > #define PATCHLEVEL 32
  60.  
  61. Index: str.h
  62. *** str.h.old    Mon Jun  8 17:51:58 1992
  63. --- str.h    Mon Jun  8 17:51:59 1992
  64. ***************
  65. *** 1,4 ****
  66. ! /* $RCSfile: str.h,v $$Revision: 4.0.1.3 $$Date: 91/11/05 18:41:47 $
  67.    *
  68.    *    Copyright (c) 1991, Larry Wall
  69.    *
  70. --- 1,4 ----
  71. ! /* $RCSfile: str.h,v $$Revision: 4.0.1.4 $$Date: 92/06/08 15:41:45 $
  72.    *
  73.    *    Copyright (c) 1991, Larry Wall
  74.    *
  75. ***************
  76. *** 6,11 ****
  77. --- 6,15 ----
  78.    *    License or the Artistic License, as specified in the README file.
  79.    *
  80.    * $Log:    str.h,v $
  81. +  * Revision 4.0.1.4  92/06/08  15:41:45  lwall
  82. +  * patch20: fixed confusion between a *var's real name and its effective name
  83. +  * patch20: removed implicit int declarations on functions
  84. +  * 
  85.    * Revision 4.0.1.3  91/11/05  18:41:47  lwall
  86.    * patch11: random cleanup
  87.    * patch11: solitary subroutine references no longer trigger typo warnings
  88. ***************
  89. *** 26,37 ****
  90.       STRLEN    str_len;    /* allocated size */
  91.       union {
  92.       double    str_nval;    /* numeric value, if any */
  93. -     STAB    *str_stab;    /* magic stab for magic "key" string */
  94.       long    str_useful;    /* is this search optimization effective? */
  95.       ARG    *str_args;    /* list of args for interpreted string */
  96.       HASH    *str_hash;    /* string represents an assoc array (stab?) */
  97.       ARRAY    *str_array;    /* string represents an array */
  98.       CMD    *str_cmd;    /* command for this source line */
  99.       } str_u;
  100.       STRLEN    str_cur;    /* length of str_ptr as a C string */
  101.       STR        *str_magic;    /* while free, link to next free str */
  102. --- 30,44 ----
  103.       STRLEN    str_len;    /* allocated size */
  104.       union {
  105.       double    str_nval;    /* numeric value, if any */
  106.       long    str_useful;    /* is this search optimization effective? */
  107.       ARG    *str_args;    /* list of args for interpreted string */
  108.       HASH    *str_hash;    /* string represents an assoc array (stab?) */
  109.       ARRAY    *str_array;    /* string represents an array */
  110.       CMD    *str_cmd;    /* command for this source line */
  111. +     struct {
  112. +         STAB *stb_stab;    /* magic stab for magic "key" string */
  113. +         HASH *stb_stash;    /* which symbol table this stab is in */
  114. +     } stb_u;
  115.       } str_u;
  116.       STRLEN    str_cur;    /* length of str_ptr as a C string */
  117.       STR        *str_magic;    /* while free, link to next free str */
  118. ***************
  119. *** 51,62 ****
  120.       STRLEN    str_len;    /* allocated size */
  121.       union {
  122.       double    str_nval;    /* numeric value, if any */
  123. -     STAB    *str_stab;    /* magic stab for magic "key" string */
  124.       long    str_useful;    /* is this search optimization effective? */
  125.       ARG    *str_args;    /* list of args for interpreted string */
  126.       HASH    *str_hash;    /* string represents an assoc array (stab?) */
  127.       ARRAY    *str_array;    /* string represents an array */
  128.       CMD    *str_cmd;    /* command for this source line */
  129.       } str_u;
  130.       STRLEN    str_cur;    /* length of str_ptr as a C string */
  131.       STR        *str_magic;    /* while free, link to next free str */
  132. --- 58,72 ----
  133.       STRLEN    str_len;    /* allocated size */
  134.       union {
  135.       double    str_nval;    /* numeric value, if any */
  136.       long    str_useful;    /* is this search optimization effective? */
  137.       ARG    *str_args;    /* list of args for interpreted string */
  138.       HASH    *str_hash;    /* string represents an assoc array (stab?) */
  139.       ARRAY    *str_array;    /* string represents an array */
  140.       CMD    *str_cmd;    /* command for this source line */
  141. +     struct {
  142. +         STAB *stb_stab;    /* magic stab for magic "key" string */
  143. +         HASH *stb_stash;    /* which symbol table this stab is in */
  144. +     } stb_u;
  145.       } str_u;
  146.       STRLEN    str_cur;    /* length of str_ptr as a C string */
  147.       STR        *str_magic;    /* while free, link to next free str */
  148. ***************
  149. *** 71,76 ****
  150. --- 81,89 ----
  151.   #endif
  152.   };
  153.   
  154. + #define str_stab stb_u.stb_stab
  155. + #define str_stash stb_u.stb_stash
  156. + 
  157.   /* some extra info tacked to some lvalue strings */
  158.   
  159.   struct lstring {
  160. ***************
  161. *** 139,144 ****
  162. --- 152,168 ----
  163.   int str_eq();
  164.   void str_magic();
  165.   void str_insert();
  166. + void str_numset();
  167. + void str_sset();
  168. + void str_nset();
  169. + void str_set();
  170. + void str_chop();
  171. + void str_cat();
  172. + void str_scat();
  173. + void str_ncat();
  174. + void str_reset();
  175. + void str_taintproper();
  176. + void str_taintenv();
  177.   STRLEN str_len();
  178.   
  179.   #define MULTI    (3)
  180.  
  181. Index: lib/termcap.pl
  182. Prereq: 4.0
  183. *** lib/termcap.pl.old    Mon Jun  8 17:49:16 1992
  184. --- lib/termcap.pl    Mon Jun  8 17:49:17 1992
  185. ***************
  186. *** 1,4 ****
  187. ! ;# $Header: termcap.pl,v 4.0 91/03/20 01:26:33 lwall Locked $
  188.   ;#
  189.   ;# Usage:
  190.   ;#    require 'ioctl.pl';
  191. --- 1,4 ----
  192. ! ;# $RCSfile: termcap.pl,v $$Revision: 4.0.1.1 $$Date: 92/06/08 13:49:17 $
  193.   ;#
  194.   ;# Usage:
  195.   ;#    require 'ioctl.pl';
  196. ***************
  197. *** 21,27 ****
  198.       $TERMCAP = $ENV{'TERMCAP'};
  199.       $TERMCAP = '/etc/termcap' unless $TERMCAP;
  200.       if ($TERMCAP !~ m:^/:) {
  201. !     if (index($TERMCAP,"|$TERM|") < $[) {
  202.           $TERMCAP = '/etc/termcap';
  203.       }
  204.       }
  205. --- 21,27 ----
  206.       $TERMCAP = $ENV{'TERMCAP'};
  207.       $TERMCAP = '/etc/termcap' unless $TERMCAP;
  208.       if ($TERMCAP !~ m:^/:) {
  209. !     if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) {
  210.           $TERMCAP = '/etc/termcap';
  211.       }
  212.       }
  213. ***************
  214. *** 33,39 ****
  215.           while (<TERMCAP>) {
  216.           next if /^#/;
  217.           next if /^\t/;
  218. !         if (/\\|$TERM[:\\|]/) {
  219.               chop;
  220.               while (chop eq '\\\\') {
  221.               \$_ .= <TERMCAP>;
  222. --- 33,39 ----
  223.           while (<TERMCAP>) {
  224.           next if /^#/;
  225.           next if /^\t/;
  226. !         if (/(^|\\|)$TERM[:\\|]/) {
  227.               chop;
  228.               while (chop eq '\\\\') {
  229.               \$_ .= <TERMCAP>;
  230.  
  231. Index: os2/tests.dif
  232. *** os2/tests.dif.old    Mon Jun  8 17:50:18 1992
  233. --- os2/tests.dif    Mon Jun  8 17:50:19 1992
  234. ***************
  235. *** 0 ****
  236. --- 1,589 ----
  237. + diff -cbBwr perl-4.019/t/base/term.t new/t/base/term.t
  238. + *** perl-4.019/t/base/term.t    Wed Mar 20 08:47:14 1991
  239. + --- new/t/base/term.t    Sun Jun 16 20:39:50 1991
  240. + ***************
  241. + *** 29,35 ****
  242. + 
  243. +   # check <> pseudoliteral
  244. + 
  245. + ! open(try, "/dev/null") || (die "Can't open /dev/null.");
  246. +   if (<try> eq '') {
  247. +       print "ok 5\n";
  248. +   }
  249. + --- 29,35 ----
  250. + 
  251. +   # check <> pseudoliteral
  252. + 
  253. + ! open(try, "nul") || (die "Can't open /dev/null.");
  254. +   if (<try> eq '') {
  255. +       print "ok 5\n";
  256. +   }
  257. + diff -cbBwr perl-4.019/t/cmd/while.t new/t/cmd/while.t
  258. + *** perl-4.019/t/cmd/while.t    Wed Mar 20 08:46:28 1991
  259. + --- new/t/cmd/while.t    Sun Jun 16 20:52:36 1991
  260. + ***************
  261. + *** 90,96 ****
  262. +   if (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
  263. +   if (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
  264. + 
  265. + ! `/bin/rm -f Cmd.while.tmp`;
  266. + 
  267. +   #$x = 0;
  268. +   #while (1) {
  269. + --- 90,97 ----
  270. +   if (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
  271. +   if (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
  272. + 
  273. + ! close(fh);
  274. + ! `del Cmd.while.tmp`;
  275. + 
  276. +   #$x = 0;
  277. +   #while (1) {
  278. + diff -cbBwr perl-4.019/t/comp/cpp.t new/t/comp/cpp.t
  279. + *** perl-4.019/t/comp/cpp.t    Wed Mar 20 08:48:44 1991
  280. + --- new/t/comp/cpp.t    Sun Jun 16 20:54:00 1991
  281. + ***************
  282. + *** 32,39 ****
  283. +   print TRY '#define OK "ok 3\n"' . "\n";
  284. +   close TRY;
  285. + 
  286. + ! $pwd=`pwd`;
  287. +   $pwd =~ s/\n//;
  288. + ! $x = `./perl -P Comp.cpp.tmp`;
  289. +   print $x;
  290. +   unlink "Comp.cpp.tmp", "Comp.cpp.inc";
  291. + --- 32,39 ----
  292. +   print TRY '#define OK "ok 3\n"' . "\n";
  293. +   close TRY;
  294. + 
  295. + ! $pwd=`cd`;
  296. +   $pwd =~ s/\n//;
  297. + ! $x = `perl -P Comp.cpp.tmp`;
  298. +   print $x;
  299. +   unlink "Comp.cpp.tmp", "Comp.cpp.inc";
  300. + diff -cbBwr perl-4.019/t/comp/script.t new/t/comp/script.t
  301. + *** perl-4.019/t/comp/script.t    Wed Mar 20 08:48:50 1991
  302. + --- new/t/comp/script.t    Sun Jun 16 21:05:02 1991
  303. + ***************
  304. + *** 4,10 ****
  305. + 
  306. +   print "1..3\n";
  307. + 
  308. + ! $x = `./perl -e 'print "ok\n";'`;
  309. + 
  310. +   if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
  311. + 
  312. + --- 4,10 ----
  313. + 
  314. +   print "1..3\n";
  315. + 
  316. + ! $x = `perl -e "print \\\"ok\\n\\\";"`;
  317. + 
  318. +   if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
  319. + 
  320. + ***************
  321. + *** 12,23 ****
  322. +   print try 'print "ok\n";'; print try "\n";
  323. +   close try;
  324. + 
  325. + ! $x = `./perl Comp.script`;
  326. + 
  327. +   if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
  328. + 
  329. + ! $x = `./perl <Comp.script`;
  330. + 
  331. +   if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
  332. + 
  333. + ! `/bin/rm -f Comp.script`;
  334. + --- 12,23 ----
  335. +   print try 'print "ok\n";'; print try "\n";
  336. +   close try;
  337. + 
  338. + ! $x = `perl Comp.script`;
  339. + 
  340. +   if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
  341. + 
  342. + ! $x = `perl <Comp.script`;
  343. + 
  344. +   if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
  345. + 
  346. + ! `del Comp.script`;
  347. + diff -cbBwr perl-4.019/t/io/argv.t new/t/io/argv.t
  348. + *** perl-4.019/t/io/argv.t    Wed Mar 20 08:48:38 1991
  349. + --- new/t/io/argv.t    Sun Jun 16 21:14:14 1991
  350. + ***************
  351. + *** 8,26 ****
  352. +   print try "a line\n";
  353. +   close try;
  354. + 
  355. + ! $x = `./perl -e 'while (<>) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`;
  356. + 
  357. +   if ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";}
  358. + 
  359. + ! $x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`;
  360. + 
  361. +   if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
  362. + 
  363. + ! $x = `echo foo|./perl -e 'while (<>) {print $_;}'`;
  364. + 
  365. +   if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3 :$x:\n";}
  366. + 
  367. + ! @ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp');
  368. +   while (<>) {
  369. +       $y .= $. . $_;
  370. +       if (eof()) {
  371. + --- 8,26 ----
  372. +   print try "a line\n";
  373. +   close try;
  374. + 
  375. + ! $x = `perl -e "while (<>) {print \$.,\$_;}" Io.argv.tmp Io.argv.tmp`;
  376. + 
  377. +   if ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";}
  378. + 
  379. + ! $x = `echo foo | perl -e "while (<>) {print $_;}" Io.argv.tmp -`;
  380. + 
  381. +   if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
  382. + 
  383. + ! $x = `echo foo | perl -e "while (<>) {print $_;}"`;
  384. + 
  385. +   if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3 :$x:\n";}
  386. + 
  387. + ! @ARGV = ('Io.argv.tmp', 'Io.argv.tmp', 'nul', 'Io.argv.tmp');
  388. +   while (<>) {
  389. +       $y .= $. . $_;
  390. +       if (eof()) {
  391. + ***************
  392. + *** 33,36 ****
  393. +   else
  394. +       {print "not ok 5\n";}
  395. + 
  396. + ! `/bin/rm -f Io.argv.tmp`;
  397. + --- 33,36 ----
  398. +   else
  399. +       {print "not ok 5\n";}
  400. + 
  401. + ! `del Io.argv.tmp`;
  402. + diff -cbBwr perl-4.019/t/io/pipe.t new/t/io/pipe.t
  403. + *** perl-4.019/t/io/pipe.t    Wed Mar 20 08:48:38 1991
  404. + --- new/t/io/pipe.t    Sun Jun 16 21:25:14 1991
  405. + ***************
  406. + *** 5,11 ****
  407. +   $| = 1;
  408. +   print "1..8\n";
  409. + 
  410. + ! open(PIPE, "|-") || (exec 'tr', '[A-Z]', '[a-z]');
  411. +   print PIPE "OK 1\n";
  412. +   print PIPE "ok 2\n";
  413. +   close PIPE;
  414. + --- 5,11 ----
  415. +   $| = 1;
  416. +   print "1..8\n";
  417. + 
  418. + ! open(PIPE, "|-") || (exec 'tr.exe', '[A-Z]', '[a-z]');
  419. +   print PIPE "OK 1\n";
  420. +   print PIPE "ok 2\n";
  421. +   close PIPE;
  422. + ***************
  423. + *** 18,24 ****
  424. +   }
  425. +   else {
  426. +       print STDOUT "not ok 3\n";
  427. + !     exec 'echo', 'not ok 4';
  428. +   }
  429. + 
  430. +   pipe(READER,WRITER) || die "Can't open pipe";
  431. + --- 18,24 ----
  432. +   }
  433. +   else {
  434. +       print STDOUT "not ok 3\n";
  435. + !     exec 'perlglob', 'not ok 4';
  436. +   }
  437. + 
  438. +   pipe(READER,WRITER) || die "Can't open pipe";
  439. + diff -cbBwr perl-4.019/t/op/exec.t new/t/op/exec.t
  440. + *** perl-4.019/t/op/exec.t    Wed Mar 20 08:48:46 1991
  441. + --- new/t/op/exec.t    Sun Jun 16 21:39:32 1991
  442. + ***************
  443. + *** 7,21 ****
  444. + 
  445. +   print "not ok 1\n" if system "echo ok \\1";    # shell interpreted
  446. +   print "not ok 2\n" if system "echo ok 2";    # split and directly called
  447. + ! print "not ok 3\n" if system "echo", "ok", "3"; # directly called
  448. + 
  449. + ! if (system "true") {print "not ok 4\n";} else {print "ok 4\n";}
  450. + 
  451. + ! if ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; }
  452. +   print "ok 5\n";
  453. + 
  454. + ! if ((system "lskdfj") == 255 << 8) {print "ok 6\n";} else {print "not ok 6\n";}
  455. + 
  456. +   unless (exec "lskdjfalksdjfdjfkls") {print "ok 7\n";} else {print "not ok 7\n";}
  457. + 
  458. + ! exec "echo","ok","8";
  459. + --- 7,21 ----
  460. + 
  461. +   print "not ok 1\n" if system "echo ok \\1";    # shell interpreted
  462. +   print "not ok 2\n" if system "echo ok 2";    # split and directly called
  463. + ! print "not ok 3\n" if system "perlglob", "ok", "3", "\n"; # directly called
  464. + 
  465. + ! if (system "expr 1 >nul") {print "not ok 4\n";} else {print "ok 4\n";}
  466. + 
  467. + ! if ((system "sh -c \"exit 1\"") != 1) { print "not "; }
  468. +   print "ok 5\n";
  469. + 
  470. + ! if ((system "lskdfj") == 1) {print "ok 6\n";} else {print "not ok 6\n";}
  471. + 
  472. +   unless (exec "lskdjfalksdjfdjfkls") {print "ok 7\n";} else {print "not ok 7\n";}
  473. + 
  474. + ! exec "perlglob","ok","8";
  475. + diff -cbBwr perl-4.019/t/op/glob.t new/t/op/glob.t
  476. + *** perl-4.019/t/op/glob.t    Wed Mar 20 08:48:54 1991
  477. + --- new/t/op/glob.t    Sun Jun 16 21:43:26 1991
  478. + ***************
  479. + *** 7,13 ****
  480. +   @ops = <op/*>;
  481. +   $list = join(' ',@ops);
  482. + 
  483. + ! chop($otherway = `echo op/*`);
  484. + 
  485. +   print $list eq $otherway ? "ok 1\n" : "not ok 1\n$list\n$otherway\n";
  486. + 
  487. + --- 7,13 ----
  488. +   @ops = <op/*>;
  489. +   $list = join(' ',@ops);
  490. + 
  491. + ! chop($otherway = `perlglob op/*`);
  492. + 
  493. +   print $list eq $otherway ? "ok 1\n" : "not ok 1\n$list\n$otherway\n";
  494. + 
  495. + diff -cbBwr perl-4.019/t/op/goto.t new/t/op/goto.t
  496. + *** perl-4.019/t/op/goto.t    Wed Mar 20 08:48:46 1991
  497. + --- new/t/op/goto.t    Sun Jun 16 21:50:54 1991
  498. + ***************
  499. + *** 29,34 ****
  500. +   print "#2\t:$foo: == 4\n";
  501. +   if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
  502. + 
  503. + ! $x = `./perl -e 'goto foo;' 2>&1`;
  504. +   print "#3\t/label/ in :$x";
  505. +   if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
  506. + --- 29,34 ----
  507. +   print "#2\t:$foo: == 4\n";
  508. +   if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
  509. + 
  510. + ! $x = `perl -e "goto foo;" 2>&1`;
  511. +   print "#3\t/label/ in :$x";
  512. +   if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
  513. + diff -cbBwr perl-4.019/t/op/magic.t new/t/op/magic.t
  514. + *** perl-4.019/t/op/magic.t    Wed Mar 20 08:48:36 1991
  515. + --- new/t/op/magic.t    Sun Jun 16 21:56:14 1991
  516. + ***************
  517. + *** 7,13 ****
  518. +   print "1..5\n";
  519. + 
  520. +   eval '$ENV{"foo"} = "hi there";';    # check that ENV is inited inside eval
  521. + ! if (`echo \$foo` eq "hi there\n") {print "ok 1\n";} else {print "not ok 1\n";}
  522. + 
  523. +   unlink 'ajslkdfpqjsjfk';
  524. +   $! = 0;
  525. + --- 7,13 ----
  526. +   print "1..5\n";
  527. + 
  528. +   eval '$ENV{"foo"} = "hi there";';    # check that ENV is inited inside eval
  529. + ! if (`echo %foo%` eq "hi there\n") {print "ok 1\n";} else {print "not ok 1\n";}
  530. + 
  531. +   unlink 'ajslkdfpqjsjfk';
  532. +   $! = 0;
  533. + ***************
  534. + *** 17,30 ****
  535. +   # the next tests are embedded inside system simply because sh spits out
  536. +   # a newline onto stderr when a child process kills itself with SIGINT.
  537. + 
  538. + ! system './perl',
  539. +   '-e', '$| = 1;        # command buffering',
  540. + 
  541. + ! '-e', '$SIG{"INT"} = "ok3"; kill 2,$$;',
  542. + ! '-e', '$SIG{"INT"} = "IGNORE"; kill 2,$$; print "ok 4\n";',
  543. + ! '-e', '$SIG{"INT"} = "DEFAULT"; kill 2,$$; print "not ok\n";',
  544. + 
  545. + ! '-e', 'sub ok3 { print "ok 3\n" if pop(@_) eq "INT"; }';
  546. + 
  547. +   @val1 = @ENV{keys(%ENV)};    # can we slice ENV?
  548. +   @val2 = values(%ENV);
  549. + --- 17,30 ----
  550. +   # the next tests are embedded inside system simply because sh spits out
  551. +   # a newline onto stderr when a child process kills itself with SIGINT.
  552. + 
  553. + ! system 'perl',
  554. +   '-e', '$| = 1;        # command buffering',
  555. + 
  556. + ! '-e', '$SIG{"TERM"} = "ok3"; kill 0,$$;',
  557. + ! '-e', '$SIG{"TERM"} = "IGNORE"; kill 0,$$; print "ok 4\n";',
  558. + ! '-e', '$SIG{"TERM"} = "DEFAULT"; kill 0,$$; print "not ok\n";',
  559. + 
  560. + ! '-e', 'sub ok3 { print "ok 3\n" if pop(@_) eq "TERM"; }';
  561. + 
  562. +   @val1 = @ENV{keys(%ENV)};    # can we slice ENV?
  563. +   @val2 = values(%ENV);
  564. + diff -cbBwr perl-4.019/t/op/mkdir.t new/t/op/mkdir.t
  565. + *** perl-4.019/t/op/mkdir.t    Wed Mar 20 08:48:54 1991
  566. + --- new/t/op/mkdir.t    Sun Jun 16 22:00:06 1991
  567. + ***************
  568. + *** 4,14 ****
  569. + 
  570. +   print "1..7\n";
  571. + 
  572. + ! `rm -rf blurfl`;
  573. + 
  574. +   print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n");
  575. +   print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n");
  576. + ! print ($! =~ /exist/ ? "ok 3\n" : "not ok 3\n");
  577. +   print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
  578. +   print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
  579. +   print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
  580. + --- 4,14 ----
  581. + 
  582. +   print "1..7\n";
  583. + 
  584. + ! `rm -r blurfl`;
  585. + 
  586. +   print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n");
  587. +   print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n");
  588. + ! print ($! =~ /denied/ ? "ok 3\n" : "not ok 3\n");
  589. +   print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
  590. +   print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
  591. +   print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
  592. + diff -cbBwr perl-4.019/t/op/split.t new/t/op/split.t
  593. + *** perl-4.019/t/op/split.t    Wed Mar 20 08:48:24 1991
  594. + --- new/t/op/split.t    Sun Jun 16 22:04:02 1991
  595. + ***************
  596. + *** 47,53 ****
  597. +   print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n";
  598. + 
  599. +   # Does assignment to a list imply split to one more field than that?
  600. + ! $foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1`;
  601. +   print $foo =~ /DEBUGGING/ || $foo =~ /num\(3\)/ ? "ok 11\n" : "not ok 11\n";
  602. + 
  603. +   # Can we say how many fields to split to when assigning to a list?
  604. + --- 47,53 ----
  605. +   print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n";
  606. + 
  607. +   # Does assignment to a list imply split to one more field than that?
  608. + ! $foo = `perl -D1024 -e "(\$a,\$b) = split;" 2>&1`;
  609. +   print $foo =~ /DEBUGGING/ || $foo =~ /num\(3\)/ ? "ok 11\n" : "not ok 11\n";
  610. + 
  611. +   # Can we say how many fields to split to when assigning to a list?
  612. + diff -cbBwr perl-4.019/t/op/stat.t new/t/op/stat.t
  613. + *** perl-4.019/t/op/stat.t    Fri Nov 22 22:04:46 1991
  614. + --- new/t/op/stat.t    Fri Nov 22 22:16:40 1991
  615. + ***************
  616. + *** 4,12 ****
  617. + 
  618. +   print "1..56\n";
  619. + 
  620. + ! chop($cwd = `pwd`);
  621. + 
  622. + ! $DEV = `ls -l /dev`;
  623. + 
  624. +   unlink "Op.stat.tmp";
  625. +   open(FOO, ">Op.stat.tmp");
  626. + --- 4,12 ----
  627. + 
  628. +   print "1..56\n";
  629. + 
  630. + ! chop($cwd = `cd`);
  631. + 
  632. + ! $DEV = `ls -l`;
  633. + 
  634. +   unlink "Op.stat.tmp";
  635. +   open(FOO, ">Op.stat.tmp");
  636. + ***************
  637. + *** 23,29 ****
  638. + 
  639. +   sleep 2;
  640. + 
  641. + ! `rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
  642. + 
  643. +   ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  644. +       $blksize,$blocks) = stat('Op.stat.tmp');
  645. + --- 23,29 ----
  646. + 
  647. +   sleep 2;
  648. + 
  649. + ! `del Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp 2>nul`;
  650. + 
  651. +   ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  652. +       $blksize,$blocks) = stat('Op.stat.tmp');
  653. + ***************
  654. + *** 73,80 ****
  655. +   if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
  656. +   if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
  657. + 
  658. + ! if (`ls -l perl` =~ /^l.*->/) {
  659. + !     if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";}
  660. +   }
  661. +   else {
  662. +       print "ok 25\n";
  663. + --- 73,80 ----
  664. +   if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";}
  665. +   if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";}
  666. + 
  667. + ! if (`ls -l perl.exe` =~ /^l.*->/) {
  668. + !     if (-l 'perl.exe') {print "ok 25\n";} else {print "not ok 25\n";}
  669. +   }
  670. +   else {
  671. +       print "ok 25\n";
  672. + ***************
  673. + *** 83,89 ****
  674. +   if (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";}
  675. + 
  676. +   if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
  677. + ! `rm -f Op.stat.tmp Op.stat.tmp2`;
  678. +   if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
  679. + 
  680. +   if ($DEV !~ /\nc.* (\S+)\n/)
  681. + --- 83,89 ----
  682. +   if (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";}
  683. + 
  684. +   if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";}
  685. + ! `del Op.stat.tmp Op.stat.tmp2 2>nul`;
  686. +   if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";}
  687. + 
  688. +   if ($DEV !~ /\nc.* (\S+)\n/)
  689. + ***************
  690. + *** 113,119 ****
  691. +   $cnt = $uid = 0;
  692. + 
  693. +   die "Can't run op/stat.t test 35 without pwd working" unless $cwd;
  694. + ! chdir '/usr/bin' || die "Can't cd to /usr/bin";
  695. +   while (defined($_ = <*>)) {
  696. +       $cnt++;
  697. +       $uid++ if -u;
  698. + --- 113,119 ----
  699. +   $cnt = $uid = 0;
  700. + 
  701. +   die "Can't run op/stat.t test 35 without pwd working" unless $cwd;
  702. + ! chdir '../os2' || die "Can't cd to ../os2";
  703. +   while (defined($_ = <*>)) {
  704. +       $cnt++;
  705. +       $uid++ if -u;
  706. + ***************
  707. + *** 124,138 ****
  708. +   # I suppose this is going to fail somewhere...
  709. +   if ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";}
  710. + 
  711. + ! unless (open(tty,"/dev/tty")) {
  712. + !     print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n";
  713. +   }
  714. +   if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";}
  715. +   if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
  716. +   close(tty);
  717. +   if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
  718. + ! open(null,"/dev/null");
  719. + ! if (! -t null || -e '/xenix') {print "ok 39\n";} else {print "not ok 39\n";}
  720. +   close(null);
  721. +   if (-t) {print "ok 40\n";} else {print "not ok 40\n";}
  722. + 
  723. + --- 124,138 ----
  724. +   # I suppose this is going to fail somewhere...
  725. +   if ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";}
  726. + 
  727. + ! unless (open(tty,"con")) {
  728. + !     print STDERR "Can't open con--run t/TEST outside of make.\n";
  729. +   }
  730. +   if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";}
  731. +   if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
  732. +   close(tty);
  733. +   if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
  734. + ! open(null,"nul");
  735. + ! if (! -t null || -e 'c:/os2krnl') {print "ok 39\n";} else {print "not ok 39\n";}
  736. +   close(null);
  737. +   if (-t) {print "ok 40\n";} else {print "not ok 40\n";}
  738. + 
  739. + ***************
  740. + *** 141,148 ****
  741. +   if (-T 'op/stat.t') {print "ok 41\n";} else {print "not ok 41\n";}
  742. +   if (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";}
  743. + 
  744. + ! if (-B './perl') {print "ok 43\n";} else {print "not ok 43\n";}
  745. + ! if (! -T './perl') {print "ok 44\n";} else {print "not ok 44\n";}
  746. + 
  747. +   open(FOO,'op/stat.t');
  748. +   eval { -T FOO; };
  749. + --- 141,148 ----
  750. +   if (-T 'op/stat.t') {print "ok 41\n";} else {print "not ok 41\n";}
  751. +   if (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";}
  752. + 
  753. + ! if (-B 'perl.exe') {print "ok 43\n";} else {print "not ok 43\n";}
  754. + ! if (! -T 'perl.exe') {print "ok 44\n";} else {print "not ok 44\n";}
  755. + 
  756. +   open(FOO,'op/stat.t');
  757. +   eval { -T FOO; };
  758. + ***************
  759. + *** 172,176 ****
  760. +   }
  761. +   close(FOO);
  762. + 
  763. + ! if (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";}
  764. + ! if (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";}
  765. + --- 172,176 ----
  766. +   }
  767. +   close(FOO);
  768. + 
  769. + ! if (-T 'nul') {print "ok 55\n";} else {print "not ok 55\n";}
  770. + ! if (-B 'nul') {print "ok 56\n";} else {print "not ok 56\n";}
  771. + diff -cbBwr perl-4.019/t/TEST new/t/TEST
  772. + *** perl-4.019/t/TEST    Tue Jun 11 23:32:06 1991
  773. + --- new/t/TEST    Sun Jun 16 20:47:38 1991
  774. + ***************
  775. + *** 16,22 ****
  776. + 
  777. +   if ($ARGV[0] eq '') {
  778. +       @ARGV = split(/[ \n]/,
  779. + !       `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t lib/*.t`);
  780. +   }
  781. + 
  782. +   open(CONFIG,"../config.sh");
  783. + --- 16,22 ----
  784. + 
  785. +   if ($ARGV[0] eq '') {
  786. +       @ARGV = split(/[ \n]/,
  787. + !       `ls base/*.t comp/*.t cmd/*.t io/*.t op/*.t lib/*.t`);
  788. +   }
  789. + 
  790. +   open(CONFIG,"../config.sh");
  791. + ***************
  792. + *** 35,41 ****
  793. +       chop($te);
  794. +       print "$te" . '.' x (15 - length($te));
  795. +       if ($sharpbang) {
  796. + !     open(results,"./$test|") || (print "can't run.\n");
  797. +       } else {
  798. +       open(script,"$test") || die "Can't run $test.\n";
  799. +       $_ = <script>;
  800. + --- 35,41 ----
  801. +       chop($te);
  802. +       print "$te" . '.' x (15 - length($te));
  803. +       if ($sharpbang) {
  804. + !     open(results,"$test|") || (print "can't run.\n");
  805. +       } else {
  806. +       open(script,"$test") || die "Can't run $test.\n";
  807. +       $_ = <script>;
  808. + ***************
  809. + *** 45,51 ****
  810. +       } else {
  811. +           $switch = '';
  812. +       }
  813. + !     open(results,"./perl$switch $test|") || (print "can't run.\n");
  814. +       }
  815. +       $ok = 0;
  816. +       $next = 0;
  817. + --- 45,51 ----
  818. +       } else {
  819. +           $switch = '';
  820. +       }
  821. + !     open(results,"perl$switch $test|") || (print "can't run.\n");
  822. +       }
  823. +       $ok = 0;
  824. +       $next = 0;
  825. + 
  826.  
  827. Index: lib/timelocal.pl
  828. *** lib/timelocal.pl.old    Mon Jun  8 17:49:19 1992
  829. --- lib/timelocal.pl    Mon Jun  8 17:49:19 1992
  830. ***************
  831. *** 1,7 ****
  832.   ;# timelocal.pl
  833.   ;#
  834.   ;# Usage:
  835. ! ;#    $time = timelocal($sec,$min,$hours,$mday,$mon,$year,$junk,$junk,$isdst);
  836.   ;#    $time = timegm($sec,$min,$hours,$mday,$mon,$year);
  837.   
  838.   ;# These routines are quite efficient and yet are always guaranteed to agree
  839. --- 1,7 ----
  840.   ;# timelocal.pl
  841.   ;#
  842.   ;# Usage:
  843. ! ;#    $time = timelocal($sec,$min,$hours,$mday,$mon,$year);
  844.   ;#    $time = timegm($sec,$min,$hours,$mday,$mon,$year);
  845.   
  846.   ;# These routines are quite efficient and yet are always guaranteed to agree
  847. ***************
  848. *** 24,29 ****
  849. --- 24,30 ----
  850.   CONFIG: {
  851.       package timelocal;
  852.       
  853. +     local($[) = 0;
  854.       @epoch = localtime(0);
  855.       $tzmin = $epoch[2] * 60 + $epoch[1];    # minutes east of GMT
  856.       if ($tzmin > 0) {
  857. ***************
  858. *** 40,45 ****
  859. --- 41,47 ----
  860.   sub timegm {
  861.       package timelocal;
  862.   
  863. +     local($[) = 0;
  864.       $ym = pack(C2, @_[5,4]);
  865.       $cheat = $cheat{$ym} || &cheat;
  866.       $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS;
  867. ***************
  868. *** 48,57 ****
  869.   sub timelocal {
  870.       package timelocal;
  871.   
  872. !     $ym = pack(C2, @_[5,4]);
  873. !     $cheat = $cheat{$ym} || &cheat;
  874. !     $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS
  875. !     + $tzmin * $MIN - 60 * 60 * ($_[8] != 0);
  876.   }
  877.   
  878.   package timelocal;
  879. --- 50,60 ----
  880.   sub timelocal {
  881.       package timelocal;
  882.   
  883. !     local($[) = 0;
  884. !     $time = &main'timegm + $tzmin*$MIN;
  885. !     @test = localtime($time);
  886. !     $time -= $HR if $test[2] != $_[2];
  887. !     $time;
  888.   }
  889.   
  890.   package timelocal;
  891. ***************
  892. *** 59,72 ****
  893.   sub cheat {
  894.       $year = $_[5];
  895.       $month = $_[4];
  896.       $guess = $^T;
  897.       @g = gmtime($guess);
  898.       while ($diff = $year - $g[5]) {
  899. !     $guess += $diff * (364 * $DAYS);
  900.       @g = gmtime($guess);
  901.       }
  902.       while ($diff = $month - $g[4]) {
  903. !     $guess += $diff * (28 * $DAYS);
  904.       @g = gmtime($guess);
  905.       }
  906.       $g[3]--;
  907. --- 62,76 ----
  908.   sub cheat {
  909.       $year = $_[5];
  910.       $month = $_[4];
  911. +     die "Month out of range 0..11 in ctime.pl\n" if $month > 11;
  912.       $guess = $^T;
  913.       @g = gmtime($guess);
  914.       while ($diff = $year - $g[5]) {
  915. !     $guess += $diff * (363 * $DAYS);
  916.       @g = gmtime($guess);
  917.       }
  918.       while ($diff = $month - $g[4]) {
  919. !     $guess += $diff * (27 * $DAYS);
  920.       @g = gmtime($guess);
  921.       }
  922.       $g[3]--;
  923.  
  924. Index: hints/titan.sh
  925. *** hints/titan.sh.old    Mon Jun  8 17:48:23 1992
  926. --- hints/titan.sh    Mon Jun  8 17:48:23 1992
  927. ***************
  928. *** 0 ****
  929. --- 1,40 ----
  930. + # Hints file (perl 4.019) for Kubota Pacific's Titan 3000 Series Machines.
  931. + # Created by: JT McDuffie (jt@kpc.com)  26 DEC 1991
  932. + bin='/usr/local/bin'
  933. + installbin='/usr/local/bin'
  934. + alignbytes="8"
  935. + byteorder="4321"
  936. + cppstdin='/lib/cpp'
  937. + cppminus=''
  938. + castflags='0'
  939. + gid_type='ushort'
  940. + groupstype='unsigned short'
  941. + intsize='4'
  942. + libc='/lib/libc.a'
  943. + nm_opts='-eh'
  944. + mallocptrtype='void'
  945. + mansrc='/usr/man/man1'
  946. + installmansrc='/usr/man/man1'
  947. + manext='1'
  948. + models='none'
  949. + optimize='-O'
  950. + ccflags="$ccflags -I/usr/include/net -DDEBUGGING"
  951. + cppflags="$cppflags -I/usr/include/net -DDEBUGGING"
  952. + cc='cc'
  953. + libs='-lnsl -ldbm -lPW -lmalloc -lm'
  954. + libswanted='net socket nsl nm ndir ndbm dbm PW malloc m x posix '
  955. + scriptdir='/usr/local/bin'
  956. + installscr='/usr/local/bin'
  957. + stdchar='unsigned char'
  958. + uidtype='ushort'
  959. + usrinclude='/usr/include'
  960. + voidhave='7'
  961. + w_localtim='1'
  962. + w_s_timevl='1'
  963. + w_s_tm='1'
  964. + privlib='/usr/local/lib/perl'
  965. + installprivlib='/usr/local/lib/perl'
  966. + inclwanted='/usr/include /usr/include/net '
  967. + libpth=' /usr/lib /usr/local/lib /lib'
  968. + eoPATH='/bin /usr/bin /usr/ucb /usr/local /usr/local/bin /usr/lbin /etc /usr/lib /lib /usr/local/lib '
  969. + pth=' . /bin /usr/bin /usr/ucb /usr/local/bin /usr/X11/bin /usr/lbin /etc /usr/lib /lib /usr/local/lib '
  970.  
  971. Index: atarist/usub/usersub.c
  972. *** atarist/usub/usersub.c.old    Mon Jun  8 17:45:37 1992
  973. --- atarist/usub/usersub.c    Mon Jun  8 17:45:37 1992
  974. ***************
  975. *** 0 ****
  976. --- 1,27 ----
  977. + /* $RCSfile: usersub.c,v $$Revision: 4.0.1.1 $$Date: 92/06/08 11:54:52 $
  978. +  *
  979. +  * $Log:    usersub.c,v $
  980. +  * Revision 4.0.1.1  92/06/08  11:54:52  lwall
  981. +  * Initial revision
  982. +  * 
  983. +  * Revision 4.0.1.1  91/11/05  19:07:24  lwall
  984. +  * patch11: there are now subroutines for calling back from C into Perl
  985. +  * 
  986. +  * Revision 4.0  91/03/20  01:56:34  lwall
  987. +  * 4.0 baseline.
  988. +  * 
  989. +  * Revision 3.0.1.1  90/08/09  04:06:10  lwall
  990. +  * patch19: Initial revision
  991. +  * 
  992. +  */
  993. + 
  994. + #include "EXTERN.h"
  995. + #include "perl.h"
  996. + 
  997. + int
  998. + userinit()
  999. + {
  1000. +     install_null();    /* install device /dev/null or NUL: */
  1001. +     init_curses();
  1002. +     return 0;
  1003. + }
  1004.  
  1005. Index: usersub.c
  1006. *** usersub.c.old    Mon Jun  8 17:52:23 1992
  1007. --- usersub.c    Mon Jun  8 17:52:23 1992
  1008. ***************
  1009. *** 1,4 ****
  1010. ! /* $RCSfile: usersub.c,v $$Revision: 4.0.1.1 $$Date: 91/11/11 16:47:17 $
  1011.    *
  1012.    *  This file contains stubs for routines that the user may define to
  1013.    *  set up glue routines for C libraries or to decrypt encrypted scripts
  1014. --- 1,4 ----
  1015. ! /* $RCSfile: usersub.c,v $$Revision: 4.0.1.2 $$Date: 92/06/08 16:04:24 $
  1016.    *
  1017.    *  This file contains stubs for routines that the user may define to
  1018.    *  set up glue routines for C libraries or to decrypt encrypted scripts
  1019. ***************
  1020. *** 5,10 ****
  1021. --- 5,13 ----
  1022.    *  for execution.
  1023.    *
  1024.    * $Log:    usersub.c,v $
  1025. +  * Revision 4.0.1.2  92/06/08  16:04:24  lwall
  1026. +  * patch20: removed implicit int declarations on functions
  1027. +  * 
  1028.    * Revision 4.0.1.1  91/11/11  16:47:17  lwall
  1029.    * patch19: deleted some unused functions from usersub.c
  1030.    * 
  1031. ***************
  1032. *** 16,21 ****
  1033. --- 19,25 ----
  1034.   #include "EXTERN.h"
  1035.   #include "perl.h"
  1036.   
  1037. + int
  1038.   userinit()
  1039.   {
  1040.       return 0;
  1041. ***************
  1042. *** 46,51 ****
  1043. --- 50,56 ----
  1044.   #define    CRYPT_MAGIC_1    0xfb
  1045.   #define    CRYPT_MAGIC_2    0xf1
  1046.   
  1047. + void
  1048.   cryptfilter( fil )
  1049.   FILE *    fil;
  1050.   {
  1051. ***************
  1052. *** 113,118 ****
  1053. --- 118,124 ----
  1054.       return fdopen(p[0], "r");
  1055.   }
  1056.   
  1057. + void
  1058.   cryptswitch()
  1059.   {
  1060.       int ch;
  1061.  
  1062. Index: hints/utekv.sh
  1063. *** hints/utekv.sh.old    Mon Jun  8 17:48:31 1992
  1064. --- hints/utekv.sh    Mon Jun  8 17:48:31 1992
  1065. ***************
  1066. *** 0 ****
  1067. --- 1,18 ----
  1068. + # XD88/10 UTekV hints by Kaveh Ghazi (ghazi@caip.rutgers.edu)  2/11/92
  1069. + 
  1070. + # The -DUTekV is needed because the greenhills compiler does not have any
  1071. + # UTekV specific definitions and we need one in perl.h
  1072. + ccflags="$ccflags -X18 -DJMPCLOBBER -DUTekV"
  1073. + 
  1074. + usemymalloc='y'
  1075. + 
  1076. + # /usr/include/rpcsvc is for finding dbm.h
  1077. + inclwanted="$inclwanted /usr/include/rpcsvc"
  1078. + 
  1079. + # dont use the wrapper, use the real thing.
  1080. + cppstdin=/lib/cpp
  1081. + 
  1082. + echo " "
  1083. + echo "NOTE: You may have to take out makefile dependencies on the files in"
  1084. + echo "/usr/include (i.e. /usr/include/ctype.h) or the make will fail.  A"
  1085. + echo "simple 'grep -v /usr/include/ makefile' should suffice."
  1086.  
  1087. Index: util.c
  1088. *** util.c.old    Mon Jun  8 17:52:33 1992
  1089. --- util.c    Mon Jun  8 17:52:34 1992
  1090. ***************
  1091. *** 1,4 ****
  1092. ! /* $RCSfile: util.c,v $$Revision: 4.0.1.4 $$Date: 91/11/11 16:48:54 $
  1093.    *
  1094.    *    Copyright (c) 1991, Larry Wall
  1095.    *
  1096. --- 1,4 ----
  1097. ! /* $RCSfile: util.c,v $$Revision: 4.0.1.5 $$Date: 92/06/08 16:08:37 $
  1098.    *
  1099.    *    Copyright (c) 1991, Larry Wall
  1100.    *
  1101. ***************
  1102. *** 6,11 ****
  1103. --- 6,18 ----
  1104.    *    License or the Artistic License, as specified in the README file.
  1105.    *
  1106.    * $Log:    util.c,v $
  1107. +  * Revision 4.0.1.5  92/06/08  16:08:37  lwall
  1108. +  * patch20: removed implicit int declarations on functions
  1109. +  * patch20: Perl now distinguishes overlapped copies from non-overlapped
  1110. +  * patch20: fixed confusion between a *var's real name and its effective name
  1111. +  * patch20: bcopy() and memcpy() now tested for overlap safety
  1112. +  * patch20: added Atari ST portability
  1113. +  * 
  1114.    * Revision 4.0.1.4  91/11/11  16:48:54  lwall
  1115.    * patch19: study was busted by 4.018
  1116.    * patch19: added little-endian pack/unpack options
  1117. ***************
  1118. *** 96,111 ****
  1119.   #endif
  1120.       ptr = malloc(size?size:1);    /* malloc(0) is NASTY on our system */
  1121.   #ifdef DEBUGGING
  1122. ! #  ifndef I286
  1123.       if (debug & 128)
  1124. !     fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size);
  1125.   #  else
  1126.       if (debug & 128)
  1127. !     fprintf(stderr,"0x%lx: (%05d) malloc %d bytes\n",ptr,an++,size);
  1128.   #  endif
  1129.   #endif
  1130.       if (ptr != Nullch)
  1131.       return ptr;
  1132.       else {
  1133.       fputs(nomem,stderr) FLUSH;
  1134.       exit(1);
  1135. --- 103,120 ----
  1136.   #endif
  1137.       ptr = malloc(size?size:1);    /* malloc(0) is NASTY on our system */
  1138.   #ifdef DEBUGGING
  1139. ! #  if !(defined(I286) || defined(atarist))
  1140.       if (debug & 128)
  1141. !     fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",ptr,an++,(long)size);
  1142.   #  else
  1143.       if (debug & 128)
  1144. !     fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",ptr,an++,(long)size);
  1145.   #  endif
  1146.   #endif
  1147.       if (ptr != Nullch)
  1148.       return ptr;
  1149. +     else if (nomemok)
  1150. +     return Nullch;
  1151.       else {
  1152.       fputs(nomem,stderr) FLUSH;
  1153.       exit(1);
  1154. ***************
  1155. *** 146,165 ****
  1156.   #endif
  1157.       ptr = realloc(where,size?size:1);    /* realloc(0) is NASTY on our system */
  1158.   #ifdef DEBUGGING
  1159. ! #  ifndef I286
  1160.       if (debug & 128) {
  1161.       fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
  1162. !     fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size);
  1163.       }
  1164.   #  else
  1165.       if (debug & 128) {
  1166.       fprintf(stderr,"0x%lx: (%05d) rfree\n",where,an++);
  1167. !     fprintf(stderr,"0x%lx: (%05d) realloc %d bytes\n",ptr,an++,size);
  1168.       }
  1169.   #  endif
  1170.   #endif
  1171.       if (ptr != Nullch)
  1172.       return ptr;
  1173.       else {
  1174.       fputs(nomem,stderr) FLUSH;
  1175.       exit(1);
  1176. --- 155,176 ----
  1177.   #endif
  1178.       ptr = realloc(where,size?size:1);    /* realloc(0) is NASTY on our system */
  1179.   #ifdef DEBUGGING
  1180. ! #  if !(defined(I286) || defined(atarist))
  1181.       if (debug & 128) {
  1182.       fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
  1183. !     fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
  1184.       }
  1185.   #  else
  1186.       if (debug & 128) {
  1187.       fprintf(stderr,"0x%lx: (%05d) rfree\n",where,an++);
  1188. !     fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
  1189.       }
  1190.   #  endif
  1191.   #endif
  1192.       if (ptr != Nullch)
  1193.       return ptr;
  1194. +     else if (nomemok)
  1195. +     return Nullch;
  1196.       else {
  1197.       fputs(nomem,stderr) FLUSH;
  1198.       exit(1);
  1199. ***************
  1200. *** 177,183 ****
  1201.   char *where;
  1202.   {
  1203.   #ifdef DEBUGGING
  1204. ! #  ifndef I286
  1205.       if (debug & 128)
  1206.       fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
  1207.   #  else
  1208. --- 188,194 ----
  1209.   char *where;
  1210.   {
  1211.   #ifdef DEBUGGING
  1212. ! #  if !(defined(I286) || defined(atarist))
  1213.       if (debug & 128)
  1214.       fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
  1215.   #  else
  1216. ***************
  1217. *** 233,238 ****
  1218. --- 244,250 ----
  1219.       safefree(where);
  1220.   }
  1221.   
  1222. + static void
  1223.   xstat()
  1224.   {
  1225.       register int i;
  1226. ***************
  1227. *** 820,826 ****
  1228.       register char *newaddr;
  1229.   
  1230.       New(903,newaddr,len+1,char);
  1231. !     (void)bcopy(str,newaddr,len);    /* might not be null terminated */
  1232.       newaddr[len] = '\0';        /* is now */
  1233.       return newaddr;
  1234.   }
  1235. --- 832,838 ----
  1236.       register char *newaddr;
  1237.   
  1238.       New(903,newaddr,len+1,char);
  1239. !     Copy(str,newaddr,len,char);        /* might not be null terminated */
  1240.       newaddr[len] = '\0';        /* is now */
  1241.       return newaddr;
  1242.   }
  1243. ***************
  1244. *** 844,849 ****
  1245. --- 856,862 ----
  1246.   
  1247.   #ifndef I_VARARGS
  1248.   /*VARARGS1*/
  1249. + char *
  1250.   mess(pat,a1,a2,a3,a4)
  1251.   char *pat;
  1252.   long a1, a2, a3, a4;
  1253. ***************
  1254. *** 873,879 ****
  1255.           stab_io(last_in_stab) &&
  1256.           stab_io(last_in_stab)->lines ) {
  1257.           (void)sprintf(s,", <%s> line %ld",
  1258. !           last_in_stab == argvstab ? "" : stab_name(last_in_stab),
  1259.             (long)stab_io(last_in_stab)->lines);
  1260.           s += strlen(s);
  1261.       }
  1262. --- 886,892 ----
  1263.           stab_io(last_in_stab) &&
  1264.           stab_io(last_in_stab)->lines ) {
  1265.           (void)sprintf(s,", <%s> line %ld",
  1266. !           last_in_stab == argvstab ? "" : stab_ename(last_in_stab),
  1267.             (long)stab_io(last_in_stab)->lines);
  1268.           s += strlen(s);
  1269.       }
  1270. ***************
  1271. *** 888,894 ****
  1272.   }
  1273.   
  1274.   /*VARARGS1*/
  1275. ! fatal(pat,a1,a2,a3,a4)
  1276.   char *pat;
  1277.   long a1, a2, a3, a4;
  1278.   {
  1279. --- 901,907 ----
  1280.   }
  1281.   
  1282.   /*VARARGS1*/
  1283. ! void fatal(pat,a1,a2,a3,a4)
  1284.   char *pat;
  1285.   long a1, a2, a3, a4;
  1286.   {
  1287. ***************
  1288. *** 932,938 ****
  1289.   }
  1290.   
  1291.   /*VARARGS1*/
  1292. ! warn(pat,a1,a2,a3,a4)
  1293.   char *pat;
  1294.   long a1, a2, a3, a4;
  1295.   {
  1296. --- 945,951 ----
  1297.   }
  1298.   
  1299.   /*VARARGS1*/
  1300. ! void warn(pat,a1,a2,a3,a4)
  1301.   char *pat;
  1302.   long a1, a2, a3, a4;
  1303.   {
  1304. ***************
  1305. *** 1009,1015 ****
  1306.   }
  1307.   
  1308.   /*VARARGS0*/
  1309. ! fatal(va_alist)
  1310.   va_dcl
  1311.   {
  1312.       va_list args;
  1313. --- 1022,1028 ----
  1314.   }
  1315.   
  1316.   /*VARARGS0*/
  1317. ! void fatal(va_alist)
  1318.   va_dcl
  1319.   {
  1320.       va_list args;
  1321. ***************
  1322. *** 1059,1065 ****
  1323.   }
  1324.   
  1325.   /*VARARGS0*/
  1326. ! warn(va_alist)
  1327.   va_dcl
  1328.   {
  1329.       va_list args;
  1330. --- 1072,1078 ----
  1331.   }
  1332.   
  1333.   /*VARARGS0*/
  1334. ! void warn(va_alist)
  1335.   va_dcl
  1336.   {
  1337.       va_list args;
  1338. ***************
  1339. *** 1085,1091 ****
  1340.   #endif
  1341.   
  1342.   void
  1343. ! setenv(nam,val)
  1344.   char *nam, *val;
  1345.   {
  1346.       register int i=envix(nam);        /* where does it go? */
  1347. --- 1098,1104 ----
  1348.   #endif
  1349.   
  1350.   void
  1351. ! my_setenv(nam,val)
  1352.   char *nam, *val;
  1353.   {
  1354.       register int i=envix(nam);        /* where does it go? */
  1355. ***************
  1356. *** 1144,1149 ****
  1357. --- 1157,1163 ----
  1358.   }
  1359.   
  1360.   #ifdef EUNICE
  1361. + int
  1362.   unlnk(f)    /* unlink all versions of a file */
  1363.   char *f;
  1364.   {
  1365. ***************
  1366. *** 1154,1163 ****
  1367.   }
  1368.   #endif
  1369.   
  1370. ! #ifndef HAS_MEMCPY
  1371. ! #ifndef HAS_BCOPY
  1372.   char *
  1373. ! bcopy(from,to,len)
  1374.   register char *from;
  1375.   register char *to;
  1376.   register int len;
  1377. --- 1168,1176 ----
  1378.   }
  1379.   #endif
  1380.   
  1381. ! #if !defined(HAS_BCOPY) || !defined(SAFE_BCOPY)
  1382.   char *
  1383. ! my_bcopy(from,to,len)
  1384.   register char *from;
  1385.   register char *to;
  1386.   register int len;
  1387. ***************
  1388. *** 1164,1178 ****
  1389.   {
  1390.       char *retval = to;
  1391.   
  1392. !     while (len--)
  1393. !     *to++ = *from++;
  1394.       return retval;
  1395.   }
  1396.   #endif
  1397.   
  1398. ! #ifndef HAS_BZERO
  1399.   char *
  1400. ! bzero(loc,len)
  1401.   register char *loc;
  1402.   register int len;
  1403.   {
  1404. --- 1177,1199 ----
  1405.   {
  1406.       char *retval = to;
  1407.   
  1408. !     if (from - to >= 0) {
  1409. !     while (len--)
  1410. !         *to++ = *from++;
  1411. !     }
  1412. !     else {
  1413. !     to += len;
  1414. !     from += len;
  1415. !     while (len--)
  1416. !         --*to = --*from;
  1417. !     }
  1418.       return retval;
  1419.   }
  1420.   #endif
  1421.   
  1422. ! #if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
  1423.   char *
  1424. ! my_bzero(loc,len)
  1425.   register char *loc;
  1426.   register int len;
  1427.   {
  1428. ***************
  1429. *** 1183,1190 ****
  1430.       return retval;
  1431.   }
  1432.   #endif
  1433. - #endif
  1434.   
  1435.   #ifdef I_VARARGS
  1436.   #ifndef HAS_VPRINTF
  1437.   
  1438. --- 1204,1227 ----
  1439.       return retval;
  1440.   }
  1441.   #endif
  1442.   
  1443. + #ifndef HAS_MEMCMP
  1444. + int
  1445. + my_memcmp(s1,s2,len)
  1446. + register unsigned char *s1;
  1447. + register unsigned char *s2;
  1448. + register int len;
  1449. + {
  1450. +     register int tmp;
  1451. + 
  1452. +     while (len--) {
  1453. +     if (tmp = *s1++ - *s2++)
  1454. +         return tmp;
  1455. +     }
  1456. +     return 0;
  1457. + }
  1458. + #endif /* HAS_MEMCMP */
  1459. + 
  1460.   #ifdef I_VARARGS
  1461.   #ifndef HAS_VPRINTF
  1462.   
  1463. ***************
  1464. *** 1372,1378 ****
  1465.   VTOH(vtohl,long)
  1466.   #endif
  1467.   
  1468. ! #ifndef MSDOS
  1469.   FILE *
  1470.   mypopen(cmd,mode)
  1471.   char    *cmd;
  1472. --- 1409,1415 ----
  1473.   VTOH(vtohl,long)
  1474.   #endif
  1475.   
  1476. ! #ifndef DOSISH
  1477.   FILE *
  1478.   mypopen(cmd,mode)
  1479.   char    *cmd;
  1480. ***************
  1481. *** 1446,1453 ****
  1482.       forkprocess = pid;
  1483.       return fdopen(p[this], mode);
  1484.   }
  1485. ! #endif /* !MSDOS */
  1486.   
  1487.   #ifdef NOTDEF
  1488.   dumpfds(s)
  1489.   char *s;
  1490. --- 1483,1502 ----
  1491.       forkprocess = pid;
  1492.       return fdopen(p[this], mode);
  1493.   }
  1494. ! #else
  1495. ! #ifdef atarist
  1496. ! FILE *popen();
  1497. ! FILE *
  1498. ! mypopen(cmd,mode)
  1499. ! char    *cmd;
  1500. ! char    *mode;
  1501. ! {
  1502. !     return popen(cmd, mode);
  1503. ! }
  1504. ! #endif
  1505.   
  1506. + #endif /* !DOSISH */
  1507. + 
  1508.   #ifdef NOTDEF
  1509.   dumpfds(s)
  1510.   char *s;
  1511. ***************
  1512. *** 1488,1494 ****
  1513.   }
  1514.   #endif
  1515.   
  1516. ! #ifndef MSDOS
  1517.   int
  1518.   mypclose(ptr)
  1519.   FILE *ptr;
  1520. --- 1537,1543 ----
  1521.   }
  1522.   #endif
  1523.   
  1524. ! #ifndef DOSISH
  1525.   int
  1526.   mypclose(ptr)
  1527.   FILE *ptr;
  1528. ***************
  1529. *** 1506,1511 ****
  1530. --- 1555,1563 ----
  1531.       pid = (int)str->str_u.str_useful;
  1532.       astore(fdpid,fileno(ptr),Nullstr);
  1533.       fclose(ptr);
  1534. + #ifdef UTS
  1535. +     if(kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
  1536. + #endif
  1537.       hstat = signal(SIGHUP, SIG_IGN);
  1538.       istat = signal(SIGINT, SIG_IGN);
  1539.       qstat = signal(SIGQUIT, SIG_IGN);
  1540. ***************
  1541. *** 1551,1557 ****
  1542.       hiterinit(pidstatus);
  1543.       if (entry = hiternext(pidstatus)) {
  1544.           pid = atoi(hiterkey(entry,statusp));
  1545. !         str = hiterval(entry);
  1546.           *statusp = (int)str->str_u.str_useful;
  1547.           sprintf(spid, "%d", pid);
  1548.           hdelete(pidstatus,spid,strlen(spid));
  1549. --- 1603,1609 ----
  1550.       hiterinit(pidstatus);
  1551.       if (entry = hiternext(pidstatus)) {
  1552.           pid = atoi(hiterkey(entry,statusp));
  1553. !         str = hiterval(pidstatus,entry);
  1554.           *statusp = (int)str->str_u.str_useful;
  1555.           sprintf(spid, "%d", pid);
  1556.           hdelete(pidstatus,spid,strlen(spid));
  1557. ***************
  1558. *** 1570,1576 ****
  1559. --- 1622,1630 ----
  1560.   #endif
  1561.   #endif
  1562.   }
  1563. + #endif /* !DOSISH */
  1564.   
  1565. + void
  1566.   /*SUPPRESS 590*/
  1567.   pidgone(pid,status)
  1568.   int pid;
  1569. ***************
  1570. *** 1587,1609 ****
  1571.   #endif
  1572.       return;
  1573.   }
  1574. - #endif /* !MSDOS */
  1575.   
  1576. ! #ifndef HAS_MEMCMP
  1577. ! memcmp(s1,s2,len)
  1578. ! register unsigned char *s1;
  1579. ! register unsigned char *s2;
  1580. ! register int len;
  1581.   {
  1582. !     register int tmp;
  1583. ! 
  1584. !     while (len--) {
  1585. !     if (tmp = *s1++ - *s2++)
  1586. !         return tmp;
  1587. !     }
  1588. !     return 0;
  1589.   }
  1590. ! #endif /* HAS_MEMCMP */
  1591.   
  1592.   void
  1593.   repeatcpy(to,from,len,count)
  1594. --- 1641,1656 ----
  1595.   #endif
  1596.       return;
  1597.   }
  1598.   
  1599. ! #ifdef atarist
  1600. ! int pclose();
  1601. ! int
  1602. ! mypclose(ptr)
  1603. ! FILE *ptr;
  1604.   {
  1605. !     return pclose(ptr);
  1606.   }
  1607. ! #endif
  1608.   
  1609.   void
  1610.   repeatcpy(to,from,len,count)
  1611.  
  1612. Index: util.h
  1613. *** util.h.old    Mon Jun  8 17:52:38 1992
  1614. --- util.h    Mon Jun  8 17:52:39 1992
  1615. ***************
  1616. *** 1,4 ****
  1617. ! /* $RCSfile: util.h,v $$Revision: 4.0.1.2 $$Date: 91/11/05 19:18:40 $
  1618.    *
  1619.    *    Copyright (c) 1991, Larry Wall
  1620.    *
  1621. --- 1,4 ----
  1622. ! /* $RCSfile: util.h,v $$Revision: 4.0.1.3 $$Date: 92/06/08 16:09:20 $
  1623.    *
  1624.    *    Copyright (c) 1991, Larry Wall
  1625.    *
  1626. ***************
  1627. *** 6,11 ****
  1628. --- 6,14 ----
  1629.    *    License or the Artistic License, as specified in the README file.
  1630.    *
  1631.    * $Log:    util.h,v $
  1632. +  * Revision 4.0.1.3  92/06/08  16:09:20  lwall
  1633. +  * patch20: bcopy() and memcpy() now tested for overlap safety
  1634. +  * 
  1635.    * Revision 4.0.1.2  91/11/05  19:18:40  lwall
  1636.    * patch11: safe malloc code now integrated into Perl's malloc when possible
  1637.    * 
  1638. ***************
  1639. *** 30,36 ****
  1640.   char    *screaminstr();
  1641.   void    fbmcompile();
  1642.   char    *savestr();
  1643. ! void    setenv();
  1644.   int    envix();
  1645.   void    growstr();
  1646.   char    *ninstr();
  1647. --- 33,39 ----
  1648.   char    *screaminstr();
  1649.   void    fbmcompile();
  1650.   char    *savestr();
  1651. ! void    my_setenv();
  1652.   int    envix();
  1653.   void    growstr();
  1654.   char    *ninstr();
  1655. ***************
  1656. *** 38,50 ****
  1657.   char    *nsavestr();
  1658.   FILE    *mypopen();
  1659.   int    mypclose();
  1660. ! #ifndef HAS_MEMCPY
  1661. ! #ifndef HAS_BCOPY
  1662. ! char    *bcopy();
  1663.   #endif
  1664. ! #ifndef HAS_BZERO
  1665. ! char    *bzero();
  1666.   #endif
  1667.   #endif
  1668.   unsigned long scanoct();
  1669.   unsigned long scanhex();
  1670. --- 41,54 ----
  1671.   char    *nsavestr();
  1672.   FILE    *mypopen();
  1673.   int    mypclose();
  1674. ! #if !defined(HAS_BCOPY) || !defined(SAFE_BCOPY)
  1675. ! char    *my_bcopy();
  1676.   #endif
  1677. ! #if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
  1678. ! char    *my_bzero();
  1679.   #endif
  1680. + #ifndef HAS_MEMCMP
  1681. + int    my_memcmp();
  1682.   #endif
  1683.   unsigned long scanoct();
  1684.   unsigned long scanhex();
  1685.  
  1686. Index: hints/uts.sh
  1687. *** hints/uts.sh.old    Mon Jun  8 17:48:33 1992
  1688. --- hints/uts.sh    Mon Jun  8 17:48:34 1992
  1689. ***************
  1690. *** 1,2 ****
  1691.   ccflags="$ccflags -DCRIPPLED_CC"
  1692. ! d_lstat=$define
  1693. --- 1,2 ----
  1694.   ccflags="$ccflags -DCRIPPLED_CC"
  1695. ! d_lstat=define
  1696.  
  1697. Index: x2p/walk.c
  1698. *** x2p/walk.c.old    Mon Jun  8 17:53:03 1992
  1699. --- x2p/walk.c    Mon Jun  8 17:53:03 1992
  1700. ***************
  1701. *** 1,4 ****
  1702. ! /* $RCSfile: walk.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 19:25:09 $
  1703.    *
  1704.    *    Copyright (c) 1991, Larry Wall
  1705.    *
  1706. --- 1,4 ----
  1707. ! /* $RCSfile: walk.c,v $$Revision: 4.0.1.3 $$Date: 92/06/08 17:33:46 $
  1708.    *
  1709.    *    Copyright (c) 1991, Larry Wall
  1710.    *
  1711. ***************
  1712. *** 6,11 ****
  1713. --- 6,17 ----
  1714.    *    License or the Artistic License, as specified in the README file.
  1715.    *
  1716.    * $Log:    walk.c,v $
  1717. +  * Revision 4.0.1.3  92/06/08  17:33:46  lwall
  1718. +  * patch20: in a2p, simplified the filehandle model
  1719. +  * patch20: in a2p, made RS="" translate to $/ = "\n\n"
  1720. +  * patch20: in a2p, do {...} while ... was missing some reconstruction code
  1721. +  * patch20: in a2p, getline should allow variable to be array element
  1722. +  * 
  1723.    * Revision 4.0.1.2  91/11/05  19:25:09  lwall
  1724.    * patch11: in a2p, split on whitespace produced extra null field
  1725.    * 
  1726. ***************
  1727. *** 211,221 ****
  1728.           str_cat(str,"\n\
  1729.   sub Pick {\n\
  1730.       local($mode,$name,$pipe) = @_;\n\
  1731. !     $fh = $opened{$name};\n\
  1732. !     if (!$fh) {\n\
  1733. !     $fh = $opened{$name} = 'fh_' . ($nextfh++ + 0);\n\
  1734. !     open($fh,$mode.$name.$pipe);\n\
  1735. !     }\n\
  1736.   }\n\
  1737.   ");
  1738.       }
  1739. --- 217,224 ----
  1740.           str_cat(str,"\n\
  1741.   sub Pick {\n\
  1742.       local($mode,$name,$pipe) = @_;\n\
  1743. !     $fh = $name;\n\
  1744. !     open($name,$mode.$name.$pipe) unless $opened{$name}++;\n\
  1745.   }\n\
  1746.   ");
  1747.       }
  1748. ***************
  1749. *** 468,473 ****
  1750. --- 471,478 ----
  1751.       str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec));
  1752.       str_free(fstr);
  1753.       numeric |= numarg;
  1754. +     if (strEQ(str->str_ptr,"$/ = ''"))
  1755. +         str_set(str, "$/ = \"\\n\\n\"");
  1756.       break;
  1757.       case OADD:
  1758.       prec = P_ADD;
  1759. ***************
  1760. *** 570,579 ****
  1761.       if (useval)
  1762.           str_cat(str,"(");
  1763.       if (len > 0) {
  1764. -         str_cat(str,"$");
  1765.           str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
  1766.           if (!*fstr->str_ptr) {
  1767. !         str_cat(str,"_");
  1768.           len = 2;        /* a legal fiction */
  1769.           }
  1770.           str_free(fstr);
  1771. --- 575,583 ----
  1772.       if (useval)
  1773.           str_cat(str,"(");
  1774.       if (len > 0) {
  1775.           str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
  1776.           if (!*fstr->str_ptr) {
  1777. !         str_cat(str,"$_");
  1778.           len = 2;        /* a legal fiction */
  1779.           }
  1780.           str_free(fstr);
  1781. ***************
  1782. *** 1137,1144 ****
  1783.           str_cat(str,tokenbuf);
  1784.       }
  1785.       else {
  1786. !         sprintf(tokenbuf,"$fh = delete $opened{%s} && close($fh)",
  1787. !            tmpstr->str_ptr);
  1788.           str_free(tmpstr);
  1789.           str_set(str,tokenbuf);
  1790.       }
  1791. --- 1141,1148 ----
  1792.           str_cat(str,tokenbuf);
  1793.       }
  1794.       else {
  1795. !         sprintf(tokenbuf,"delete $opened{%s} && close(%s)",
  1796. !            tmpstr->str_ptr, tmpstr->str_ptr);
  1797.           str_free(tmpstr);
  1798.           str_set(str,tokenbuf);
  1799.       }
  1800. ***************
  1801. *** 1414,1419 ****
  1802. --- 1418,1435 ----
  1803.       str_cat(str,") ");
  1804.       str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
  1805.       str_free(fstr);
  1806. +     break;
  1807. +     case ODO:
  1808. +     str = str_new(0);
  1809. +     str_set(str,"do ");
  1810. +     str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
  1811. +     str_free(fstr);
  1812. +     if (str->str_ptr[str->str_cur - 1] == '\n')
  1813. +         --str->str_cur;;
  1814. +     str_cat(str," while (");
  1815. +     str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
  1816. +     str_free(fstr);
  1817. +     str_cat(str,");");
  1818.       break;
  1819.       case OFOR:
  1820.       str = str_new(0);
  1821.  
  1822. Index: eg/who
  1823. *** eg/who.old    Mon Jun  8 17:47:11 1992
  1824. --- eg/who    Mon Jun  8 17:47:12 1992
  1825. ***************
  1826. *** 5,11 ****
  1827.   while (read(UTMP,$utmp,36)) {
  1828.       ($line,$name,$host,$time) = unpack('A8A8A16l',$utmp);
  1829.       if ($name) {
  1830. !     $host = "($host)" if $host;
  1831.       ($sec,$min,$hour,$mday,$mon) = localtime($time);
  1832.       printf "%-9s%-8s%s %2d %02d:%02d   %s\n",
  1833.         $name,$line,$mo[$mon],$mday,$hour,$min,$host;
  1834. --- 5,11 ----
  1835.   while (read(UTMP,$utmp,36)) {
  1836.       ($line,$name,$host,$time) = unpack('A8A8A16l',$utmp);
  1837.       if ($name) {
  1838. !     $host = "($host)" if ord($host);
  1839.       ($sec,$min,$hour,$mday,$mon) = localtime($time);
  1840.       printf "%-9s%-8s%s %2d %02d:%02d   %s\n",
  1841.         $name,$line,$mo[$mon],$mday,$hour,$min,$host;
  1842.  
  1843. *** End of Patch 32 ***
  1844. exit 0 # Just in case...
  1845.