home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume13 / perl / part10 < prev    next >
Encoding:
Internet Message Format  |  1988-01-30  |  49.3 KB

  1. Subject:  v13i010:  Perl, a "replacement" for awk and sed, Part10/10
  2. Newsgroups: comp.sources.unix
  3. Sender: sources
  4. Approved: rsalz@uunet.UU.NET
  5.  
  6. Submitted-by: Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
  7. Posting-number: Volume 13, Issue 10
  8. Archive-name: perl/part10
  9.  
  10.  
  11. #! /bin/sh
  12.  
  13. # Make a new directory for the perl sources, cd to it, and run kits 1
  14. # thru 10 through sh.  When all 10 kits have been run, read README.
  15.  
  16. echo "This is perl 1.0 kit 10 (of 10).  If kit 10 is complete, the line"
  17. echo '"'"End of kit 10 (of 10)"'" will echo at the end.'
  18. echo ""
  19. export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
  20. mkdir t 2>/dev/null
  21. mkdir x2p 2>/dev/null
  22. echo Extracting x2p/s2p.man
  23. sed >x2p/s2p.man <<'!STUFFY!FUNK!' -e 's/X//'
  24. X.rn '' }`
  25. X''' $Header: s2p.man,v 1.0 87/12/18 17:37:16 root Exp $
  26. X''' 
  27. X''' $Log:    s2p.man,v $
  28. X''' Revision 1.0  87/12/18  17:37:16  root
  29. X''' Initial revision
  30. X''' 
  31. X''' 
  32. X.de Sh
  33. X.br
  34. X.ne 5
  35. X.PP
  36. X\fB\\$1\fR
  37. X.PP
  38. X..
  39. X.de Sp
  40. X.if t .sp .5v
  41. X.if n .sp
  42. X..
  43. X.de Ip
  44. X.br
  45. X.ie \\n.$>=3 .ne \\$3
  46. X.el .ne 3
  47. X.IP "\\$1" \\$2
  48. X..
  49. X'''
  50. X'''     Set up \*(-- to give an unbreakable dash;
  51. X'''     string Tr holds user defined translation string.
  52. X'''     Bell System Logo is used as a dummy character.
  53. X'''
  54. X.tr \(bs-|\(bv\*(Tr
  55. X.ie n \{\
  56. X.ds -- \(bs-
  57. X.if (\n(.H=4u)&(1m=24u) .ds -- \(bs\h'-12u'\(bs\h'-12u'-\" diablo 10 pitch
  58. X.if (\n(.H=4u)&(1m=20u) .ds -- \(bs\h'-12u'\(bs\h'-8u'-\" diablo 12 pitch
  59. X.ds L" ""
  60. X.ds R" ""
  61. X.ds L' '
  62. X.ds R' '
  63. X'br\}
  64. X.el\{\
  65. X.ds -- \(em\|
  66. X.tr \*(Tr
  67. X.ds L" ``
  68. X.ds R" ''
  69. X.ds L' `
  70. X.ds R' '
  71. X'br\}
  72. X.TH S2P 1 NEW
  73. X.SH NAME
  74. Xs2p - Sed to Perl translator
  75. X.SH SYNOPSIS
  76. X.B s2p [options] filename
  77. X.SH DESCRIPTION
  78. X.I S2p
  79. Xtakes a sed script specified on the command line (or from standard input)
  80. Xand produces a comparable
  81. X.I perl
  82. Xscript on the standard output.
  83. X.Sh "Options"
  84. XOptions include:
  85. X.TP 5
  86. X.B \-D<number>
  87. Xsets debugging flags.
  88. X.TP 5
  89. X.B \-n
  90. Xspecifies that this sed script was always invoked with a sed -n.
  91. XOtherwise a switch parser is prepended to the front of the script.
  92. X.TP 5
  93. X.B \-p
  94. Xspecifies that this sed script was never invoked with a sed -n.
  95. XOtherwise a switch parser is prepended to the front of the script.
  96. X.Sh "Considerations"
  97. XThe perl script produced looks very sed-ish, and there may very well be
  98. Xbetter ways to express what you want to do in perl.
  99. XFor instance, s2p does not make any use of the split operator, but you might
  100. Xwant to.
  101. X.PP
  102. XThe perl script you end up with may be either faster or slower than the original
  103. Xsed script.
  104. XIf you're only interested in speed you'll just have to try it both ways.
  105. XOf course, if you want to do something sed doesn't do, you have no choice.
  106. X.SH ENVIRONMENT
  107. XS2p uses no environment variables.
  108. X.SH AUTHOR
  109. XLarry Wall <lwall@jpl-devvax.Jpl.Nasa.Gov>
  110. X.SH FILES
  111. X.SH SEE ALSO
  112. Xperl    The perl compiler/interpreter
  113. X.br
  114. Xa2p    awk to perl translator
  115. X.SH DIAGNOSTICS
  116. X.SH BUGS
  117. X.rn }` ''
  118. !STUFFY!FUNK!
  119. echo Extracting stab.h
  120. sed >stab.h <<'!STUFFY!FUNK!' -e 's/X//'
  121. X/* $Header: stab.h,v 1.0 87/12/18 13:06:18 root Exp $
  122. X *
  123. X * $Log:    stab.h,v $
  124. X * Revision 1.0  87/12/18  13:06:18  root
  125. X * Initial revision
  126. X * 
  127. X */
  128. X
  129. Xstruct stab {
  130. X    struct stab *stab_next;
  131. X    char    *stab_name;
  132. X    STR        *stab_val;
  133. X    struct stio *stab_io;
  134. X    FCMD    *stab_form;
  135. X    ARRAY    *stab_array;
  136. X    HASH    *stab_hash;
  137. X    CMD        *stab_sub;
  138. X    char    stab_flags;
  139. X};
  140. X
  141. X#define SF_VMAGIC 1        /* call routine to dereference STR val */
  142. X
  143. Xstruct stio {
  144. X    FILE    *fp;
  145. X    long    lines;
  146. X    long    page;
  147. X    long    page_len;
  148. X    long    lines_left;
  149. X    char    *top_name;
  150. X    STAB    *top_stab;
  151. X    char    *fmt_name;
  152. X    STAB    *fmt_stab;
  153. X    char    type;
  154. X    char    flags;
  155. X};
  156. X
  157. X#define IOF_ARGV 1    /* this fp iterates over ARGV */
  158. X#define IOF_START 2    /* check for null ARGV and substitute '-' */
  159. X#define IOF_FLUSH 4    /* this fp wants a flush after write op */
  160. X
  161. X#define Nullstab Null(STAB*)
  162. X
  163. X#define STAB_STR(s) (tmpstab = (s), tmpstab->stab_flags & SF_VMAGIC ? stab_str(tmpstab) : tmpstab->stab_val)
  164. X#define STAB_GET(s) (tmpstab = (s), str_get(tmpstab->stab_flags & SF_VMAGIC ? stab_str(tmpstab) : tmpstab->stab_val))
  165. X#define STAB_GNUM(s) (tmpstab = (s), str_gnum(tmpstab->stab_flags & SF_VMAGIC ? stab_str(tmpstab) : tmpstab->stab_val))
  166. X
  167. XEXT STAB *tmpstab;
  168. X
  169. XEXT STAB *stab_index[128];
  170. X
  171. XEXT char *envname;    /* place for ENV name being assigned--gross cheat */
  172. XEXT char *signame;    /* place for SIG name being assigned--gross cheat */
  173. X
  174. XEXT int statusvalue;
  175. XEXT int subsvalue;
  176. X
  177. XSTAB *aadd();
  178. XSTAB *hadd();
  179. !STUFFY!FUNK!
  180. echo Extracting makedir.SH
  181. sed >makedir.SH <<'!STUFFY!FUNK!' -e 's/X//'
  182. Xcase $CONFIG in
  183. X'')
  184. X    if test ! -f config.sh; then
  185. X    ln ../config.sh . || \
  186. X    ln ../../config.sh . || \
  187. X    ln ../../../config.sh . || \
  188. X    (echo "Can't find config.sh."; exit 1)
  189. X    fi
  190. X    . config.sh
  191. X    ;;
  192. Xesac
  193. Xcase "$0" in
  194. X*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
  195. Xesac
  196. Xecho "Extracting makedir (with variable substitutions)"
  197. X$spitshell >makedir <<!GROK!THIS!
  198. X$startsh
  199. X# $Header: makedir.SH,v 1.0 87/12/18 13:05:32 root Exp $
  200. X# 
  201. X# $Log:    makedir.SH,v $
  202. X# Revision 1.0  87/12/18  13:05:32  root
  203. X# Initial revision
  204. X# 
  205. X# Revision 4.3.1.1  85/05/10  11:35:14  lwall
  206. X# Branch for patches.
  207. X# 
  208. X# Revision 4.3  85/05/01  11:42:31  lwall
  209. X# Baseline for release with 4.3bsd.
  210. X# 
  211. X
  212. Xexport PATH || (echo "OOPS, this isn't sh.  Desperation time.  I will feed myself to sh."; sh \$0; kill \$\$)
  213. X
  214. Xcase \$# in
  215. X  0)
  216. X    $echo "makedir pathname filenameflag"
  217. X    exit 1
  218. X    ;;
  219. Xesac
  220. X
  221. X: guarantee one slash before 1st component
  222. Xcase \$1 in
  223. X  /*) ;;
  224. X  *)  set ./\$1 \$2 ;;
  225. Xesac
  226. X
  227. X: strip last component if it is to be a filename
  228. Xcase X\$2 in
  229. X  X1) set \`$echo \$1 | $sed 's:\(.*\)/[^/]*\$:\1:'\` ;;
  230. X  *)  set \$1 ;;
  231. Xesac
  232. X
  233. X: return reasonable status if nothing to be created
  234. Xif $test -d "\$1" ; then
  235. X    exit 0
  236. Xfi
  237. X
  238. Xlist=''
  239. Xwhile true ; do
  240. X    case \$1 in
  241. X    */*)
  242. X    list="\$1 \$list"
  243. X    set \`echo \$1 | $sed 's:\(.*\)/:\1 :'\`
  244. X    ;;
  245. X    *)
  246. X    break
  247. X    ;;
  248. X    esac
  249. Xdone
  250. X
  251. Xset \$list
  252. X
  253. Xfor dir do
  254. X    $mkdir \$dir >/dev/null 2>&1
  255. Xdone
  256. X!GROK!THIS!
  257. X$eunicefix makedir
  258. Xchmod 755 makedir
  259. !STUFFY!FUNK!
  260. echo Extracting t/cmd.subval
  261. sed >t/cmd.subval <<'!STUFFY!FUNK!' -e 's/X//'
  262. X#!./perl
  263. X
  264. X# $Header: cmd.subval,v 1.0 87/12/18 13:12:12 root Exp $
  265. X
  266. Xsub foo1 {
  267. X    'true1';
  268. X    if ($_[0]) { 'true2'; }
  269. X}
  270. X
  271. Xsub foo2 {
  272. X    'true1';
  273. X    if ($_[0]) { 'true2'; } else { 'true3'; }
  274. X}
  275. X
  276. Xsub foo3 {
  277. X    'true1';
  278. X    unless ($_[0]) { 'true2'; }
  279. X}
  280. X
  281. Xsub foo4 {
  282. X    'true1';
  283. X    unless ($_[0]) { 'true2'; } else { 'true3'; }
  284. X}
  285. X
  286. Xsub foo5 {
  287. X    'true1';
  288. X    'true2' if $_[0];
  289. X}
  290. X
  291. Xsub foo6 {
  292. X    'true1';
  293. X    'true2' unless $_[0];
  294. X}
  295. X
  296. Xprint "1..12\n";
  297. X
  298. Xif (do foo1(0) eq '') {print "ok 1\n";} else {print "not ok 1\n";}
  299. Xif (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
  300. Xif (do foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
  301. Xif (do foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
  302. X
  303. Xif (do foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
  304. Xif (do foo3(1) eq '') {print "ok 6\n";} else {print "not ok 6\n";}
  305. Xif (do foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
  306. Xif (do foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
  307. X
  308. Xif (do foo5(0) eq '') {print "ok 9\n";} else {print "not ok 9\n";}
  309. Xif (do foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
  310. Xif (do foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
  311. Xif (do foo6(1) eq '') {print "ok 12\n";} else {print "not ok 12\n";}
  312. !STUFFY!FUNK!
  313. echo Extracting t/TEST
  314. sed >t/TEST <<'!STUFFY!FUNK!' -e 's/X//'
  315. X#!./perl
  316. X
  317. X# $Header: TEST,v 1.0 87/12/18 13:11:34 root Exp $
  318. X
  319. X# This is written in a peculiar style, since we're trying to avoid
  320. X# most of the constructs we'll be testing for.
  321. X
  322. Xif ($ARGV[0] eq '-v') {
  323. X    $verbose = 1;
  324. X    shift;
  325. X}
  326. X
  327. Xif ($ARGV[0] eq '') {
  328. X    @ARGV = split(/[ \n]/,`echo base.* comp.* cmd.* io.* op.*`);
  329. X}
  330. X
  331. X$bad = 0;
  332. Xwhile ($test = shift) {
  333. X    print "$test...";
  334. X    open(results,"$test|") || (print "can't run.\n");
  335. X    $ok = 0;
  336. X    while (<results>) {
  337. X    if ($verbose) {
  338. X        print $_;
  339. X    }
  340. X    unless (/^#/) {
  341. X        if (/^1\.\.([0-9]+)/) {
  342. X        $max = $1;
  343. X        $next = 1;
  344. X        $ok = 1;
  345. X        } else {
  346. X        if (/^ok (.*)/ && $1 == $next) {
  347. X            $next = $next + 1;
  348. X        } else {
  349. X            $ok = 0;
  350. X        }
  351. X        }
  352. X    }
  353. X    }
  354. X    $next = $next - 1;
  355. X    if ($ok && $next == $max) {
  356. X    print "ok\n";
  357. X    } else {
  358. X    $next += 1;
  359. X    print "FAILED on test $next\n";
  360. X    $bad = $bad + 1;
  361. X    $_ = $test;
  362. X    if (/^base/) {
  363. X        die "Failed a basic test--cannot continue.";
  364. X    }
  365. X    }
  366. X}
  367. X
  368. Xif ($bad == 0) {
  369. X    if ($ok) {
  370. X    print "All tests successful.\n";
  371. X    } else {
  372. X    die "FAILED--no tests were run for some reason.";
  373. X    }
  374. X} else {
  375. X    if ($bad == 1) {
  376. X    die "Failed 1 test.";
  377. X    } else {
  378. X    die "Failed $bad tests.";
  379. X    }
  380. X}
  381. X($user,$sys,$cuser,$csys) = times;
  382. Xprint sprintf("u=%g  s=%g  cu=%g  cs=%g\n",$user,$sys,$cuser,$csys);
  383. !STUFFY!FUNK!
  384. echo Extracting t/op.list
  385. sed >t/op.list <<'!STUFFY!FUNK!' -e 's/X//'
  386. X#!./perl
  387. X
  388. X# $Header: op.list,v 1.0 87/12/18 13:13:50 root Exp $
  389. X
  390. Xprint "1..11\n";
  391. X
  392. X@foo = (1, 2, 3, 4);
  393. Xif ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
  394. X
  395. X$_ = join(foo,':');
  396. Xif ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
  397. X
  398. X($a,$b,$c,$d) = (1,2,3,4);
  399. Xif ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 3\n";} else {print "not ok 3\n";}
  400. X
  401. X($c,$b,$a) = split(/ /,"111 222 333");
  402. Xif ("$a;$b;$c" eq '333;222;111') {print "ok 4\n";} else {print "not ok 4\n";}
  403. X
  404. X($a,$b,$c) = ($c,$b,$a);
  405. Xif ("$a;$b;$c" eq '111;222;333') {print "ok 5\n";} else {print "not ok 5\n";}
  406. X
  407. X($a, $b) = ($b, $a);
  408. Xif ("$a;$b;$c" eq '222;111;333') {print "ok 6\n";} else {print "not ok 6\n";}
  409. X
  410. X($a, $b[1], $c{2}, $d) = (1, 2, 3, 4);
  411. Xif ($a eq 1) {print "ok 7\n";} else {print "not ok 7\n";}
  412. Xif ($b[1] eq 2) {print "ok 8\n";} else {print "not ok 8\n";}
  413. Xif ($c{2} eq 3) {print "ok 9\n";} else {print "not ok 9\n";}
  414. Xif ($d eq 4) {print "ok 10\n";} else {print "not ok 10\n";}
  415. X
  416. X@foo = (1,2,3,4,5,6,7,8);
  417. X($a, $b, $c, $d) = @foo;
  418. Xprint "#11    $a;$b;$c;$d eq 1;2;3;4\n";
  419. Xif ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 11\n";} else {print "not ok 11\n";}
  420. !STUFFY!FUNK!
  421. echo Extracting t/io.tell
  422. sed >t/io.tell <<'!STUFFY!FUNK!' -e 's/X//'
  423. X#!./perl
  424. X
  425. X# $Header: io.tell,v 1.0 87/12/18 13:13:02 root Exp $
  426. X
  427. Xprint "1..13\n";
  428. X
  429. Xopen(tst, '../Makefile') || (die "Can't open ../Makefile");
  430. X
  431. Xif (eof(tst)) { print "not ok 1\n"; } else { print "ok 1\n"; }
  432. X
  433. X$firstline = <tst>;
  434. X$secondpos = tell;
  435. X
  436. X$x = 0;
  437. Xwhile (<tst>) {
  438. X    if (eof) {$x++;}
  439. X}
  440. Xif ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; }
  441. X
  442. X$lastpos = tell;
  443. X
  444. Xunless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; }
  445. X
  446. Xif (seek(tst,0,0)) { print "ok 4\n"; } else { print "not ok 4\n"; }
  447. X
  448. Xif (eof) { print "not ok 5\n"; } else { print "ok 5\n"; }
  449. X
  450. Xif ($firstline eq <tst>) { print "ok 6\n"; } else { print "not ok 6\n"; }
  451. X
  452. Xif ($secondpos == tell) { print "ok 7\n"; } else { print "not ok 7\n"; }
  453. X
  454. Xif (seek(tst,0,1)) { print "ok 8\n"; } else { print "not ok 8\n"; }
  455. X
  456. Xif (eof) { print "not ok 9\n"; } else { print "ok 9\n"; }
  457. X
  458. Xif ($secondpos == tell) { print "ok 10\n"; } else { print "not ok 10\n"; }
  459. X
  460. Xif (seek(tst,0,2)) { print "ok 11\n"; } else { print "not ok 11\n"; }
  461. X
  462. Xif ($lastpos == tell) { print "ok 12\n"; } else { print "not ok 12\n"; }
  463. X
  464. Xunless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; }
  465. !STUFFY!FUNK!
  466. echo Extracting search.h
  467. sed >search.h <<'!STUFFY!FUNK!' -e 's/X//'
  468. X/* $Header: search.h,v 1.0 87/12/18 13:06:06 root Exp $
  469. X *
  470. X * $Log:    search.h,v $
  471. X * Revision 1.0  87/12/18  13:06:06  root
  472. X * Initial revision
  473. X * 
  474. X */
  475. X
  476. X#ifndef MAXSUB
  477. X#define    MAXSUB    10        /* how many sub-patterns are allowed */
  478. X#define MAXALT    10        /* how many alternatives are allowed */
  479. Xtypedef struct {    
  480. X    char *precomp;        /* the original pattern, for debug output */
  481. X    char *compbuf;        /* the compiled pattern */
  482. X    int complen;        /* length of compbuf */
  483. X    char *alternatives[MAXALT];    /* list of alternatives */
  484. X    char *subbeg[MAXSUB];    /* subpattern start list */
  485. X    char *subend[MAXSUB];    /* subpattern end list */
  486. X    char *subbase;        /* saved match string after execute() */
  487. X    char lastparen;        /* which subpattern matched last */
  488. X    char numsubs;        /* how many subpatterns the compiler saw */
  489. X    bool do_folding;        /* fold upper and lower case? */
  490. X} COMPEX;
  491. X
  492. XEXT int multiline INIT(0);
  493. X
  494. Xvoid    search_init();
  495. Xvoid    init_compex();
  496. Xvoid    free_compex();
  497. Xchar    *getparen();
  498. Xvoid    case_fold();
  499. Xchar    *compile(); 
  500. Xvoid    grow_comp();
  501. Xchar    *execute(); 
  502. Xbool    try();
  503. Xbool    subpat(); 
  504. Xbool    cclass(); 
  505. X#endif
  506. !STUFFY!FUNK!
  507. echo Extracting hash.h
  508. sed >hash.h <<'!STUFFY!FUNK!' -e 's/X//'
  509. X/* $Header: hash.h,v 1.0 87/12/18 13:05:20 root Exp $
  510. X *
  511. X * $Log:    hash.h,v $
  512. X * Revision 1.0  87/12/18  13:05:20  root
  513. X * Initial revision
  514. X * 
  515. X */
  516. X
  517. X#define FILLPCT 60        /* don't make greater than 99 */
  518. X
  519. X#ifdef DOINIT
  520. Xchar coeff[] = {
  521. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  522. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  523. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  524. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  525. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  526. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  527. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  528. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1};
  529. X#else
  530. Xextern char coeff[];
  531. X#endif
  532. X
  533. Xtypedef struct hentry HENT;
  534. X
  535. Xstruct hentry {
  536. X    HENT    *hent_next;
  537. X    char    *hent_key;
  538. X    STR        *hent_val;
  539. X    int        hent_hash;
  540. X};
  541. X
  542. Xstruct htbl {
  543. X    HENT    **tbl_array;
  544. X    int        tbl_max;
  545. X    int        tbl_fill;
  546. X    int        tbl_riter;    /* current root of iterator */
  547. X    HENT    *tbl_eiter;    /* current entry of iterator */
  548. X};
  549. X
  550. XSTR *hfetch();
  551. Xbool hstore();
  552. Xbool hdelete();
  553. XHASH *hnew();
  554. Xint hiterinit();
  555. XHENT *hiternext();
  556. Xchar *hiterkey();
  557. XSTR *hiterval();
  558. !STUFFY!FUNK!
  559. echo Extracting x2p/hash.h
  560. sed >x2p/hash.h <<'!STUFFY!FUNK!' -e 's/X//'
  561. X/* $Header: hash.h,v 1.0 87/12/18 13:07:23 root Exp $
  562. X *
  563. X * $Log:    hash.h,v $
  564. X * Revision 1.0  87/12/18  13:07:23  root
  565. X * Initial revision
  566. X * 
  567. X */
  568. X
  569. X#define FILLPCT 60        /* don't make greater than 99 */
  570. X
  571. X#ifdef DOINIT
  572. Xchar coeff[] = {
  573. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  574. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  575. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  576. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  577. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  578. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  579. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
  580. X        61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1};
  581. X#else
  582. Xextern char coeff[];
  583. X#endif
  584. X
  585. Xtypedef struct hentry HENT;
  586. X
  587. Xstruct hentry {
  588. X    HENT    *hent_next;
  589. X    char    *hent_key;
  590. X    STR        *hent_val;
  591. X    int        hent_hash;
  592. X};
  593. X
  594. Xstruct htbl {
  595. X    HENT    **tbl_array;
  596. X    int        tbl_max;
  597. X    int        tbl_fill;
  598. X    int        tbl_riter;    /* current root of iterator */
  599. X    HENT    *tbl_eiter;    /* current entry of iterator */
  600. X};
  601. X
  602. XSTR *hfetch();
  603. Xbool hstore();
  604. Xbool hdelete();
  605. XHASH *hnew();
  606. Xint hiterinit();
  607. XHENT *hiternext();
  608. Xchar *hiterkey();
  609. XSTR *hiterval();
  610. !STUFFY!FUNK!
  611. echo Extracting t/op.time
  612. sed >t/op.time <<'!STUFFY!FUNK!' -e 's/X//'
  613. X#!./perl
  614. X
  615. X# $Header: op.time,v 1.0 87/12/18 13:14:33 root Exp $
  616. X
  617. Xprint "1..5\n";
  618. X
  619. X($beguser,$begsys) = times;
  620. X
  621. X$beg = time;
  622. X
  623. Xwhile (($now = time) == $beg) {}
  624. X
  625. Xif ($now > $beg && $now - $beg < 10){print "ok 1\n";} else {print "not ok 1\n";}
  626. X
  627. Xfor ($i = 0; $i < 100000; $i++) {
  628. X    ($nowuser, $nowsys) = times;
  629. X    $i = 200000 if $nowuser > $beguser && $nowsys > $begsys;
  630. X    last if time - $beg > 20;
  631. X}
  632. X
  633. Xif ($i >= 200000) {print "ok 2\n";} else {print "not ok 2\n";}
  634. X
  635. X($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($beg);
  636. X($xsec,$foo) = localtime($now);
  637. X$localyday = $yday;
  638. X
  639. Xif ($sec != $xsec && $yday && $wday && $year)
  640. X    {print "ok 3\n";}
  641. Xelse
  642. X    {print "not ok 3\n";}
  643. X
  644. X($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($beg);
  645. X($xsec,$foo) = localtime($now);
  646. X
  647. Xif ($sec != $xsec && $yday && $wday && $year)
  648. X    {print "ok 4\n";}
  649. Xelse
  650. X    {print "not ok 4\n";}
  651. X
  652. Xif (index(" :0:1:-1:365:366:-365:-366:",':' . ($localyday - $yday) . ':') > 0)
  653. X    {print "ok 5\n";}
  654. Xelse
  655. X    {print "not ok 5\n";}
  656. !STUFFY!FUNK!
  657. echo Extracting t/op.subst
  658. sed >t/op.subst <<'!STUFFY!FUNK!' -e 's/X//'
  659. X#!./perl
  660. X
  661. X# $Header: op.subst,v 1.0 87/12/18 13:14:30 root Exp $
  662. X
  663. Xprint "1..7\n";
  664. X
  665. X$x = 'foo';
  666. X$_ = "x";
  667. Xs/x/\$x/;
  668. Xprint "#1\t:$_: eq :\$x:\n";
  669. Xif ($_ eq '$x') {print "ok 1\n";} else {print "not ok 1\n";}
  670. X
  671. X$_ = "x";
  672. Xs/x/$x/;
  673. Xprint "#2\t:$_: eq :foo:\n";
  674. Xif ($_ eq 'foo') {print "ok 2\n";} else {print "not ok 2\n";}
  675. X
  676. X$_ = "x";
  677. Xs/x/\$x $x/;
  678. Xprint "#3\t:$_: eq :\$x foo:\n";
  679. Xif ($_ eq '$x foo') {print "ok 3\n";} else {print "not ok 3\n";}
  680. X
  681. X$a = 'abcdef';
  682. X$b = 'cd';
  683. X$a =~ s'(b${b}e)'\n$1';
  684. Xprint "#4\t:$1: eq :bcde:\n";
  685. Xprint "#4\t:$a: eq :a\\n\$1f:\n";
  686. Xif ($1 eq 'bcde' && $a eq 'a\n$1f') {print "ok 4\n";} else {print "not ok 4\n";}
  687. X
  688. X$a = 'abacada';
  689. Xif (($a =~ s/a/x/g) == 4 && $a eq 'xbxcxdx')
  690. X    {print "ok 5\n";} else {print "not ok 5\n";}
  691. X
  692. Xif (($a =~ s/a/y/g) == 0 && $a eq 'xbxcxdx')
  693. X    {print "ok 6\n";} else {print "not ok 6\n";}
  694. X
  695. Xif (($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx')
  696. X    {print "ok 7\n";} else {print "not ok 7\n";}
  697. !STUFFY!FUNK!
  698. echo Extracting str.h
  699. sed >str.h <<'!STUFFY!FUNK!' -e 's/X//'
  700. X/* $Header: str.h,v 1.0 87/12/18 13:06:26 root Exp $
  701. X *
  702. X * $Log:    str.h,v $
  703. X * Revision 1.0  87/12/18  13:06:26  root
  704. X * Initial revision
  705. X * 
  706. X */
  707. X
  708. Xstruct string {
  709. X    char *    str_ptr;    /* pointer to malloced string */
  710. X    double    str_nval;    /* numeric value, if any */
  711. X    int        str_len;    /* allocated size */
  712. X    int        str_cur;    /* length of str_ptr as a C string */
  713. X    union {
  714. X    STR *str_next;        /* while free, link to next free str */
  715. X    STAB *str_magic;    /* while in use, ptr to magic stab, if any */
  716. X    } str_link;
  717. X    char    str_pok;    /* state of str_ptr */
  718. X    char    str_nok;    /* state of str_nval */
  719. X};
  720. X
  721. X#define Nullstr Null(STR*)
  722. X
  723. X/* the following macro updates any magic values this str is associated with */
  724. X
  725. X#define STABSET(x) (x->str_link.str_magic && stabset(x->str_link.str_magic,x))
  726. X
  727. XEXT STR **tmps_list;
  728. XEXT long tmps_max INIT(-1);
  729. X
  730. Xchar *str_2ptr();
  731. Xdouble str_2num();
  732. XSTR *str_static();
  733. XSTR *str_make();
  734. XSTR *str_nmake();
  735. !STUFFY!FUNK!
  736. echo Extracting t/op.repeat
  737. sed >t/op.repeat <<'!STUFFY!FUNK!' -e 's/X//'
  738. X#!./perl
  739. X
  740. X# $Header: op.repeat,v 1.0 87/12/18 13:14:14 root Exp $
  741. X
  742. Xprint "1..11\n";
  743. X
  744. X# compile time
  745. X
  746. Xif ('-' x 5 eq '-----') {print "ok 1\n";} else {print "not ok 1\n";}
  747. Xif ('-' x 1 eq '-') {print "ok 2\n";} else {print "not ok 2\n";}
  748. Xif ('-' x 0 eq '') {print "ok 3\n";} else {print "not ok 3\n";}
  749. X
  750. Xif ('ab' x 3 eq 'ababab') {print "ok 4\n";} else {print "not ok 4\n";}
  751. X
  752. X# run time
  753. X
  754. X$a = '-';
  755. Xif ($a x 5 eq '-----') {print "ok 5\n";} else {print "not ok 5\n";}
  756. Xif ($a x 1 eq '-') {print "ok 6\n";} else {print "not ok 6\n";}
  757. Xif ($a x 0 eq '') {print "ok 7\n";} else {print "not ok 7\n";}
  758. X
  759. X$a = 'ab';
  760. Xif ($a x 3 eq 'ababab') {print "ok 8\n";} else {print "not ok 8\n";}
  761. X
  762. X$a = 'xyz';
  763. X$a x= 2;
  764. Xif ($a eq 'xyzxyz') {print "ok 9\n";} else {print "not ok 9\n";}
  765. X$a x= 1;
  766. Xif ($a eq 'xyzxyz') {print "ok 10\n";} else {print "not ok 10\n";}
  767. X$a x= 0;
  768. Xif ($a eq '') {print "ok 11\n";} else {print "not ok 11\n";}
  769. X
  770. !STUFFY!FUNK!
  771. echo Extracting t/op.each
  772. sed >t/op.each <<'!STUFFY!FUNK!' -e 's/X//'
  773. X#!./perl
  774. X
  775. X# $Header: op.each,v 1.0 87/12/18 13:13:23 root Exp $
  776. X
  777. Xprint "1..2\n";
  778. X
  779. X$h{'abc'} = 'ABC';
  780. X$h{'def'} = 'DEF';
  781. X$h{'jkl'} = 'JKL';
  782. X$h{'xyz'} = 'XYZ';
  783. X$h{'a'} = 'A';
  784. X$h{'b'} = 'B';
  785. X$h{'c'} = 'C';
  786. X$h{'d'} = 'D';
  787. X$h{'e'} = 'E';
  788. X$h{'f'} = 'F';
  789. X$h{'g'} = 'G';
  790. X$h{'h'} = 'H';
  791. X$h{'i'} = 'I';
  792. X$h{'j'} = 'J';
  793. X$h{'k'} = 'K';
  794. X$h{'l'} = 'L';
  795. X$h{'m'} = 'M';
  796. X$h{'n'} = 'N';
  797. X$h{'o'} = 'O';
  798. X$h{'p'} = 'P';
  799. X$h{'q'} = 'Q';
  800. X$h{'r'} = 'R';
  801. X$h{'s'} = 'S';
  802. X$h{'t'} = 'T';
  803. X$h{'u'} = 'U';
  804. X$h{'v'} = 'V';
  805. X$h{'w'} = 'W';
  806. X$h{'x'} = 'X';
  807. X$h{'y'} = 'Y';
  808. X$h{'z'} = 'Z';
  809. X
  810. X@keys = keys(h);
  811. X@values = values(h);
  812. X
  813. Xif ($#keys == 29 && $#values == 29) {print "ok 1\n";} else {print "not ok 1\n";}
  814. X
  815. Xwhile (($key,$value) = each(h)) {
  816. X    if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
  817. X    $key =~ y/a-z/A-Z/;
  818. X    $i++ if $key eq $value;
  819. X    }
  820. X}
  821. X
  822. Xif ($i == 30) {print "ok 2\n";} else {print "not ok 2\n";}
  823. !STUFFY!FUNK!
  824. echo Extracting t/io.argv
  825. sed >t/io.argv <<'!STUFFY!FUNK!' -e 's/X//'
  826. X#!./perl
  827. X
  828. X# $Header: io.argv,v 1.0 87/12/18 13:12:44 root Exp $
  829. X
  830. Xprint "1..5\n";
  831. X
  832. Xopen(try, '>Io.argv.tmp') || (die "Can't open temp file.");
  833. Xprint try "a line\n";
  834. Xclose try;
  835. X
  836. X$x = `./perl -e 'while (<>) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`;
  837. X
  838. Xif ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";}
  839. X
  840. X$x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`;
  841. X
  842. Xif ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
  843. X
  844. X$x = `echo foo|./perl -e 'while (<>) {print $_;}'`;
  845. X
  846. Xif ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3\n";}
  847. X
  848. X@ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp');
  849. Xwhile (<>) {
  850. X    $y .= $. . $_;
  851. X    if (eof) {
  852. X    if ($. == 3) {print "ok 4\n";} else {print "not ok 4\n";}
  853. X    }
  854. X}
  855. X
  856. Xif ($y eq "1a line\n2a line\n3a line\n")
  857. X    {print "ok 5\n";}
  858. Xelse
  859. X    {print "not ok 5\n";}
  860. X
  861. X`/bin/rm -f Io.argv.tmp`;
  862. !STUFFY!FUNK!
  863. echo Extracting t/comp.term
  864. sed >t/comp.term <<'!STUFFY!FUNK!' -e 's/X//'
  865. X#!./perl
  866. X
  867. X# $Header: comp.term,v 1.0 87/12/18 13:12:40 root Exp $
  868. X
  869. X# tests that aren't important enough for base.term
  870. X
  871. Xprint "1..9\n";
  872. X
  873. X$x = "\\n";
  874. Xprint "#1\t:$x: eq " . ':\n:' . "\n";
  875. Xif ($x eq '\n') {print "ok 1\n";} else {print "not ok 1\n";}
  876. X
  877. X$x = "#2\t:$x: eq :\\n:\n";
  878. Xprint $x;
  879. Xunless (index($x,'\\\\')>0) {print "ok 2\n";} else {print "not ok 2\n";}
  880. X
  881. Xif (length('\\\\') == 2) {print "ok 3\n";} else {print "not ok 3\n";}
  882. X
  883. X$one = 'a';
  884. X
  885. Xif (length("\\n") == 2) {print "ok 4\n";} else {print "not ok 4\n";}
  886. Xif (length("\\\n") == 2) {print "ok 5\n";} else {print "not ok 5\n";}
  887. Xif (length("$one\\n") == 3) {print "ok 6\n";} else {print "not ok 6\n";}
  888. Xif (length("$one\\\n") == 3) {print "ok 7\n";} else {print "not ok 7\n";}
  889. Xif (length("\\n$one") == 3) {print "ok 8\n";} else {print "not ok 8\n";}
  890. Xif (length("\\\n$one") == 3) {print "ok 9\n";} else {print "not ok 9\n";}
  891. X
  892. !STUFFY!FUNK!
  893. echo Extracting x2p/str.h
  894. sed >x2p/str.h <<'!STUFFY!FUNK!' -e 's/X//'
  895. X/* $Header: str.h,v 1.0 87/12/18 13:07:30 root Exp $
  896. X *
  897. X * $Log:    str.h,v $
  898. X * Revision 1.0  87/12/18  13:07:30  root
  899. X * Initial revision
  900. X * 
  901. X */
  902. X
  903. Xstruct string {
  904. X    char *    str_ptr;    /* pointer to malloced string */
  905. X    double    str_nval;    /* numeric value, if any */
  906. X    int        str_len;    /* allocated size */
  907. X    int        str_cur;    /* length of str_ptr as a C string */
  908. X    union {
  909. X    STR *str_next;        /* while free, link to next free str */
  910. X    } str_link;
  911. X    char    str_pok;    /* state of str_ptr */
  912. X    char    str_nok;    /* state of str_nval */
  913. X};
  914. X
  915. X#define Nullstr Null(STR*)
  916. X
  917. X/* the following macro updates any magic values this str is associated with */
  918. X
  919. X#define STABSET(x) (x->str_link.str_magic && stabset(x->str_link.str_magic,x))
  920. X
  921. XEXT STR **tmps_list;
  922. XEXT long tmps_max INIT(-1);
  923. X
  924. Xchar *str_2ptr();
  925. Xdouble str_2num();
  926. XSTR *str_static();
  927. XSTR *str_make();
  928. XSTR *str_nmake();
  929. Xchar *str_gets();
  930. !STUFFY!FUNK!
  931. echo Extracting t/op.stat
  932. sed >t/op.stat <<'!STUFFY!FUNK!' -e 's/X//'
  933. X#!./perl
  934. X
  935. X# $Header: op.stat,v 1.0 87/12/18 13:14:27 root Exp $
  936. X
  937. Xprint "1..4\n";
  938. X
  939. Xopen(foo, ">Op.stat.tmp");
  940. X
  941. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  942. X    $blksize,$blocks) = stat(foo);
  943. Xif ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";}
  944. Xif ($mtime && $mtime == $ctime) {print "ok 2\n";} else {print "not ok 2\n";}
  945. X
  946. Xprint foo "Now is the time for all good men to come to.\n";
  947. Xclose(foo);
  948. X
  949. X$base = time;
  950. Xwhile (time == $base) {}
  951. X
  952. X`rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
  953. X
  954. X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
  955. X    $blksize,$blocks) = stat('Op.stat.tmp');
  956. X
  957. Xif ($nlink == 2) {print "ok 3\n";} else {print "not ok 3\n";}
  958. Xif ($mtime && $mtime != $ctime) {print "ok 4\n";} else {print "not ok 4\n";}
  959. Xprint "#4    :$mtime: != :$ctime:\n";
  960. X
  961. X`rm -f Op.stat.tmp Op.stat.tmp2`;
  962. !STUFFY!FUNK!
  963. echo Extracting spat.h
  964. sed >spat.h <<'!STUFFY!FUNK!' -e 's/X//'
  965. X/* $Header: spat.h,v 1.0 87/12/18 13:06:10 root Exp $
  966. X *
  967. X * $Log:    spat.h,v $
  968. X * Revision 1.0  87/12/18  13:06:10  root
  969. X * Initial revision
  970. X * 
  971. X */
  972. X
  973. Xstruct scanpat {
  974. X    SPAT    *spat_next;        /* list of all scanpats */
  975. X    COMPEX    spat_compex;        /* compiled expression */
  976. X    ARG        *spat_repl;        /* replacement string for subst */
  977. X    ARG        *spat_runtime;        /* compile pattern at runtime */
  978. X    STR        *spat_first;        /* for a fast bypass of execute() */
  979. X    bool    spat_flags;
  980. X    char    spat_flen;
  981. X};
  982. X
  983. X#define SPAT_USED 1            /* spat has been used once already */
  984. X#define SPAT_USE_ONCE 2            /* use pattern only once per article */
  985. X#define SPAT_SCANFIRST 4        /* initial constant not anchored */
  986. X#define SPAT_SCANALL 8            /* initial constant is whole pat */
  987. X
  988. XEXT SPAT *spat_root;        /* list of all spats */
  989. XEXT SPAT *curspat;        /* what to do \ interps from */
  990. X
  991. X#define Nullspat Null(SPAT*)
  992. !STUFFY!FUNK!
  993. echo Extracting t/op.do
  994. sed >t/op.do <<'!STUFFY!FUNK!' -e 's/X//'
  995. X#!./perl
  996. X
  997. X# $Header: op.do,v 1.0 87/12/18 13:13:20 root Exp $
  998. Xsub foo1
  999. X{
  1000. X    print $_[0];
  1001. X    'value';
  1002. X}
  1003. X
  1004. Xsub foo2
  1005. X{
  1006. X    shift(_);
  1007. X    print $_[0];
  1008. X    $x = 'value';
  1009. X    $x;
  1010. X}
  1011. X
  1012. Xprint "1..8\n";
  1013. X
  1014. X$_[0] = "not ok 1\n";
  1015. X$result = do foo1("ok 1\n");
  1016. Xprint "#2\t:$result: eq :value:\n";
  1017. Xif ($result EQ 'value') { print "ok 2\n"; } else { print "not ok 2\n"; }
  1018. Xif ($_[0] EQ "not ok 1\n") { print "ok 3\n"; } else { print "not ok 3\n"; }
  1019. X
  1020. X$_[0] = "not ok 4\n";
  1021. X$result = do foo2("not ok 4\n","ok 4\n","not ok 4\n");
  1022. Xprint "#5\t:$result: eq :value:\n";
  1023. Xif ($result EQ 'value') { print "ok 5\n"; } else { print "not ok 5\n"; }
  1024. Xif ($_[0] EQ "not ok 4\n") { print "ok 6\n"; } else { print "not ok 6\n"; }
  1025. X
  1026. X$result = do{print "ok 7\n"; 'value';};
  1027. Xprint "#8\t:$result: eq :value:\n";
  1028. Xif ($result EQ 'value') { print "ok 8\n"; } else { print "not ok 8\n"; }
  1029. !STUFFY!FUNK!
  1030. echo Extracting t/base.term
  1031. sed >t/base.term <<'!STUFFY!FUNK!' -e 's/X//'
  1032. X#!./perl
  1033. X
  1034. X# $Header: base.term,v 1.0 87/12/18 13:11:59 root Exp $
  1035. X
  1036. Xprint "1..6\n";
  1037. X
  1038. X# check "" interpretation
  1039. X
  1040. X$x = "\n";
  1041. Xif ($x lt ' ') {print "ok 1\n";} else {print "not ok 1\n";}
  1042. X
  1043. X# check `` processing
  1044. X
  1045. X$x = `echo hi there`;
  1046. Xif ($x eq "hi there\n") {print "ok 2\n";} else {print "not ok 2\n";}
  1047. X
  1048. X# check $#array
  1049. X
  1050. X$x[0] = 'foo';
  1051. X$x[1] = 'foo';
  1052. X$tmp = $#x;
  1053. Xprint "#3\t:$tmp: == :1:\n";
  1054. Xif ($#x == '1') {print "ok 3\n";} else {print "not ok 3\n";}
  1055. X
  1056. X# check numeric literal
  1057. X
  1058. X$x = 1;
  1059. Xif ($x == '1') {print "ok 4\n";} else {print "not ok 4\n";}
  1060. X
  1061. X# check <> pseudoliteral
  1062. X
  1063. Xopen(try, "/dev/null") || (die "Can't open /dev/null.");
  1064. Xif (<try> eq '') {print "ok 5\n";} else {print "not ok 5\n";}
  1065. X
  1066. Xopen(try, "/etc/termcap") || (die "Can't open /etc/termcap.");
  1067. Xif (<try> ne '') {print "ok 6\n";} else {print "not ok 6\n";}
  1068. !STUFFY!FUNK!
  1069. echo Extracting t/comp.multiline
  1070. sed >t/comp.multiline <<'!STUFFY!FUNK!' -e 's/X//'
  1071. X#!./perl
  1072. X
  1073. X# $Header: comp.multiline,v 1.0 87/12/18 13:12:31 root Exp $
  1074. X
  1075. Xprint "1..5\n";
  1076. X
  1077. Xopen(try,'>Comp.try') || (die "Can't open temp file.");
  1078. X
  1079. X$x = 'now is the time
  1080. Xfor all good men
  1081. Xto come to.
  1082. X';
  1083. X
  1084. X$y = 'now is the time' . "\n" .
  1085. X'for all good men' . "\n" .
  1086. X'to come to.' . "\n";
  1087. X
  1088. Xif ($x eq $y) {print "ok 1\n";} else {print "not ok 1\n";}
  1089. X
  1090. Xprint try $x;
  1091. Xclose try;
  1092. X
  1093. Xopen(try,'Comp.try') || (die "Can't reopen temp file.");
  1094. X$count = 0;
  1095. X$z = '';
  1096. Xwhile (<try>) {
  1097. X    $z .= $_;
  1098. X    $count = $count + 1;
  1099. X}
  1100. X
  1101. Xif ($z eq $y) {print "ok 2\n";} else {print "not ok 2\n";}
  1102. X
  1103. Xif ($count == 3) {print "ok 3\n";} else {print "not ok 3\n";}
  1104. X
  1105. X$_ = `cat Comp.try`;
  1106. X
  1107. Xif (/.*\n.*\n.*\n$/) {print "ok 4\n";} else {print "not ok 4\n";}
  1108. X`/bin/rm -f Comp.try`;
  1109. X
  1110. Xif ($_ eq $y) {print "ok 5\n";} else {print "not ok 5\n";}
  1111. !STUFFY!FUNK!
  1112. echo Extracting t/comp.cpp
  1113. sed >t/comp.cpp <<'!STUFFY!FUNK!' -e 's/X//'
  1114. X#!./perl -P
  1115. X
  1116. X# $Header: comp.cpp,v 1.0 87/12/18 13:12:22 root Exp $
  1117. X
  1118. Xprint "1..3\n";
  1119. X
  1120. X#this is a comment
  1121. X#define MESS "ok 1\n"
  1122. Xprint MESS;
  1123. X
  1124. X#If you capitalize, it's a comment.
  1125. X#ifdef MESS
  1126. X    print "ok 2\n";
  1127. X#else
  1128. X    print "not ok 2\n";
  1129. X#endif
  1130. X
  1131. Xopen(try,">Comp.cpp.tmp") || die "Can't open temp perl file.";
  1132. Xprint try '$ok = "not ok 3\n";'; print try "\n";
  1133. Xprint try "#include <Comp.cpp.inc>\n";
  1134. Xprint try "#ifdef OK\n";
  1135. Xprint try '$ok = OK;'; print try "\n";
  1136. Xprint try "#endif\n";
  1137. Xprint try 'print $ok;'; print try "\n";
  1138. Xclose try;
  1139. X
  1140. Xopen(try,">Comp.cpp.inc") || (die "Can't open temp include file.");
  1141. Xprint try '#define OK "ok 3\n"'; print try "\n";
  1142. Xclose try;
  1143. X
  1144. X$pwd=`pwd`;
  1145. X$pwd =~ s/\n//;
  1146. X$x = `./perl -P -I$pwd Comp.cpp.tmp`;
  1147. Xprint $x;
  1148. X`/bin/rm -f Comp.cpp.tmp Comp.cpp.inc`;
  1149. !STUFFY!FUNK!
  1150. echo Extracting t/op.exp
  1151. sed >t/op.exp <<'!STUFFY!FUNK!' -e 's/X//'
  1152. X#!./perl
  1153. X
  1154. X# $Header: op.exp,v 1.0 87/12/18 13:13:29 root Exp $
  1155. X
  1156. Xprint "1..6\n";
  1157. X
  1158. X# compile time evaluation
  1159. X
  1160. X$s = sqrt(2);
  1161. Xif (substr($s,0,5) eq '1.414') {print "ok 1\n";} else {print "not ok 1\n";}
  1162. X
  1163. X$s = exp(1);
  1164. Xif (substr($s,0,7) eq '2.71828') {print "ok 2\n";} else {print "not ok 2\n";}
  1165. X
  1166. Xif (exp(log(1)) == 1) {print "ok 3\n";} else {print "not ok 3\n";}
  1167. X
  1168. X# run time evaluation
  1169. X
  1170. X$x1 = 1;
  1171. X$x2 = 2;
  1172. X$s = sqrt($x2);
  1173. Xif (substr($s,0,5) eq '1.414') {print "ok 4\n";} else {print "not ok 4\n";}
  1174. X
  1175. X$s = exp($x1);
  1176. Xif (substr($s,0,7) eq '2.71828') {print "ok 5\n";} else {print "not ok 5\n";}
  1177. X
  1178. Xif (exp(log($x1)) == 1) {print "ok 6\n";} else {print "not ok 6\n";}
  1179. !STUFFY!FUNK!
  1180. echo Extracting handy.h
  1181. sed >handy.h <<'!STUFFY!FUNK!' -e 's/X//'
  1182. X/* $Header: handy.h,v 1.0 87/12/18 13:05:14 root Exp $
  1183. X *
  1184. X * $Log:    handy.h,v $
  1185. X * Revision 1.0  87/12/18  13:05:14  root
  1186. X * Initial revision
  1187. X * 
  1188. X */
  1189. X
  1190. X#define Null(type) ((type)0)
  1191. X#define Nullch Null(char*)
  1192. X#define Nullfp Null(FILE*)
  1193. X
  1194. X#define bool char
  1195. X#define TRUE (1)
  1196. X#define FALSE (0)
  1197. X
  1198. X#define Ctl(ch) (ch & 037)
  1199. X
  1200. X#define strNE(s1,s2) (strcmp(s1,s2))
  1201. X#define strEQ(s1,s2) (!strcmp(s1,s2))
  1202. X#define strLT(s1,s2) (strcmp(s1,s2) < 0)
  1203. X#define strLE(s1,s2) (strcmp(s1,s2) <= 0)
  1204. X#define strGT(s1,s2) (strcmp(s1,s2) > 0)
  1205. X#define strGE(s1,s2) (strcmp(s1,s2) >= 0)
  1206. X#define strnNE(s1,s2,l) (strncmp(s1,s2,l))
  1207. X#define strnEQ(s1,s2,l) (!strncmp(s1,s2,l))
  1208. !STUFFY!FUNK!
  1209. echo Extracting x2p/handy.h
  1210. sed >x2p/handy.h <<'!STUFFY!FUNK!' -e 's/X//'
  1211. X/* $Header: handy.h,v 1.0 87/12/18 13:07:15 root Exp $
  1212. X *
  1213. X * $Log:    handy.h,v $
  1214. X * Revision 1.0  87/12/18  13:07:15  root
  1215. X * Initial revision
  1216. X * 
  1217. X */
  1218. X
  1219. X#define Null(type) ((type)0)
  1220. X#define Nullch Null(char*)
  1221. X#define Nullfp Null(FILE*)
  1222. X
  1223. X#define bool char
  1224. X#define TRUE (1)
  1225. X#define FALSE (0)
  1226. X
  1227. X#define Ctl(ch) (ch & 037)
  1228. X
  1229. X#define strNE(s1,s2) (strcmp(s1,s2))
  1230. X#define strEQ(s1,s2) (!strcmp(s1,s2))
  1231. X#define strLT(s1,s2) (strcmp(s1,s2) < 0)
  1232. X#define strLE(s1,s2) (strcmp(s1,s2) <= 0)
  1233. X#define strGT(s1,s2) (strcmp(s1,s2) > 0)
  1234. X#define strGE(s1,s2) (strcmp(s1,s2) >= 0)
  1235. X#define strnNE(s1,s2,l) (strncmp(s1,s2,l))
  1236. X#define strnEQ(s1,s2,l) (!strncmp(s1,s2,l))
  1237. !STUFFY!FUNK!
  1238. echo Extracting x2p/util.h
  1239. sed >x2p/util.h <<'!STUFFY!FUNK!' -e 's/X//'
  1240. X/* $Header: util.h,v 1.0 87/12/18 13:07:37 root Exp $
  1241. X *
  1242. X * $Log:    util.h,v $
  1243. X * Revision 1.0  87/12/18  13:07:37  root
  1244. X * Initial revision
  1245. X * 
  1246. X */
  1247. X
  1248. X/* is the string for makedir a directory name or a filename? */
  1249. X
  1250. X#define MD_DIR 0
  1251. X#define MD_FILE 1
  1252. X
  1253. Xvoid    util_init();
  1254. Xint    doshell();
  1255. Xchar    *safemalloc();
  1256. Xchar    *saferealloc();
  1257. Xchar    *safecpy();
  1258. Xchar    *safecat();
  1259. Xchar    *cpytill();
  1260. Xchar    *cpy2();
  1261. Xchar    *instr();
  1262. X#ifdef SETUIDGID
  1263. X    int        eaccess();
  1264. X#endif
  1265. Xchar    *getwd();
  1266. Xvoid    cat();
  1267. Xvoid    prexit();
  1268. Xchar    *get_a_line();
  1269. Xchar    *savestr();
  1270. Xint    makedir();
  1271. Xvoid    setenv();
  1272. Xint    envix();
  1273. Xvoid    notincl();
  1274. Xchar    *getval();
  1275. Xvoid    growstr();
  1276. Xvoid    setdef();
  1277. !STUFFY!FUNK!
  1278. echo Extracting util.h
  1279. sed >util.h <<'!STUFFY!FUNK!' -e 's/X//'
  1280. X/* $Header: util.h,v 1.0 87/12/18 13:06:33 root Exp $
  1281. X *
  1282. X * $Log:    util.h,v $
  1283. X * Revision 1.0  87/12/18  13:06:33  root
  1284. X * Initial revision
  1285. X * 
  1286. X */
  1287. X
  1288. X/* is the string for makedir a directory name or a filename? */
  1289. X
  1290. X#define MD_DIR 0
  1291. X#define MD_FILE 1
  1292. X
  1293. Xvoid    util_init();
  1294. Xint    doshell();
  1295. Xchar    *safemalloc();
  1296. Xchar    *saferealloc();
  1297. Xchar    *safecpy();
  1298. Xchar    *safecat();
  1299. Xchar    *cpytill();
  1300. Xchar    *instr();
  1301. X#ifdef SETUIDGID
  1302. X    int        eaccess();
  1303. X#endif
  1304. Xchar    *getwd();
  1305. Xvoid    cat();
  1306. Xvoid    prexit();
  1307. Xchar    *get_a_line();
  1308. Xchar    *savestr();
  1309. Xint    makedir();
  1310. Xvoid    setenv();
  1311. Xint    envix();
  1312. Xvoid    notincl();
  1313. Xchar    *getval();
  1314. Xvoid    growstr();
  1315. Xvoid    setdef();
  1316. !STUFFY!FUNK!
  1317. echo Extracting t/op.goto
  1318. sed >t/op.goto <<'!STUFFY!FUNK!' -e 's/X//'
  1319. X#!./perl
  1320. X
  1321. X# $Header: op.goto,v 1.0 87/12/18 13:13:40 root Exp $
  1322. X
  1323. Xprint "1..3\n";
  1324. X
  1325. Xwhile (0) {
  1326. X    $foo = 1;
  1327. X  label1:
  1328. X    $foo = 2;
  1329. X    goto label2;
  1330. X} continue {
  1331. X    $foo = 0;
  1332. X    goto label4;
  1333. X  label3:
  1334. X    $foo = 4;
  1335. X    goto label4;
  1336. X}
  1337. Xgoto label1;
  1338. X
  1339. X$foo = 3;
  1340. X
  1341. Xlabel2:
  1342. Xprint "#1\t:$foo: == 2\n";
  1343. Xif ($foo == 2) {print "ok 1\n";} else {print "not ok 1\n";}
  1344. Xgoto label3;
  1345. X
  1346. Xlabel4:
  1347. Xprint "#2\t:$foo: == 4\n";
  1348. Xif ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
  1349. X
  1350. X$x = `./perl -e 'goto foo;' 2>&1`;
  1351. Xprint "#3\t/label/ in :$x";
  1352. Xif ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
  1353. !STUFFY!FUNK!
  1354. echo Extracting t/op.flip
  1355. sed >t/op.flip <<'!STUFFY!FUNK!' -e 's/X//'
  1356. X#!./perl
  1357. X
  1358. X# $Header: op.flip,v 1.0 87/12/18 13:13:34 root Exp $
  1359. X
  1360. Xprint "1..8\n";
  1361. X
  1362. X@a = (1,2,3,4,5,6,7,8,9,10,11,12);
  1363. X
  1364. Xwhile ($_ = shift(a)) {
  1365. X    if ($x = /4/../8/) { $z = $x; print "ok ", $x + 0, "\n"; }
  1366. X    $y .= /1/../2/;
  1367. X}
  1368. X
  1369. Xif ($z eq '5E0') {print "ok 6\n";} else {print "not ok 6\n";}
  1370. X
  1371. Xif ($y eq '12E0123E0') {print "ok 7\n";} else {print "not ok 7\n";}
  1372. X
  1373. X@a = ('a','b','c','d','e','f','g');
  1374. X
  1375. Xopen(of,'/etc/termcap');
  1376. Xwhile (<of>) {
  1377. X    (3 .. 5) && $foo .= $_;
  1378. X}
  1379. X$x = ($foo =~ y/\n/\n/);
  1380. X
  1381. Xif ($x eq 3) {print "ok 8\n";} else {print "not ok 8 $x:$foo:\n";}
  1382. !STUFFY!FUNK!
  1383. echo Extracting t/op.split
  1384. sed >t/op.split <<'!STUFFY!FUNK!' -e 's/X//'
  1385. X#!./perl
  1386. X
  1387. X# $Header: op.split,v 1.0 87/12/18 13:14:20 root Exp $
  1388. X
  1389. Xprint "1..4\n";
  1390. X
  1391. X$FS = ':';
  1392. X
  1393. X$_ = 'a:b:c';
  1394. X
  1395. X($a,$b,$c) = split($FS,$_);
  1396. X
  1397. Xif (join(';',$a,$b,$c) eq 'a;b;c') {print "ok 1\n";} else {print "not ok 1\n";}
  1398. X
  1399. X@ary = split(/:b:/);
  1400. Xif (join("$_",@ary) eq 'aa:b:cc') {print "ok 2\n";} else {print "not ok 2\n";}
  1401. X
  1402. X$_ = "abc\n";
  1403. X@ary = split(//);
  1404. Xif (join(".",@ary) eq "a.b.c.\n") {print "ok 3\n";} else {print "not ok 3\n";}
  1405. X
  1406. X$_ = "a:b:c::::";
  1407. X@ary = split(/:/);
  1408. Xif (join(".",@ary) eq "a.b.c") {print "ok 4\n";} else {print "not ok 4\n";}
  1409. !STUFFY!FUNK!
  1410. echo Extracting t/cmd.mod
  1411. sed >t/cmd.mod <<'!STUFFY!FUNK!' -e 's/X//'
  1412. X#!./perl
  1413. X
  1414. X# $Header: cmd.mod,v 1.0 87/12/18 13:12:09 root Exp $
  1415. X
  1416. Xprint "1..6\n";
  1417. X
  1418. Xprint "ok 1\n" if 1;
  1419. Xprint "not ok 1\n" unless 1;
  1420. X
  1421. Xprint "ok 2\n" unless 0;
  1422. Xprint "not ok 2\n" if 0;
  1423. X
  1424. X1 && (print "not ok 3\n") if 0;
  1425. X1 && (print "ok 3\n") if 1;
  1426. X0 || (print "not ok 4\n") if 0;
  1427. X0 || (print "ok 4\n") if 1;
  1428. X
  1429. X$x = 0;
  1430. Xdo {$x[$x] = $x;} while ($x++) < 10;
  1431. Xif (join(' ',@x) eq '0 1 2 3 4 5 6 7 8 9 10') {
  1432. X    print "ok 5\n";
  1433. X} else {
  1434. X    print "not ok 5\n";
  1435. X}
  1436. X
  1437. X$x = 15;
  1438. X$x = 10 while $x < 10;
  1439. Xif ($x == 15) {print "ok 6\n";} else {print "not ok 6\n";}
  1440. !STUFFY!FUNK!
  1441. echo Extracting t/README
  1442. sed >t/README <<'!STUFFY!FUNK!' -e 's/X//'
  1443. XThis is the perl test library.  To run all the tests, just type 'TEST'.
  1444. X
  1445. XTo add new tests, just look at the current tests and do likewise.
  1446. X
  1447. XIf a test fails, run it by itself to see if it prints any informative
  1448. Xdiagnostics.  If not, modify the test to print informative diagnostics.
  1449. XIf you put out extra lines with a '#' character on the front, you don't
  1450. Xhave to worry about removing the extra print statements later since TEST
  1451. Xignores lines beginning with '#'.
  1452. X
  1453. XIf you come up with new tests, send them to lwall@jpl-devvax.jpl.nasa.gov.
  1454. !STUFFY!FUNK!
  1455. echo Extracting t/op.magic
  1456. sed >t/op.magic <<'!STUFFY!FUNK!' -e 's/X//'
  1457. X#!./perl
  1458. X
  1459. X# $Header: op.magic,v 1.0 87/12/18 13:13:54 root Exp $
  1460. X
  1461. Xprint "1..4\n";
  1462. X
  1463. X$| = 1;        # command buffering
  1464. X
  1465. X$ENV{'foo'} = 'hi there';
  1466. Xif (`echo \$foo` eq "hi there\n") {print "ok 1\n";} else {print "not ok 1\n";}
  1467. X
  1468. X$! = 0;
  1469. Xopen(foo,'ajslkdfpqjsjfkslkjdflksd');
  1470. Xif ($! == 2) {print "ok 2\n";} else {print "not ok 2\n";}
  1471. X
  1472. X$SIG{'INT'} = 'ok3';
  1473. Xkill 2,$$;
  1474. X$SIG{'INT'} = 'IGNORE';
  1475. Xkill 2,$$;
  1476. Xprint "ok 4\n";
  1477. X$SIG{'INT'} = 'DEFAULT';
  1478. Xkill 2,$$;
  1479. Xprint "not ok\n";
  1480. X
  1481. Xsub ok3 {
  1482. X    print "ok 3\n" if pop(@_) eq 'INT';
  1483. X}
  1484. !STUFFY!FUNK!
  1485. echo Extracting t/comp.script
  1486. sed >t/comp.script <<'!STUFFY!FUNK!' -e 's/X//'
  1487. X#!./perl
  1488. X
  1489. X# $Header: comp.script,v 1.0 87/12/18 13:12:36 root Exp $
  1490. X
  1491. Xprint "1..3\n";
  1492. X
  1493. X$x = `./perl -e 'print "ok\n";'`;
  1494. X
  1495. Xif ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
  1496. X
  1497. Xopen(try,">Comp.script") || (die "Can't open temp file.");
  1498. Xprint try 'print "ok\n";'; print try "\n";
  1499. Xclose try;
  1500. X
  1501. X$x = `./perl Comp.script`;
  1502. X
  1503. Xif ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
  1504. X
  1505. X$x = `./perl <Comp.script`;
  1506. X
  1507. Xif ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
  1508. X
  1509. X`/bin/rm -f Comp.script`;
  1510. !STUFFY!FUNK!
  1511. echo Extracting t/cmd.elsif
  1512. sed >t/cmd.elsif <<'!STUFFY!FUNK!' -e 's/X//'
  1513. X#!./perl
  1514. X
  1515. X# $Header: cmd.elsif,v 1.0 87/12/18 13:12:02 root Exp $
  1516. X
  1517. Xsub foo {
  1518. X    if ($_[0] == 1) {
  1519. X    1;
  1520. X    }
  1521. X    elsif ($_[0] == 2) {
  1522. X    2;
  1523. X    }
  1524. X    elsif ($_[0] == 3) {
  1525. X    3;
  1526. X    }
  1527. X    else {
  1528. X    4;
  1529. X    }
  1530. X}
  1531. X
  1532. Xprint "1..4\n";
  1533. X
  1534. Xif (($x = do foo(1)) == 1) {print "ok 1\n";} else {print "not ok 1\n";}
  1535. Xif (($x = do foo(2)) == 2) {print "ok 2\n";} else {print "not ok 2\n";}
  1536. Xif (($x = do foo(3)) == 3) {print "ok 3\n";} else {print "not ok 3\n";}
  1537. Xif (($x = do foo(4)) == 4) {print "ok 4\n";} else {print "not ok 4\n";}
  1538. !STUFFY!FUNK!
  1539. echo Extracting t/comp.decl
  1540. sed >t/comp.decl <<'!STUFFY!FUNK!' -e 's/X//'
  1541. X#!./perl
  1542. X
  1543. X# $Header: comp.decl,v 1.0 87/12/18 13:12:27 root Exp $
  1544. X
  1545. X# check to see if subroutine declarations work everwhere
  1546. X
  1547. Xsub one {
  1548. X    print "ok 1\n";
  1549. X}
  1550. Xformat one =
  1551. Xok 5
  1552. X.
  1553. X
  1554. Xprint "1..7\n";
  1555. X
  1556. Xdo one();
  1557. Xdo two();
  1558. X
  1559. Xsub two {
  1560. X    print "ok 2\n";
  1561. X}
  1562. Xformat two =
  1563. X@<<<
  1564. X$foo
  1565. X.
  1566. X
  1567. Xif ($x eq $x) {
  1568. X    sub three {
  1569. X    print "ok 3\n";
  1570. X    }
  1571. X    do three();
  1572. X}
  1573. X
  1574. Xdo four();
  1575. X$~ = 'one';
  1576. Xwrite;
  1577. X$~ = 'two';
  1578. X$foo = "ok 6";
  1579. Xwrite;
  1580. X$~ = 'three';
  1581. Xwrite;
  1582. X
  1583. Xformat three =
  1584. Xok 7
  1585. X.
  1586. X
  1587. Xsub four {
  1588. X    print "ok 4\n";
  1589. X}
  1590. !STUFFY!FUNK!
  1591. echo Extracting form.h
  1592. sed >form.h <<'!STUFFY!FUNK!' -e 's/X//'
  1593. X/* $Header: form.h,v 1.0 87/12/18 13:05:10 root Exp $
  1594. X *
  1595. X * $Log:    form.h,v $
  1596. X * Revision 1.0  87/12/18  13:05:10  root
  1597. X * Initial revision
  1598. X * 
  1599. X */
  1600. X
  1601. X#define F_NULL 0
  1602. X#define F_LEFT 1
  1603. X#define F_RIGHT 2
  1604. X#define F_CENTER 3
  1605. X#define F_LINES 4
  1606. X
  1607. Xstruct formcmd {
  1608. X    struct formcmd *f_next;
  1609. X    ARG *f_expr;
  1610. X    char *f_pre;
  1611. X    short f_presize;
  1612. X    short f_size;
  1613. X    char f_type;
  1614. X    char f_flags;
  1615. X};
  1616. X
  1617. X#define FC_CHOP 1
  1618. X#define FC_NOBLANK 2
  1619. X#define FC_MORE 4
  1620. X
  1621. X#define Nullfcmd Null(FCMD*)
  1622. !STUFFY!FUNK!
  1623. echo Extracting t/op.append
  1624. sed >t/op.append <<'!STUFFY!FUNK!' -e 's/X//'
  1625. X#!./perl
  1626. X
  1627. X# $Header: op.append,v 1.0 87/12/18 13:13:05 root Exp $
  1628. X
  1629. Xprint "1..3\n";
  1630. X
  1631. X$a = 'ab' . 'c';    # compile time
  1632. X$b = 'def';
  1633. X
  1634. X$c = $a . $b;
  1635. Xprint "#1\t:$c: eq :abcdef:\n";
  1636. Xif ($c eq 'abcdef') {print "ok 1\n";} else {print "not ok 1\n";}
  1637. X
  1638. X$c .= 'xyz';
  1639. Xprint "#2\t:$c: eq :abcdefxyz:\n";
  1640. Xif ($c eq 'abcdefxyz') {print "ok 2\n";} else {print "not ok 2\n";}
  1641. X
  1642. X$_ = $a;
  1643. X$_ .= $b;
  1644. Xprint "#3\t:$_: eq :abcdef:\n";
  1645. Xif ($_ eq 'abcdef') {print "ok 3\n";} else {print "not ok 3\n";}
  1646. !STUFFY!FUNK!
  1647. echo Extracting t/base.lex
  1648. sed >t/base.lex <<'!STUFFY!FUNK!' -e 's/X//'
  1649. X#!./perl
  1650. X
  1651. X# $Header: base.lex,v 1.0 87/12/18 13:11:51 root Exp $
  1652. X
  1653. Xprint "1..4\n";
  1654. X
  1655. X$ # this is the register <space>
  1656. X= 'x';
  1657. X
  1658. Xprint "#1    :$ : eq :x:\n";
  1659. Xif ($  eq 'x') {print "ok 1\n";} else {print "not ok 1\n";}
  1660. X
  1661. X$x = $#;    # this is the register $#
  1662. X
  1663. Xif ($x eq '') {print "ok 2\n";} else {print "not ok 2\n";}
  1664. X
  1665. X$x = $#x;
  1666. X
  1667. Xif ($x eq '-1') {print "ok 3\n";} else {print "not ok 3\n";}
  1668. X
  1669. X$x = '\\'; # ';
  1670. X
  1671. Xif (length($x) == 1) {print "ok 4\n";} else {print "not ok 4\n";}
  1672. !STUFFY!FUNK!
  1673. echo Extracting t/cmd.for
  1674. sed >t/cmd.for <<'!STUFFY!FUNK!' -e 's/X//'
  1675. X#!./perl
  1676. X
  1677. X# $Header: cmd.for,v 1.0 87/12/18 13:12:05 root Exp $
  1678. X
  1679. Xprint "1..2\n";
  1680. X
  1681. Xfor ($i = 0; $i <= 10; $i++) {
  1682. X    $x[$i] = $i;
  1683. X}
  1684. X$y = $x[10];
  1685. Xprint "#1    :$y: eq :10:\n";
  1686. X$y = join(' ', @x);
  1687. Xprint "#1    :$y: eq :0 1 2 3 4 5 6 7 8 9 10:\n";
  1688. Xif (join(' ', @x) eq '0 1 2 3 4 5 6 7 8 9 10') {
  1689. X    print "ok 1\n";
  1690. X} else {
  1691. X    print "not ok 1\n";
  1692. X}
  1693. X
  1694. X$i = $c = 0;
  1695. Xfor (;;) {
  1696. X    $c++;
  1697. X    last if $i++ > 10;
  1698. X}
  1699. Xif ($c == 12) {print "ok 2\n";} else {print "not ok 2\n";}
  1700. !STUFFY!FUNK!
  1701. echo Extracting t/io.inplace
  1702. sed >t/io.inplace <<'!STUFFY!FUNK!' -e 's/X//'
  1703. X#!./perl -i.bak
  1704. X
  1705. X# $Header: io.inplace,v 1.0 87/12/18 13:12:51 root Exp $
  1706. X
  1707. Xprint "1..2\n";
  1708. X
  1709. X@ARGV = ('.a','.b','.c');
  1710. X`echo foo | tee .a .b .c`;
  1711. Xwhile (<>) {
  1712. X    s/foo/bar/;
  1713. X}
  1714. Xcontinue {
  1715. X    print;
  1716. X}
  1717. X
  1718. Xif (`cat .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";}
  1719. Xif (`cat .a.bak .b.bak .c.bak` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";}
  1720. X
  1721. Xunlink '.a', '.b', '.c', '.a.bak', '.b.bak', '.c.bak';
  1722. !STUFFY!FUNK!
  1723. echo Extracting t/op.int
  1724. sed >t/op.int <<'!STUFFY!FUNK!' -e 's/X//'
  1725. X#!./perl
  1726. X
  1727. X# $Header: op.int,v 1.0 87/12/18 13:13:43 root Exp $
  1728. X
  1729. Xprint "1..4\n";
  1730. X
  1731. X# compile time evaluation
  1732. X
  1733. Xif (int(1.234) == 1) {print "ok 1\n";} else {print "not ok 1\n";}
  1734. X
  1735. Xif (int(-1.234) == -1) {print "ok 2\n";} else {print "not ok 2\n";}
  1736. X
  1737. X# run time evaluation
  1738. X
  1739. X$x = 1.234;
  1740. Xif (int($x) == 1) {print "ok 3\n";} else {print "not ok 3\n";}
  1741. Xif (int(-$x) == -1) {print "ok 4\n";} else {print "not ok 4\n";}
  1742. !STUFFY!FUNK!
  1743. echo Extracting t/base.cond
  1744. sed >t/base.cond <<'!STUFFY!FUNK!' -e 's/X//'
  1745. X#!./perl
  1746. X
  1747. X# $Header: base.cond,v 1.0 87/12/18 13:11:41 root Exp $
  1748. X
  1749. X# make sure conditional operators work
  1750. X
  1751. Xprint "1..4\n";
  1752. X
  1753. X$x = '0';
  1754. X
  1755. X$x eq $x && (print "ok 1\n");
  1756. X$x ne $x && (print "not ok 1\n");
  1757. X$x eq $x || (print "not ok 2\n");
  1758. X$x ne $x || (print "ok 2\n");
  1759. X
  1760. X$x == $x && (print "ok 3\n");
  1761. X$x != $x && (print "not ok 3\n");
  1762. X$x == $x || (print "not ok 4\n");
  1763. X$x != $x || (print "ok 4\n");
  1764. !STUFFY!FUNK!
  1765. echo Extracting t/io.print
  1766. sed >t/io.print <<'!STUFFY!FUNK!' -e 's/X//'
  1767. X#!./perl
  1768. X
  1769. X# $Header: io.print,v 1.0 87/12/18 13:12:55 root Exp $
  1770. X
  1771. Xprint "1..11\n";
  1772. X
  1773. Xprint stdout "ok 1\n";
  1774. Xprint "ok 2\n","ok 3\n","ok 4\n","ok 5\n";
  1775. X
  1776. Xopen(foo,">-");
  1777. Xprint foo "ok 6\n";
  1778. X
  1779. Xprintf "ok %d\n",7;
  1780. Xprintf("ok %d\n",8);
  1781. X
  1782. X@a = ("ok %d%c",9,ord("\n"));
  1783. Xprintf @a;
  1784. X
  1785. X$a[1] = 10;
  1786. Xprintf stdout @a;
  1787. X
  1788. X$, = ' ';
  1789. X$\ = "\n";
  1790. X
  1791. Xprint "ok","11";
  1792. !STUFFY!FUNK!
  1793. echo Extracting array.h
  1794. sed >array.h <<'!STUFFY!FUNK!' -e 's/X//'
  1795. X/* $Header: array.h,v 1.0 87/12/18 13:04:46 root Exp $
  1796. X *
  1797. X * $Log:    array.h,v $
  1798. X * Revision 1.0  87/12/18  13:04:46  root
  1799. X * Initial revision
  1800. X * 
  1801. X */
  1802. X
  1803. Xstruct atbl {
  1804. X    STR    **ary_array;
  1805. X    int    ary_max;
  1806. X    int    ary_fill;
  1807. X};
  1808. X
  1809. XSTR *afetch();
  1810. Xbool astore();
  1811. Xbool adelete();
  1812. XSTR *apop();
  1813. XSTR *ashift();
  1814. Xbool apush();
  1815. Xlong alen();
  1816. XARRAY *anew();
  1817. !STUFFY!FUNK!
  1818. echo Extracting t/op.join
  1819. sed >t/op.join <<'!STUFFY!FUNK!' -e 's/X//'
  1820. X#!./perl
  1821. X
  1822. X# $Header: op.join,v 1.0 87/12/18 13:13:46 root Exp $
  1823. X
  1824. Xprint "1..3\n";
  1825. X
  1826. X@x = (1, 2, 3);
  1827. Xif (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
  1828. X
  1829. Xif (join('',1,2,3) eq '123') {print "ok 2\n";} else {print "not ok 2\n";}
  1830. X
  1831. Xif (join(':',split(/ /,"1 2 3")) eq '1:2:3') {print "ok 3\n";} else {print "not ok 3\n";}
  1832. !STUFFY!FUNK!
  1833. echo Extracting t/op.crypt
  1834. sed >t/op.crypt <<'!STUFFY!FUNK!' -e 's/X//'
  1835. X#!./perl
  1836. X
  1837. X# $Header: op.crypt,v 1.0 87/12/18 13:13:17 root Exp $
  1838. X
  1839. Xprint "1..2\n";
  1840. X
  1841. X# this evaluates entirely at compile time!
  1842. Xif (crypt('uh','oh') eq 'ohPnjpYtoi1NU') {print "ok 1\n";} else {print "not ok 1\n";}
  1843. X
  1844. X# this doesn't.
  1845. X$uh = 'uh';
  1846. Xif (crypt($uh,'oh') eq 'ohPnjpYtoi1NU') {print "ok 2\n";} else {print "not ok 2\n";}
  1847. !STUFFY!FUNK!
  1848. echo Extracting t/op.chop
  1849. sed >t/op.chop <<'!STUFFY!FUNK!' -e 's/X//'
  1850. X#!./perl
  1851. X
  1852. X# $Header: op.chop,v 1.0 87/12/18 13:13:11 root Exp $
  1853. X
  1854. Xprint "1..2\n";
  1855. X
  1856. X# optimized
  1857. X
  1858. X$_ = 'abc';
  1859. X$c = do foo();
  1860. Xif ($c . $_ eq 'cab') {print "ok 1\n";} else {print "not ok 1\n";}
  1861. X
  1862. X# unoptimized
  1863. X
  1864. X$_ = 'abc';
  1865. X$c = chop($_);
  1866. Xif ($c . $_ eq 'cab') {print "ok 2\n";} else {print "not ok 2\n";}
  1867. X
  1868. Xsub foo {
  1869. X    chop;
  1870. X}
  1871. !STUFFY!FUNK!
  1872. echo Extracting version.c
  1873. sed >version.c <<'!STUFFY!FUNK!' -e 's/X//'
  1874. X/* $Header: version.c,v 1.0 87/12/18 13:06:41 root Exp $
  1875. X *
  1876. X * $Log:    version.c,v $
  1877. X * Revision 1.0  87/12/18  13:06:41  root
  1878. X * Initial revision
  1879. X * 
  1880. X */
  1881. X
  1882. X#include "patchlevel.h"
  1883. X
  1884. X/* Print out the version number. */
  1885. X
  1886. Xversion()
  1887. X{
  1888. X    extern char rcsid[];
  1889. X
  1890. X    printf("%s\r\nPatch level: %d\r\n", rcsid, PATCHLEVEL);
  1891. X}
  1892. !STUFFY!FUNK!
  1893. echo Extracting t/op.unshift
  1894. sed >t/op.unshift <<'!STUFFY!FUNK!' -e 's/X//'
  1895. X#!./perl
  1896. X
  1897. X# $Header: op.unshift,v 1.0 87/12/18 13:14:37 root Exp $
  1898. X
  1899. Xprint "1..2\n";
  1900. X
  1901. X@a = (1,2,3);
  1902. X$cnt1 = unshift(a,0);
  1903. X
  1904. Xif (join(' ',@a) eq '0 1 2 3') {print "ok 1\n";} else {print "not ok 1\n";}
  1905. X$cnt2 = unshift(a,3,2,1);
  1906. Xif (join(' ',@a) eq '3 2 1 0 1 2 3') {print "ok 2\n";} else {print "not ok 2\n";}
  1907. X
  1908. X
  1909. !STUFFY!FUNK!
  1910. echo Extracting t/op.oct
  1911. sed >t/op.oct <<'!STUFFY!FUNK!' -e 's/X//'
  1912. X#!./perl
  1913. X
  1914. X# $Header: op.oct,v 1.0 87/12/18 13:13:57 root Exp $
  1915. X
  1916. Xprint "1..3\n";
  1917. X
  1918. Xif (oct('01234') == 01234) {print "ok 1\n";} else {print "not ok 1\n";}
  1919. Xif (oct('0x1234') == 0x1234) {print "ok 2\n";} else {print "not ok 2\n";}
  1920. Xif (hex('01234') == 0x1234) {print "ok 3\n";} else {print "not ok 3\n";}
  1921. !STUFFY!FUNK!
  1922. echo Extracting t/op.ord
  1923. sed >t/op.ord <<'!STUFFY!FUNK!' -e 's/X//'
  1924. X#!./perl
  1925. X
  1926. X# $Header: op.ord,v 1.0 87/12/18 13:14:01 root Exp $
  1927. X
  1928. Xprint "1..2\n";
  1929. X
  1930. X# compile time evaluation
  1931. X
  1932. Xif (ord('A') == 65) {print "ok 1\n";} else {print "not ok 1\n";}
  1933. X
  1934. X# run time evaluation
  1935. X
  1936. X$x = 'ABC';
  1937. Xif (ord($x) == 65) {print "ok 2\n";} else {print "not ok 2\n";}
  1938. !STUFFY!FUNK!
  1939. echo Extracting t/op.exec
  1940. sed >t/op.exec <<'!STUFFY!FUNK!' -e 's/X//'
  1941. X#!./perl
  1942. X
  1943. X# $Header: op.exec,v 1.0 87/12/18 13:13:26 root Exp $
  1944. X
  1945. X$| = 1;                # flush stdout
  1946. Xprint "1..4\n";
  1947. X
  1948. Xsystem "echo ok \\1";        # shell interpreted
  1949. Xsystem "echo ok 2";        # split and directly called
  1950. Xsystem "echo", "ok", "3";    # directly called
  1951. X
  1952. Xexec "echo","ok","4";
  1953. !STUFFY!FUNK!
  1954. echo Extracting t/op.fork
  1955. sed >t/op.fork <<'!STUFFY!FUNK!' -e 's/X//'
  1956. X#!./perl
  1957. X
  1958. X# $Header: op.fork,v 1.0 87/12/18 13:13:37 root Exp $
  1959. X
  1960. X$| = 1;
  1961. Xprint "1..2\n";
  1962. X
  1963. Xif ($cid = fork) {
  1964. X    sleep 2;
  1965. X    if ($result = (kill 9, $cid)) {print "ok 2\n";} else {print "not ok 2 $result\n";}
  1966. X}
  1967. Xelse {
  1968. X    $| = 1;
  1969. X    print "ok 1\n";
  1970. X    sleep 10;
  1971. X}
  1972. !STUFFY!FUNK!
  1973. echo Extracting t/base.if
  1974. sed >t/base.if <<'!STUFFY!FUNK!' -e 's/X//'
  1975. X#!./perl
  1976. X
  1977. X# $Header: base.if,v 1.0 87/12/18 13:11:45 root Exp $
  1978. X
  1979. Xprint "1..2\n";
  1980. X
  1981. X# first test to see if we can run the tests.
  1982. X
  1983. X$x = 'test';
  1984. Xif ($x eq $x) { print "ok 1\n"; } else { print "not ok 1\n";}
  1985. Xif ($x ne $x) { print "not ok 2\n"; } else { print "ok 2\n";}
  1986. !STUFFY!FUNK!
  1987. echo Extracting t/base.pat
  1988. sed >t/base.pat <<'!STUFFY!FUNK!' -e 's/X//'
  1989. X#!./perl
  1990. X
  1991. X# $Header: base.pat,v 1.0 87/12/18 13:11:56 root Exp $
  1992. X
  1993. Xprint "1..2\n";
  1994. X
  1995. X# first test to see if we can run the tests.
  1996. X
  1997. X$_ = 'test';
  1998. Xif (/^test/) { print "ok 1\n"; } else { print "not ok 1\n";}
  1999. Xif (/^foo/) { print "not ok 2\n"; } else { print "ok 2\n";}
  2000. !STUFFY!FUNK!
  2001. echo Extracting t/op.cond
  2002. sed >t/op.cond <<'!STUFFY!FUNK!' -e 's/X//'
  2003. X#!./perl
  2004. X
  2005. X# $Header: op.cond,v 1.0 87/12/18 13:13:14 root Exp $
  2006. X
  2007. Xprint "1..4\n";
  2008. X
  2009. Xprint 1 ? "ok 1\n" : "not ok 1\n";    # compile time
  2010. Xprint 0 ? "not ok 2\n" : "ok 2\n";
  2011. X
  2012. X$x = 1;
  2013. Xprint $x ? "ok 3\n" : "not ok 3\n";    # run time
  2014. Xprint !$x ? "not ok 4\n" : "ok 4\n";
  2015. !STUFFY!FUNK!
  2016. echo Extracting t/op.sprintf
  2017. sed >t/op.sprintf <<'!STUFFY!FUNK!' -e 's/X//'
  2018. X#!./perl
  2019. X
  2020. X# $Header: op.sprintf,v 1.0 87/12/18 13:14:24 root Exp $
  2021. X
  2022. Xprint "1..1\n";
  2023. X
  2024. X$x = sprintf("%3s %-4s foo %5d%c%3.1f","hi",123,456,65,3.0999);
  2025. Xif ($x eq ' hi 123  foo   456A3.1') {print "ok 1\n";} else {print "not ok 1\n";}
  2026. !STUFFY!FUNK!
  2027. echo Extracting EXTERN.h
  2028. sed >EXTERN.h <<'!STUFFY!FUNK!' -e 's/X//'
  2029. X/* $Header: EXTERN.h,v 1.0 87/12/18 13:02:26 root Exp $
  2030. X *
  2031. X * $Log:    EXTERN.h,v $
  2032. X * Revision 1.0  87/12/18  13:02:26  root
  2033. X * Initial revision
  2034. X * 
  2035. X */
  2036. X
  2037. X#undef EXT
  2038. X#define EXT extern
  2039. X
  2040. X#undef INIT
  2041. X#define INIT(x)
  2042. X
  2043. X#undef DOINIT
  2044. !STUFFY!FUNK!
  2045. echo Extracting x2p/EXTERN.h
  2046. sed >x2p/EXTERN.h <<'!STUFFY!FUNK!' -e 's/X//'
  2047. X/* $Header: EXTERN.h,v 1.0 87/12/18 13:06:44 root Exp $
  2048. X *
  2049. X * $Log:    EXTERN.h,v $
  2050. X * Revision 1.0  87/12/18  13:06:44  root
  2051. X * Initial revision
  2052. X * 
  2053. X */
  2054. X
  2055. X#undef EXT
  2056. X#define EXT extern
  2057. X
  2058. X#undef INIT
  2059. X#define INIT(x)
  2060. X
  2061. X#undef DOINIT
  2062. !STUFFY!FUNK!
  2063. echo Extracting INTERN.h
  2064. sed >INTERN.h <<'!STUFFY!FUNK!' -e 's/X//'
  2065. X/* $Header: INTERN.h,v 1.0 87/12/18 13:02:39 root Exp $
  2066. X *
  2067. X * $Log:    INTERN.h,v $
  2068. X * Revision 1.0  87/12/18  13:02:39  root
  2069. X * Initial revision
  2070. X * 
  2071. X */
  2072. X
  2073. X#undef EXT
  2074. X#define EXT
  2075. X
  2076. X#undef INIT
  2077. X#define INIT(x) = x
  2078. X
  2079. X#define DOINIT
  2080. !STUFFY!FUNK!
  2081. echo Extracting x2p/INTERN.h
  2082. sed >x2p/INTERN.h <<'!STUFFY!FUNK!' -e 's/X//'
  2083. X/* $Header: INTERN.h,v 1.0 87/12/18 13:06:48 root Exp $
  2084. X *
  2085. X * $Log:    INTERN.h,v $
  2086. X * Revision 1.0  87/12/18  13:06:48  root
  2087. X * Initial revision
  2088. X * 
  2089. X */
  2090. X
  2091. X#undef EXT
  2092. X#define EXT
  2093. X
  2094. X#undef INIT
  2095. X#define INIT(x) = x
  2096. X
  2097. X#define DOINIT
  2098. !STUFFY!FUNK!
  2099. echo Extracting Wishlist
  2100. sed >Wishlist <<'!STUFFY!FUNK!' -e 's/X//'
  2101. Xdate support
  2102. Xcase statement
  2103. Xioctl() support
  2104. Xrandom numbers
  2105. Xdirectory reading via <>
  2106. !STUFFY!FUNK!
  2107. echo ""
  2108. echo "End of kit 10 (of 10)"
  2109. cat /dev/null >kit10isdone
  2110. config=true
  2111. for iskit in 1 2 3 4 5 6 7 8 9 10; do
  2112.     if test -f kit${iskit}isdone; then
  2113.     echo "You have run kit ${iskit}."
  2114.     else
  2115.     echo "You still need to run kit ${iskit}."
  2116.     config=false
  2117.     fi
  2118. done
  2119. case $config in
  2120.     true)
  2121.     echo "You have run all your kits.  Please read README and then type Configure."
  2122.     chmod 755 Configure
  2123.     ;;
  2124. esac
  2125. : Someone might mail this, so...
  2126. exit
  2127.