Subject: v13i010: Perl, a "replacement" for awk and sed, Part10/10 Newsgroups: comp.sources.unix Sender: sources Approved: rsalz@uunet.UU.NET Submitted-by: Larry Wall Posting-number: Volume 13, Issue 10 Archive-name: perl/part10 #! /bin/sh # Make a new directory for the perl sources, cd to it, and run kits 1 # thru 10 through sh. When all 10 kits have been run, read README. echo "This is perl 1.0 kit 10 (of 10). If kit 10 is complete, the line" echo '"'"End of kit 10 (of 10)"'" will echo at the end.' echo "" export PATH || (echo "You didn't use sh, you clunch." ; kill $$) mkdir t 2>/dev/null mkdir x2p 2>/dev/null echo Extracting x2p/s2p.man sed >x2p/s2p.man <<'!STUFFY!FUNK!' -e 's/X//' X.rn '' }` X''' $Header: s2p.man,v 1.0 87/12/18 17:37:16 root Exp $ X''' X''' $Log: s2p.man,v $ X''' Revision 1.0 87/12/18 17:37:16 root X''' Initial revision X''' X''' X.de Sh X.br X.ne 5 X.PP X\fB\\$1\fR X.PP X.. X.de Sp X.if t .sp .5v X.if n .sp X.. X.de Ip X.br X.ie \\n.$>=3 .ne \\$3 X.el .ne 3 X.IP "\\$1" \\$2 X.. X''' X''' Set up \*(-- to give an unbreakable dash; X''' string Tr holds user defined translation string. X''' Bell System Logo is used as a dummy character. X''' X.tr \(bs-|\(bv\*(Tr X.ie n \{\ X.ds -- \(bs- X.if (\n(.H=4u)&(1m=24u) .ds -- \(bs\h'-12u'\(bs\h'-12u'-\" diablo 10 pitch X.if (\n(.H=4u)&(1m=20u) .ds -- \(bs\h'-12u'\(bs\h'-8u'-\" diablo 12 pitch X.ds L" "" X.ds R" "" X.ds L' ' X.ds R' ' X'br\} X.el\{\ X.ds -- \(em\| X.tr \*(Tr X.ds L" `` X.ds R" '' X.ds L' ` X.ds R' ' X'br\} X.TH S2P 1 NEW X.SH NAME Xs2p - Sed to Perl translator X.SH SYNOPSIS X.B s2p [options] filename X.SH DESCRIPTION X.I S2p Xtakes a sed script specified on the command line (or from standard input) Xand produces a comparable X.I perl Xscript on the standard output. X.Sh "Options" XOptions include: X.TP 5 X.B \-D Xsets debugging flags. X.TP 5 X.B \-n Xspecifies that this sed script was always invoked with a sed -n. XOtherwise a switch parser is prepended to the front of the script. X.TP 5 X.B \-p Xspecifies that this sed script was never invoked with a sed -n. XOtherwise a switch parser is prepended to the front of the script. X.Sh "Considerations" XThe perl script produced looks very sed-ish, and there may very well be Xbetter ways to express what you want to do in perl. XFor instance, s2p does not make any use of the split operator, but you might Xwant to. X.PP XThe perl script you end up with may be either faster or slower than the original Xsed script. XIf you're only interested in speed you'll just have to try it both ways. XOf course, if you want to do something sed doesn't do, you have no choice. X.SH ENVIRONMENT XS2p uses no environment variables. X.SH AUTHOR XLarry Wall X.SH FILES X.SH SEE ALSO Xperl The perl compiler/interpreter X.br Xa2p awk to perl translator X.SH DIAGNOSTICS X.SH BUGS X.rn }` '' !STUFFY!FUNK! echo Extracting stab.h sed >stab.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: stab.h,v 1.0 87/12/18 13:06:18 root Exp $ X * X * $Log: stab.h,v $ X * Revision 1.0 87/12/18 13:06:18 root X * Initial revision X * X */ X Xstruct stab { X struct stab *stab_next; X char *stab_name; X STR *stab_val; X struct stio *stab_io; X FCMD *stab_form; X ARRAY *stab_array; X HASH *stab_hash; X CMD *stab_sub; X char stab_flags; X}; X X#define SF_VMAGIC 1 /* call routine to dereference STR val */ X Xstruct stio { X FILE *fp; X long lines; X long page; X long page_len; X long lines_left; X char *top_name; X STAB *top_stab; X char *fmt_name; X STAB *fmt_stab; X char type; X char flags; X}; X X#define IOF_ARGV 1 /* this fp iterates over ARGV */ X#define IOF_START 2 /* check for null ARGV and substitute '-' */ X#define IOF_FLUSH 4 /* this fp wants a flush after write op */ X X#define Nullstab Null(STAB*) X X#define STAB_STR(s) (tmpstab = (s), tmpstab->stab_flags & SF_VMAGIC ? stab_str(tmpstab) : tmpstab->stab_val) X#define STAB_GET(s) (tmpstab = (s), str_get(tmpstab->stab_flags & SF_VMAGIC ? stab_str(tmpstab) : tmpstab->stab_val)) X#define STAB_GNUM(s) (tmpstab = (s), str_gnum(tmpstab->stab_flags & SF_VMAGIC ? stab_str(tmpstab) : tmpstab->stab_val)) X XEXT STAB *tmpstab; X XEXT STAB *stab_index[128]; X XEXT char *envname; /* place for ENV name being assigned--gross cheat */ XEXT char *signame; /* place for SIG name being assigned--gross cheat */ X XEXT int statusvalue; XEXT int subsvalue; X XSTAB *aadd(); XSTAB *hadd(); !STUFFY!FUNK! echo Extracting makedir.SH sed >makedir.SH <<'!STUFFY!FUNK!' -e 's/X//' Xcase $CONFIG in X'') X if test ! -f config.sh; then X ln ../config.sh . || \ X ln ../../config.sh . || \ X ln ../../../config.sh . || \ X (echo "Can't find config.sh."; exit 1) X fi X . config.sh X ;; Xesac Xcase "$0" in X*/*) cd `expr X$0 : 'X\(.*\)/'` ;; Xesac Xecho "Extracting makedir (with variable substitutions)" X$spitshell >makedir </dev/null 2>&1 Xdone X!GROK!THIS! X$eunicefix makedir Xchmod 755 makedir !STUFFY!FUNK! echo Extracting t/cmd.subval sed >t/cmd.subval <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: cmd.subval,v 1.0 87/12/18 13:12:12 root Exp $ X Xsub foo1 { X 'true1'; X if ($_[0]) { 'true2'; } X} X Xsub foo2 { X 'true1'; X if ($_[0]) { 'true2'; } else { 'true3'; } X} X Xsub foo3 { X 'true1'; X unless ($_[0]) { 'true2'; } X} X Xsub foo4 { X 'true1'; X unless ($_[0]) { 'true2'; } else { 'true3'; } X} X Xsub foo5 { X 'true1'; X 'true2' if $_[0]; X} X Xsub foo6 { X 'true1'; X 'true2' unless $_[0]; X} X Xprint "1..12\n"; X Xif (do foo1(0) eq '') {print "ok 1\n";} else {print "not ok 1\n";} Xif (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";} Xif (do foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";} Xif (do foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";} X Xif (do foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";} Xif (do foo3(1) eq '') {print "ok 6\n";} else {print "not ok 6\n";} Xif (do foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";} Xif (do foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";} X Xif (do foo5(0) eq '') {print "ok 9\n";} else {print "not ok 9\n";} Xif (do foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";} Xif (do foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";} Xif (do foo6(1) eq '') {print "ok 12\n";} else {print "not ok 12\n";} !STUFFY!FUNK! echo Extracting t/TEST sed >t/TEST <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: TEST,v 1.0 87/12/18 13:11:34 root Exp $ X X# This is written in a peculiar style, since we're trying to avoid X# most of the constructs we'll be testing for. X Xif ($ARGV[0] eq '-v') { X $verbose = 1; X shift; X} X Xif ($ARGV[0] eq '') { X @ARGV = split(/[ \n]/,`echo base.* comp.* cmd.* io.* op.*`); X} X X$bad = 0; Xwhile ($test = shift) { X print "$test..."; X open(results,"$test|") || (print "can't run.\n"); X $ok = 0; X while () { X if ($verbose) { X print $_; X } X unless (/^#/) { X if (/^1\.\.([0-9]+)/) { X $max = $1; X $next = 1; X $ok = 1; X } else { X if (/^ok (.*)/ && $1 == $next) { X $next = $next + 1; X } else { X $ok = 0; X } X } X } X } X $next = $next - 1; X if ($ok && $next == $max) { X print "ok\n"; X } else { X $next += 1; X print "FAILED on test $next\n"; X $bad = $bad + 1; X $_ = $test; X if (/^base/) { X die "Failed a basic test--cannot continue."; X } X } X} X Xif ($bad == 0) { X if ($ok) { X print "All tests successful.\n"; X } else { X die "FAILED--no tests were run for some reason."; X } X} else { X if ($bad == 1) { X die "Failed 1 test."; X } else { X die "Failed $bad tests."; X } X} X($user,$sys,$cuser,$csys) = times; Xprint sprintf("u=%g s=%g cu=%g cs=%g\n",$user,$sys,$cuser,$csys); !STUFFY!FUNK! echo Extracting t/op.list sed >t/op.list <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.list,v 1.0 87/12/18 13:13:50 root Exp $ X Xprint "1..11\n"; X X@foo = (1, 2, 3, 4); Xif ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";} X X$_ = join(foo,':'); Xif ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";} X X($a,$b,$c,$d) = (1,2,3,4); Xif ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 3\n";} else {print "not ok 3\n";} X X($c,$b,$a) = split(/ /,"111 222 333"); Xif ("$a;$b;$c" eq '333;222;111') {print "ok 4\n";} else {print "not ok 4\n";} X X($a,$b,$c) = ($c,$b,$a); Xif ("$a;$b;$c" eq '111;222;333') {print "ok 5\n";} else {print "not ok 5\n";} X X($a, $b) = ($b, $a); Xif ("$a;$b;$c" eq '222;111;333') {print "ok 6\n";} else {print "not ok 6\n";} X X($a, $b[1], $c{2}, $d) = (1, 2, 3, 4); Xif ($a eq 1) {print "ok 7\n";} else {print "not ok 7\n";} Xif ($b[1] eq 2) {print "ok 8\n";} else {print "not ok 8\n";} Xif ($c{2} eq 3) {print "ok 9\n";} else {print "not ok 9\n";} Xif ($d eq 4) {print "ok 10\n";} else {print "not ok 10\n";} X X@foo = (1,2,3,4,5,6,7,8); X($a, $b, $c, $d) = @foo; Xprint "#11 $a;$b;$c;$d eq 1;2;3;4\n"; Xif ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 11\n";} else {print "not ok 11\n";} !STUFFY!FUNK! echo Extracting t/io.tell sed >t/io.tell <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: io.tell,v 1.0 87/12/18 13:13:02 root Exp $ X Xprint "1..13\n"; X Xopen(tst, '../Makefile') || (die "Can't open ../Makefile"); X Xif (eof(tst)) { print "not ok 1\n"; } else { print "ok 1\n"; } X X$firstline = ; X$secondpos = tell; X X$x = 0; Xwhile () { X if (eof) {$x++;} X} Xif ($x == 1) { print "ok 2\n"; } else { print "not ok 2\n"; } X X$lastpos = tell; X Xunless (eof) { print "not ok 3\n"; } else { print "ok 3\n"; } X Xif (seek(tst,0,0)) { print "ok 4\n"; } else { print "not ok 4\n"; } X Xif (eof) { print "not ok 5\n"; } else { print "ok 5\n"; } X Xif ($firstline eq ) { print "ok 6\n"; } else { print "not ok 6\n"; } X Xif ($secondpos == tell) { print "ok 7\n"; } else { print "not ok 7\n"; } X Xif (seek(tst,0,1)) { print "ok 8\n"; } else { print "not ok 8\n"; } X Xif (eof) { print "not ok 9\n"; } else { print "ok 9\n"; } X Xif ($secondpos == tell) { print "ok 10\n"; } else { print "not ok 10\n"; } X Xif (seek(tst,0,2)) { print "ok 11\n"; } else { print "not ok 11\n"; } X Xif ($lastpos == tell) { print "ok 12\n"; } else { print "not ok 12\n"; } X Xunless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; } !STUFFY!FUNK! echo Extracting search.h sed >search.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: search.h,v 1.0 87/12/18 13:06:06 root Exp $ X * X * $Log: search.h,v $ X * Revision 1.0 87/12/18 13:06:06 root X * Initial revision X * X */ X X#ifndef MAXSUB X#define MAXSUB 10 /* how many sub-patterns are allowed */ X#define MAXALT 10 /* how many alternatives are allowed */ X Xtypedef struct { X char *precomp; /* the original pattern, for debug output */ X char *compbuf; /* the compiled pattern */ X int complen; /* length of compbuf */ X char *alternatives[MAXALT]; /* list of alternatives */ X char *subbeg[MAXSUB]; /* subpattern start list */ X char *subend[MAXSUB]; /* subpattern end list */ X char *subbase; /* saved match string after execute() */ X char lastparen; /* which subpattern matched last */ X char numsubs; /* how many subpatterns the compiler saw */ X bool do_folding; /* fold upper and lower case? */ X} COMPEX; X XEXT int multiline INIT(0); X Xvoid search_init(); Xvoid init_compex(); Xvoid free_compex(); Xchar *getparen(); Xvoid case_fold(); Xchar *compile(); Xvoid grow_comp(); Xchar *execute(); Xbool try(); Xbool subpat(); Xbool cclass(); X#endif !STUFFY!FUNK! echo Extracting hash.h sed >hash.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: hash.h,v 1.0 87/12/18 13:05:20 root Exp $ X * X * $Log: hash.h,v $ X * Revision 1.0 87/12/18 13:05:20 root X * Initial revision X * X */ X X#define FILLPCT 60 /* don't make greater than 99 */ X X#ifdef DOINIT Xchar coeff[] = { X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1}; X#else Xextern char coeff[]; X#endif X Xtypedef struct hentry HENT; X Xstruct hentry { X HENT *hent_next; X char *hent_key; X STR *hent_val; X int hent_hash; X}; X Xstruct htbl { X HENT **tbl_array; X int tbl_max; X int tbl_fill; X int tbl_riter; /* current root of iterator */ X HENT *tbl_eiter; /* current entry of iterator */ X}; X XSTR *hfetch(); Xbool hstore(); Xbool hdelete(); XHASH *hnew(); Xint hiterinit(); XHENT *hiternext(); Xchar *hiterkey(); XSTR *hiterval(); !STUFFY!FUNK! echo Extracting x2p/hash.h sed >x2p/hash.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: hash.h,v 1.0 87/12/18 13:07:23 root Exp $ X * X * $Log: hash.h,v $ X * Revision 1.0 87/12/18 13:07:23 root X * Initial revision X * X */ X X#define FILLPCT 60 /* don't make greater than 99 */ X X#ifdef DOINIT Xchar coeff[] = { X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, X 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1}; X#else Xextern char coeff[]; X#endif X Xtypedef struct hentry HENT; X Xstruct hentry { X HENT *hent_next; X char *hent_key; X STR *hent_val; X int hent_hash; X}; X Xstruct htbl { X HENT **tbl_array; X int tbl_max; X int tbl_fill; X int tbl_riter; /* current root of iterator */ X HENT *tbl_eiter; /* current entry of iterator */ X}; X XSTR *hfetch(); Xbool hstore(); Xbool hdelete(); XHASH *hnew(); Xint hiterinit(); XHENT *hiternext(); Xchar *hiterkey(); XSTR *hiterval(); !STUFFY!FUNK! echo Extracting t/op.time sed >t/op.time <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.time,v 1.0 87/12/18 13:14:33 root Exp $ X Xprint "1..5\n"; X X($beguser,$begsys) = times; X X$beg = time; X Xwhile (($now = time) == $beg) {} X Xif ($now > $beg && $now - $beg < 10){print "ok 1\n";} else {print "not ok 1\n";} X Xfor ($i = 0; $i < 100000; $i++) { X ($nowuser, $nowsys) = times; X $i = 200000 if $nowuser > $beguser && $nowsys > $begsys; X last if time - $beg > 20; X} X Xif ($i >= 200000) {print "ok 2\n";} else {print "not ok 2\n";} X X($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($beg); X($xsec,$foo) = localtime($now); X$localyday = $yday; X Xif ($sec != $xsec && $yday && $wday && $year) X {print "ok 3\n";} Xelse X {print "not ok 3\n";} X X($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($beg); X($xsec,$foo) = localtime($now); X Xif ($sec != $xsec && $yday && $wday && $year) X {print "ok 4\n";} Xelse X {print "not ok 4\n";} X Xif (index(" :0:1:-1:365:366:-365:-366:",':' . ($localyday - $yday) . ':') > 0) X {print "ok 5\n";} Xelse X {print "not ok 5\n";} !STUFFY!FUNK! echo Extracting t/op.subst sed >t/op.subst <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.subst,v 1.0 87/12/18 13:14:30 root Exp $ X Xprint "1..7\n"; X X$x = 'foo'; X$_ = "x"; Xs/x/\$x/; Xprint "#1\t:$_: eq :\$x:\n"; Xif ($_ eq '$x') {print "ok 1\n";} else {print "not ok 1\n";} X X$_ = "x"; Xs/x/$x/; Xprint "#2\t:$_: eq :foo:\n"; Xif ($_ eq 'foo') {print "ok 2\n";} else {print "not ok 2\n";} X X$_ = "x"; Xs/x/\$x $x/; Xprint "#3\t:$_: eq :\$x foo:\n"; Xif ($_ eq '$x foo') {print "ok 3\n";} else {print "not ok 3\n";} X X$a = 'abcdef'; X$b = 'cd'; X$a =~ s'(b${b}e)'\n$1'; Xprint "#4\t:$1: eq :bcde:\n"; Xprint "#4\t:$a: eq :a\\n\$1f:\n"; Xif ($1 eq 'bcde' && $a eq 'a\n$1f') {print "ok 4\n";} else {print "not ok 4\n";} X X$a = 'abacada'; Xif (($a =~ s/a/x/g) == 4 && $a eq 'xbxcxdx') X {print "ok 5\n";} else {print "not ok 5\n";} X Xif (($a =~ s/a/y/g) == 0 && $a eq 'xbxcxdx') X {print "ok 6\n";} else {print "not ok 6\n";} X Xif (($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx') X {print "ok 7\n";} else {print "not ok 7\n";} !STUFFY!FUNK! echo Extracting str.h sed >str.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: str.h,v 1.0 87/12/18 13:06:26 root Exp $ X * X * $Log: str.h,v $ X * Revision 1.0 87/12/18 13:06:26 root X * Initial revision X * X */ X Xstruct string { X char * str_ptr; /* pointer to malloced string */ X double str_nval; /* numeric value, if any */ X int str_len; /* allocated size */ X int str_cur; /* length of str_ptr as a C string */ X union { X STR *str_next; /* while free, link to next free str */ X STAB *str_magic; /* while in use, ptr to magic stab, if any */ X } str_link; X char str_pok; /* state of str_ptr */ X char str_nok; /* state of str_nval */ X}; X X#define Nullstr Null(STR*) X X/* the following macro updates any magic values this str is associated with */ X X#define STABSET(x) (x->str_link.str_magic && stabset(x->str_link.str_magic,x)) X XEXT STR **tmps_list; XEXT long tmps_max INIT(-1); X Xchar *str_2ptr(); Xdouble str_2num(); XSTR *str_static(); XSTR *str_make(); XSTR *str_nmake(); !STUFFY!FUNK! echo Extracting t/op.repeat sed >t/op.repeat <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.repeat,v 1.0 87/12/18 13:14:14 root Exp $ X Xprint "1..11\n"; X X# compile time X Xif ('-' x 5 eq '-----') {print "ok 1\n";} else {print "not ok 1\n";} Xif ('-' x 1 eq '-') {print "ok 2\n";} else {print "not ok 2\n";} Xif ('-' x 0 eq '') {print "ok 3\n";} else {print "not ok 3\n";} X Xif ('ab' x 3 eq 'ababab') {print "ok 4\n";} else {print "not ok 4\n";} X X# run time X X$a = '-'; Xif ($a x 5 eq '-----') {print "ok 5\n";} else {print "not ok 5\n";} Xif ($a x 1 eq '-') {print "ok 6\n";} else {print "not ok 6\n";} Xif ($a x 0 eq '') {print "ok 7\n";} else {print "not ok 7\n";} X X$a = 'ab'; Xif ($a x 3 eq 'ababab') {print "ok 8\n";} else {print "not ok 8\n";} X X$a = 'xyz'; X$a x= 2; Xif ($a eq 'xyzxyz') {print "ok 9\n";} else {print "not ok 9\n";} X$a x= 1; Xif ($a eq 'xyzxyz') {print "ok 10\n";} else {print "not ok 10\n";} X$a x= 0; Xif ($a eq '') {print "ok 11\n";} else {print "not ok 11\n";} X !STUFFY!FUNK! echo Extracting t/op.each sed >t/op.each <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.each,v 1.0 87/12/18 13:13:23 root Exp $ X Xprint "1..2\n"; X X$h{'abc'} = 'ABC'; X$h{'def'} = 'DEF'; X$h{'jkl'} = 'JKL'; X$h{'xyz'} = 'XYZ'; X$h{'a'} = 'A'; X$h{'b'} = 'B'; X$h{'c'} = 'C'; X$h{'d'} = 'D'; X$h{'e'} = 'E'; X$h{'f'} = 'F'; X$h{'g'} = 'G'; X$h{'h'} = 'H'; X$h{'i'} = 'I'; X$h{'j'} = 'J'; X$h{'k'} = 'K'; X$h{'l'} = 'L'; X$h{'m'} = 'M'; X$h{'n'} = 'N'; X$h{'o'} = 'O'; X$h{'p'} = 'P'; X$h{'q'} = 'Q'; X$h{'r'} = 'R'; X$h{'s'} = 'S'; X$h{'t'} = 'T'; X$h{'u'} = 'U'; X$h{'v'} = 'V'; X$h{'w'} = 'W'; X$h{'x'} = 'X'; X$h{'y'} = 'Y'; X$h{'z'} = 'Z'; X X@keys = keys(h); X@values = values(h); X Xif ($#keys == 29 && $#values == 29) {print "ok 1\n";} else {print "not ok 1\n";} X Xwhile (($key,$value) = each(h)) { X if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) { X $key =~ y/a-z/A-Z/; X $i++ if $key eq $value; X } X} X Xif ($i == 30) {print "ok 2\n";} else {print "not ok 2\n";} !STUFFY!FUNK! echo Extracting t/io.argv sed >t/io.argv <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: io.argv,v 1.0 87/12/18 13:12:44 root Exp $ X Xprint "1..5\n"; X Xopen(try, '>Io.argv.tmp') || (die "Can't open temp file."); Xprint try "a line\n"; Xclose try; X X$x = `./perl -e 'while (<>) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`; X Xif ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";} X X$x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`; X Xif ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} X X$x = `echo foo|./perl -e 'while (<>) {print $_;}'`; X Xif ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3\n";} X X@ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp'); Xwhile (<>) { X $y .= $. . $_; X if (eof) { X if ($. == 3) {print "ok 4\n";} else {print "not ok 4\n";} X } X} X Xif ($y eq "1a line\n2a line\n3a line\n") X {print "ok 5\n";} Xelse X {print "not ok 5\n";} X X`/bin/rm -f Io.argv.tmp`; !STUFFY!FUNK! echo Extracting t/comp.term sed >t/comp.term <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: comp.term,v 1.0 87/12/18 13:12:40 root Exp $ X X# tests that aren't important enough for base.term X Xprint "1..9\n"; X X$x = "\\n"; Xprint "#1\t:$x: eq " . ':\n:' . "\n"; Xif ($x eq '\n') {print "ok 1\n";} else {print "not ok 1\n";} X X$x = "#2\t:$x: eq :\\n:\n"; Xprint $x; Xunless (index($x,'\\\\')>0) {print "ok 2\n";} else {print "not ok 2\n";} X Xif (length('\\\\') == 2) {print "ok 3\n";} else {print "not ok 3\n";} X X$one = 'a'; X Xif (length("\\n") == 2) {print "ok 4\n";} else {print "not ok 4\n";} Xif (length("\\\n") == 2) {print "ok 5\n";} else {print "not ok 5\n";} Xif (length("$one\\n") == 3) {print "ok 6\n";} else {print "not ok 6\n";} Xif (length("$one\\\n") == 3) {print "ok 7\n";} else {print "not ok 7\n";} Xif (length("\\n$one") == 3) {print "ok 8\n";} else {print "not ok 8\n";} Xif (length("\\\n$one") == 3) {print "ok 9\n";} else {print "not ok 9\n";} X !STUFFY!FUNK! echo Extracting x2p/str.h sed >x2p/str.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: str.h,v 1.0 87/12/18 13:07:30 root Exp $ X * X * $Log: str.h,v $ X * Revision 1.0 87/12/18 13:07:30 root X * Initial revision X * X */ X Xstruct string { X char * str_ptr; /* pointer to malloced string */ X double str_nval; /* numeric value, if any */ X int str_len; /* allocated size */ X int str_cur; /* length of str_ptr as a C string */ X union { X STR *str_next; /* while free, link to next free str */ X } str_link; X char str_pok; /* state of str_ptr */ X char str_nok; /* state of str_nval */ X}; X X#define Nullstr Null(STR*) X X/* the following macro updates any magic values this str is associated with */ X X#define STABSET(x) (x->str_link.str_magic && stabset(x->str_link.str_magic,x)) X XEXT STR **tmps_list; XEXT long tmps_max INIT(-1); X Xchar *str_2ptr(); Xdouble str_2num(); XSTR *str_static(); XSTR *str_make(); XSTR *str_nmake(); Xchar *str_gets(); !STUFFY!FUNK! echo Extracting t/op.stat sed >t/op.stat <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.stat,v 1.0 87/12/18 13:14:27 root Exp $ X Xprint "1..4\n"; X Xopen(foo, ">Op.stat.tmp"); X X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat(foo); Xif ($nlink == 1) {print "ok 1\n";} else {print "not ok 1\n";} Xif ($mtime && $mtime == $ctime) {print "ok 2\n";} else {print "not ok 2\n";} X Xprint foo "Now is the time for all good men to come to.\n"; Xclose(foo); X X$base = time; Xwhile (time == $base) {} X X`rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`; X X($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, X $blksize,$blocks) = stat('Op.stat.tmp'); X Xif ($nlink == 2) {print "ok 3\n";} else {print "not ok 3\n";} Xif ($mtime && $mtime != $ctime) {print "ok 4\n";} else {print "not ok 4\n";} Xprint "#4 :$mtime: != :$ctime:\n"; X X`rm -f Op.stat.tmp Op.stat.tmp2`; !STUFFY!FUNK! echo Extracting spat.h sed >spat.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: spat.h,v 1.0 87/12/18 13:06:10 root Exp $ X * X * $Log: spat.h,v $ X * Revision 1.0 87/12/18 13:06:10 root X * Initial revision X * X */ X Xstruct scanpat { X SPAT *spat_next; /* list of all scanpats */ X COMPEX spat_compex; /* compiled expression */ X ARG *spat_repl; /* replacement string for subst */ X ARG *spat_runtime; /* compile pattern at runtime */ X STR *spat_first; /* for a fast bypass of execute() */ X bool spat_flags; X char spat_flen; X}; X X#define SPAT_USED 1 /* spat has been used once already */ X#define SPAT_USE_ONCE 2 /* use pattern only once per article */ X#define SPAT_SCANFIRST 4 /* initial constant not anchored */ X#define SPAT_SCANALL 8 /* initial constant is whole pat */ X XEXT SPAT *spat_root; /* list of all spats */ XEXT SPAT *curspat; /* what to do \ interps from */ X X#define Nullspat Null(SPAT*) !STUFFY!FUNK! echo Extracting t/op.do sed >t/op.do <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.do,v 1.0 87/12/18 13:13:20 root Exp $ Xsub foo1 X{ X print $_[0]; X 'value'; X} X Xsub foo2 X{ X shift(_); X print $_[0]; X $x = 'value'; X $x; X} X Xprint "1..8\n"; X X$_[0] = "not ok 1\n"; X$result = do foo1("ok 1\n"); Xprint "#2\t:$result: eq :value:\n"; Xif ($result EQ 'value') { print "ok 2\n"; } else { print "not ok 2\n"; } Xif ($_[0] EQ "not ok 1\n") { print "ok 3\n"; } else { print "not ok 3\n"; } X X$_[0] = "not ok 4\n"; X$result = do foo2("not ok 4\n","ok 4\n","not ok 4\n"); Xprint "#5\t:$result: eq :value:\n"; Xif ($result EQ 'value') { print "ok 5\n"; } else { print "not ok 5\n"; } Xif ($_[0] EQ "not ok 4\n") { print "ok 6\n"; } else { print "not ok 6\n"; } X X$result = do{print "ok 7\n"; 'value';}; Xprint "#8\t:$result: eq :value:\n"; Xif ($result EQ 'value') { print "ok 8\n"; } else { print "not ok 8\n"; } !STUFFY!FUNK! echo Extracting t/base.term sed >t/base.term <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: base.term,v 1.0 87/12/18 13:11:59 root Exp $ X Xprint "1..6\n"; X X# check "" interpretation X X$x = "\n"; Xif ($x lt ' ') {print "ok 1\n";} else {print "not ok 1\n";} X X# check `` processing X X$x = `echo hi there`; Xif ($x eq "hi there\n") {print "ok 2\n";} else {print "not ok 2\n";} X X# check $#array X X$x[0] = 'foo'; X$x[1] = 'foo'; X$tmp = $#x; Xprint "#3\t:$tmp: == :1:\n"; Xif ($#x == '1') {print "ok 3\n";} else {print "not ok 3\n";} X X# check numeric literal X X$x = 1; Xif ($x == '1') {print "ok 4\n";} else {print "not ok 4\n";} X X# check <> pseudoliteral X Xopen(try, "/dev/null") || (die "Can't open /dev/null."); Xif ( eq '') {print "ok 5\n";} else {print "not ok 5\n";} X Xopen(try, "/etc/termcap") || (die "Can't open /etc/termcap."); Xif ( ne '') {print "ok 6\n";} else {print "not ok 6\n";} !STUFFY!FUNK! echo Extracting t/comp.multiline sed >t/comp.multiline <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: comp.multiline,v 1.0 87/12/18 13:12:31 root Exp $ X Xprint "1..5\n"; X Xopen(try,'>Comp.try') || (die "Can't open temp file."); X X$x = 'now is the time Xfor all good men Xto come to. X'; X X$y = 'now is the time' . "\n" . X'for all good men' . "\n" . X'to come to.' . "\n"; X Xif ($x eq $y) {print "ok 1\n";} else {print "not ok 1\n";} X Xprint try $x; Xclose try; X Xopen(try,'Comp.try') || (die "Can't reopen temp file."); X$count = 0; X$z = ''; Xwhile () { X $z .= $_; X $count = $count + 1; X} X Xif ($z eq $y) {print "ok 2\n";} else {print "not ok 2\n";} X Xif ($count == 3) {print "ok 3\n";} else {print "not ok 3\n";} X X$_ = `cat Comp.try`; X Xif (/.*\n.*\n.*\n$/) {print "ok 4\n";} else {print "not ok 4\n";} X`/bin/rm -f Comp.try`; X Xif ($_ eq $y) {print "ok 5\n";} else {print "not ok 5\n";} !STUFFY!FUNK! echo Extracting t/comp.cpp sed >t/comp.cpp <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl -P X X# $Header: comp.cpp,v 1.0 87/12/18 13:12:22 root Exp $ X Xprint "1..3\n"; X X#this is a comment X#define MESS "ok 1\n" Xprint MESS; X X#If you capitalize, it's a comment. X#ifdef MESS X print "ok 2\n"; X#else X print "not ok 2\n"; X#endif X Xopen(try,">Comp.cpp.tmp") || die "Can't open temp perl file."; Xprint try '$ok = "not ok 3\n";'; print try "\n"; Xprint try "#include \n"; Xprint try "#ifdef OK\n"; Xprint try '$ok = OK;'; print try "\n"; Xprint try "#endif\n"; Xprint try 'print $ok;'; print try "\n"; Xclose try; X Xopen(try,">Comp.cpp.inc") || (die "Can't open temp include file."); Xprint try '#define OK "ok 3\n"'; print try "\n"; Xclose try; X X$pwd=`pwd`; X$pwd =~ s/\n//; X$x = `./perl -P -I$pwd Comp.cpp.tmp`; Xprint $x; X`/bin/rm -f Comp.cpp.tmp Comp.cpp.inc`; !STUFFY!FUNK! echo Extracting t/op.exp sed >t/op.exp <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.exp,v 1.0 87/12/18 13:13:29 root Exp $ X Xprint "1..6\n"; X X# compile time evaluation X X$s = sqrt(2); Xif (substr($s,0,5) eq '1.414') {print "ok 1\n";} else {print "not ok 1\n";} X X$s = exp(1); Xif (substr($s,0,7) eq '2.71828') {print "ok 2\n";} else {print "not ok 2\n";} X Xif (exp(log(1)) == 1) {print "ok 3\n";} else {print "not ok 3\n";} X X# run time evaluation X X$x1 = 1; X$x2 = 2; X$s = sqrt($x2); Xif (substr($s,0,5) eq '1.414') {print "ok 4\n";} else {print "not ok 4\n";} X X$s = exp($x1); Xif (substr($s,0,7) eq '2.71828') {print "ok 5\n";} else {print "not ok 5\n";} X Xif (exp(log($x1)) == 1) {print "ok 6\n";} else {print "not ok 6\n";} !STUFFY!FUNK! echo Extracting handy.h sed >handy.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: handy.h,v 1.0 87/12/18 13:05:14 root Exp $ X * X * $Log: handy.h,v $ X * Revision 1.0 87/12/18 13:05:14 root X * Initial revision X * X */ X X#define Null(type) ((type)0) X#define Nullch Null(char*) X#define Nullfp Null(FILE*) X X#define bool char X#define TRUE (1) X#define FALSE (0) X X#define Ctl(ch) (ch & 037) X X#define strNE(s1,s2) (strcmp(s1,s2)) X#define strEQ(s1,s2) (!strcmp(s1,s2)) X#define strLT(s1,s2) (strcmp(s1,s2) < 0) X#define strLE(s1,s2) (strcmp(s1,s2) <= 0) X#define strGT(s1,s2) (strcmp(s1,s2) > 0) X#define strGE(s1,s2) (strcmp(s1,s2) >= 0) X#define strnNE(s1,s2,l) (strncmp(s1,s2,l)) X#define strnEQ(s1,s2,l) (!strncmp(s1,s2,l)) !STUFFY!FUNK! echo Extracting x2p/handy.h sed >x2p/handy.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: handy.h,v 1.0 87/12/18 13:07:15 root Exp $ X * X * $Log: handy.h,v $ X * Revision 1.0 87/12/18 13:07:15 root X * Initial revision X * X */ X X#define Null(type) ((type)0) X#define Nullch Null(char*) X#define Nullfp Null(FILE*) X X#define bool char X#define TRUE (1) X#define FALSE (0) X X#define Ctl(ch) (ch & 037) X X#define strNE(s1,s2) (strcmp(s1,s2)) X#define strEQ(s1,s2) (!strcmp(s1,s2)) X#define strLT(s1,s2) (strcmp(s1,s2) < 0) X#define strLE(s1,s2) (strcmp(s1,s2) <= 0) X#define strGT(s1,s2) (strcmp(s1,s2) > 0) X#define strGE(s1,s2) (strcmp(s1,s2) >= 0) X#define strnNE(s1,s2,l) (strncmp(s1,s2,l)) X#define strnEQ(s1,s2,l) (!strncmp(s1,s2,l)) !STUFFY!FUNK! echo Extracting x2p/util.h sed >x2p/util.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: util.h,v 1.0 87/12/18 13:07:37 root Exp $ X * X * $Log: util.h,v $ X * Revision 1.0 87/12/18 13:07:37 root X * Initial revision X * X */ X X/* is the string for makedir a directory name or a filename? */ X X#define MD_DIR 0 X#define MD_FILE 1 X Xvoid util_init(); Xint doshell(); Xchar *safemalloc(); Xchar *saferealloc(); Xchar *safecpy(); Xchar *safecat(); Xchar *cpytill(); Xchar *cpy2(); Xchar *instr(); X#ifdef SETUIDGID X int eaccess(); X#endif Xchar *getwd(); Xvoid cat(); Xvoid prexit(); Xchar *get_a_line(); Xchar *savestr(); Xint makedir(); Xvoid setenv(); Xint envix(); Xvoid notincl(); Xchar *getval(); Xvoid growstr(); Xvoid setdef(); !STUFFY!FUNK! echo Extracting util.h sed >util.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: util.h,v 1.0 87/12/18 13:06:33 root Exp $ X * X * $Log: util.h,v $ X * Revision 1.0 87/12/18 13:06:33 root X * Initial revision X * X */ X X/* is the string for makedir a directory name or a filename? */ X X#define MD_DIR 0 X#define MD_FILE 1 X Xvoid util_init(); Xint doshell(); Xchar *safemalloc(); Xchar *saferealloc(); Xchar *safecpy(); Xchar *safecat(); Xchar *cpytill(); Xchar *instr(); X#ifdef SETUIDGID X int eaccess(); X#endif Xchar *getwd(); Xvoid cat(); Xvoid prexit(); Xchar *get_a_line(); Xchar *savestr(); Xint makedir(); Xvoid setenv(); Xint envix(); Xvoid notincl(); Xchar *getval(); Xvoid growstr(); Xvoid setdef(); !STUFFY!FUNK! echo Extracting t/op.goto sed >t/op.goto <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.goto,v 1.0 87/12/18 13:13:40 root Exp $ X Xprint "1..3\n"; X Xwhile (0) { X $foo = 1; X label1: X $foo = 2; X goto label2; X} continue { X $foo = 0; X goto label4; X label3: X $foo = 4; X goto label4; X} Xgoto label1; X X$foo = 3; X Xlabel2: Xprint "#1\t:$foo: == 2\n"; Xif ($foo == 2) {print "ok 1\n";} else {print "not ok 1\n";} Xgoto label3; X Xlabel4: Xprint "#2\t:$foo: == 4\n"; Xif ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";} X X$x = `./perl -e 'goto foo;' 2>&1`; Xprint "#3\t/label/ in :$x"; Xif ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";} !STUFFY!FUNK! echo Extracting t/op.flip sed >t/op.flip <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.flip,v 1.0 87/12/18 13:13:34 root Exp $ X Xprint "1..8\n"; X X@a = (1,2,3,4,5,6,7,8,9,10,11,12); X Xwhile ($_ = shift(a)) { X if ($x = /4/../8/) { $z = $x; print "ok ", $x + 0, "\n"; } X $y .= /1/../2/; X} X Xif ($z eq '5E0') {print "ok 6\n";} else {print "not ok 6\n";} X Xif ($y eq '12E0123E0') {print "ok 7\n";} else {print "not ok 7\n";} X X@a = ('a','b','c','d','e','f','g'); X Xopen(of,'/etc/termcap'); Xwhile () { X (3 .. 5) && $foo .= $_; X} X$x = ($foo =~ y/\n/\n/); X Xif ($x eq 3) {print "ok 8\n";} else {print "not ok 8 $x:$foo:\n";} !STUFFY!FUNK! echo Extracting t/op.split sed >t/op.split <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.split,v 1.0 87/12/18 13:14:20 root Exp $ X Xprint "1..4\n"; X X$FS = ':'; X X$_ = 'a:b:c'; X X($a,$b,$c) = split($FS,$_); X Xif (join(';',$a,$b,$c) eq 'a;b;c') {print "ok 1\n";} else {print "not ok 1\n";} X X@ary = split(/:b:/); Xif (join("$_",@ary) eq 'aa:b:cc') {print "ok 2\n";} else {print "not ok 2\n";} X X$_ = "abc\n"; X@ary = split(//); Xif (join(".",@ary) eq "a.b.c.\n") {print "ok 3\n";} else {print "not ok 3\n";} X X$_ = "a:b:c::::"; X@ary = split(/:/); Xif (join(".",@ary) eq "a.b.c") {print "ok 4\n";} else {print "not ok 4\n";} !STUFFY!FUNK! echo Extracting t/cmd.mod sed >t/cmd.mod <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: cmd.mod,v 1.0 87/12/18 13:12:09 root Exp $ X Xprint "1..6\n"; X Xprint "ok 1\n" if 1; Xprint "not ok 1\n" unless 1; X Xprint "ok 2\n" unless 0; Xprint "not ok 2\n" if 0; X X1 && (print "not ok 3\n") if 0; X1 && (print "ok 3\n") if 1; X0 || (print "not ok 4\n") if 0; X0 || (print "ok 4\n") if 1; X X$x = 0; Xdo {$x[$x] = $x;} while ($x++) < 10; Xif (join(' ',@x) eq '0 1 2 3 4 5 6 7 8 9 10') { X print "ok 5\n"; X} else { X print "not ok 5\n"; X} X X$x = 15; X$x = 10 while $x < 10; Xif ($x == 15) {print "ok 6\n";} else {print "not ok 6\n";} !STUFFY!FUNK! echo Extracting t/README sed >t/README <<'!STUFFY!FUNK!' -e 's/X//' XThis is the perl test library. To run all the tests, just type 'TEST'. X XTo add new tests, just look at the current tests and do likewise. X XIf a test fails, run it by itself to see if it prints any informative Xdiagnostics. If not, modify the test to print informative diagnostics. XIf you put out extra lines with a '#' character on the front, you don't Xhave to worry about removing the extra print statements later since TEST Xignores lines beginning with '#'. X XIf you come up with new tests, send them to lwall@jpl-devvax.jpl.nasa.gov. !STUFFY!FUNK! echo Extracting t/op.magic sed >t/op.magic <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.magic,v 1.0 87/12/18 13:13:54 root Exp $ X Xprint "1..4\n"; X X$| = 1; # command buffering X X$ENV{'foo'} = 'hi there'; Xif (`echo \$foo` eq "hi there\n") {print "ok 1\n";} else {print "not ok 1\n";} X X$! = 0; Xopen(foo,'ajslkdfpqjsjfkslkjdflksd'); Xif ($! == 2) {print "ok 2\n";} else {print "not ok 2\n";} X X$SIG{'INT'} = 'ok3'; Xkill 2,$$; X$SIG{'INT'} = 'IGNORE'; Xkill 2,$$; Xprint "ok 4\n"; X$SIG{'INT'} = 'DEFAULT'; Xkill 2,$$; Xprint "not ok\n"; X Xsub ok3 { X print "ok 3\n" if pop(@_) eq 'INT'; X} !STUFFY!FUNK! echo Extracting t/comp.script sed >t/comp.script <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: comp.script,v 1.0 87/12/18 13:12:36 root Exp $ X Xprint "1..3\n"; X X$x = `./perl -e 'print "ok\n";'`; X Xif ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";} X Xopen(try,">Comp.script") || (die "Can't open temp file."); Xprint try 'print "ok\n";'; print try "\n"; Xclose try; X X$x = `./perl Comp.script`; X Xif ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";} X X$x = `./perl t/cmd.elsif <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: cmd.elsif,v 1.0 87/12/18 13:12:02 root Exp $ X Xsub foo { X if ($_[0] == 1) { X 1; X } X elsif ($_[0] == 2) { X 2; X } X elsif ($_[0] == 3) { X 3; X } X else { X 4; X } X} X Xprint "1..4\n"; X Xif (($x = do foo(1)) == 1) {print "ok 1\n";} else {print "not ok 1\n";} Xif (($x = do foo(2)) == 2) {print "ok 2\n";} else {print "not ok 2\n";} Xif (($x = do foo(3)) == 3) {print "ok 3\n";} else {print "not ok 3\n";} Xif (($x = do foo(4)) == 4) {print "ok 4\n";} else {print "not ok 4\n";} !STUFFY!FUNK! echo Extracting t/comp.decl sed >t/comp.decl <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: comp.decl,v 1.0 87/12/18 13:12:27 root Exp $ X X# check to see if subroutine declarations work everwhere X Xsub one { X print "ok 1\n"; X} Xformat one = Xok 5 X. X Xprint "1..7\n"; X Xdo one(); Xdo two(); X Xsub two { X print "ok 2\n"; X} Xformat two = X@<<< X$foo X. X Xif ($x eq $x) { X sub three { X print "ok 3\n"; X } X do three(); X} X Xdo four(); X$~ = 'one'; Xwrite; X$~ = 'two'; X$foo = "ok 6"; Xwrite; X$~ = 'three'; Xwrite; X Xformat three = Xok 7 X. X Xsub four { X print "ok 4\n"; X} !STUFFY!FUNK! echo Extracting form.h sed >form.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: form.h,v 1.0 87/12/18 13:05:10 root Exp $ X * X * $Log: form.h,v $ X * Revision 1.0 87/12/18 13:05:10 root X * Initial revision X * X */ X X#define F_NULL 0 X#define F_LEFT 1 X#define F_RIGHT 2 X#define F_CENTER 3 X#define F_LINES 4 X Xstruct formcmd { X struct formcmd *f_next; X ARG *f_expr; X char *f_pre; X short f_presize; X short f_size; X char f_type; X char f_flags; X}; X X#define FC_CHOP 1 X#define FC_NOBLANK 2 X#define FC_MORE 4 X X#define Nullfcmd Null(FCMD*) !STUFFY!FUNK! echo Extracting t/op.append sed >t/op.append <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.append,v 1.0 87/12/18 13:13:05 root Exp $ X Xprint "1..3\n"; X X$a = 'ab' . 'c'; # compile time X$b = 'def'; X X$c = $a . $b; Xprint "#1\t:$c: eq :abcdef:\n"; Xif ($c eq 'abcdef') {print "ok 1\n";} else {print "not ok 1\n";} X X$c .= 'xyz'; Xprint "#2\t:$c: eq :abcdefxyz:\n"; Xif ($c eq 'abcdefxyz') {print "ok 2\n";} else {print "not ok 2\n";} X X$_ = $a; X$_ .= $b; Xprint "#3\t:$_: eq :abcdef:\n"; Xif ($_ eq 'abcdef') {print "ok 3\n";} else {print "not ok 3\n";} !STUFFY!FUNK! echo Extracting t/base.lex sed >t/base.lex <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: base.lex,v 1.0 87/12/18 13:11:51 root Exp $ X Xprint "1..4\n"; X X$ # this is the register X= 'x'; X Xprint "#1 :$ : eq :x:\n"; Xif ($ eq 'x') {print "ok 1\n";} else {print "not ok 1\n";} X X$x = $#; # this is the register $# X Xif ($x eq '') {print "ok 2\n";} else {print "not ok 2\n";} X X$x = $#x; X Xif ($x eq '-1') {print "ok 3\n";} else {print "not ok 3\n";} X X$x = '\\'; # '; X Xif (length($x) == 1) {print "ok 4\n";} else {print "not ok 4\n";} !STUFFY!FUNK! echo Extracting t/cmd.for sed >t/cmd.for <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: cmd.for,v 1.0 87/12/18 13:12:05 root Exp $ X Xprint "1..2\n"; X Xfor ($i = 0; $i <= 10; $i++) { X $x[$i] = $i; X} X$y = $x[10]; Xprint "#1 :$y: eq :10:\n"; X$y = join(' ', @x); Xprint "#1 :$y: eq :0 1 2 3 4 5 6 7 8 9 10:\n"; Xif (join(' ', @x) eq '0 1 2 3 4 5 6 7 8 9 10') { X print "ok 1\n"; X} else { X print "not ok 1\n"; X} X X$i = $c = 0; Xfor (;;) { X $c++; X last if $i++ > 10; X} Xif ($c == 12) {print "ok 2\n";} else {print "not ok 2\n";} !STUFFY!FUNK! echo Extracting t/io.inplace sed >t/io.inplace <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl -i.bak X X# $Header: io.inplace,v 1.0 87/12/18 13:12:51 root Exp $ X Xprint "1..2\n"; X X@ARGV = ('.a','.b','.c'); X`echo foo | tee .a .b .c`; Xwhile (<>) { X s/foo/bar/; X} Xcontinue { X print; X} X Xif (`cat .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";} Xif (`cat .a.bak .b.bak .c.bak` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} X Xunlink '.a', '.b', '.c', '.a.bak', '.b.bak', '.c.bak'; !STUFFY!FUNK! echo Extracting t/op.int sed >t/op.int <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.int,v 1.0 87/12/18 13:13:43 root Exp $ X Xprint "1..4\n"; X X# compile time evaluation X Xif (int(1.234) == 1) {print "ok 1\n";} else {print "not ok 1\n";} X Xif (int(-1.234) == -1) {print "ok 2\n";} else {print "not ok 2\n";} X X# run time evaluation X X$x = 1.234; Xif (int($x) == 1) {print "ok 3\n";} else {print "not ok 3\n";} Xif (int(-$x) == -1) {print "ok 4\n";} else {print "not ok 4\n";} !STUFFY!FUNK! echo Extracting t/base.cond sed >t/base.cond <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: base.cond,v 1.0 87/12/18 13:11:41 root Exp $ X X# make sure conditional operators work X Xprint "1..4\n"; X X$x = '0'; X X$x eq $x && (print "ok 1\n"); X$x ne $x && (print "not ok 1\n"); X$x eq $x || (print "not ok 2\n"); X$x ne $x || (print "ok 2\n"); X X$x == $x && (print "ok 3\n"); X$x != $x && (print "not ok 3\n"); X$x == $x || (print "not ok 4\n"); X$x != $x || (print "ok 4\n"); !STUFFY!FUNK! echo Extracting t/io.print sed >t/io.print <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: io.print,v 1.0 87/12/18 13:12:55 root Exp $ X Xprint "1..11\n"; X Xprint stdout "ok 1\n"; Xprint "ok 2\n","ok 3\n","ok 4\n","ok 5\n"; X Xopen(foo,">-"); Xprint foo "ok 6\n"; X Xprintf "ok %d\n",7; Xprintf("ok %d\n",8); X X@a = ("ok %d%c",9,ord("\n")); Xprintf @a; X X$a[1] = 10; Xprintf stdout @a; X X$, = ' '; X$\ = "\n"; X Xprint "ok","11"; !STUFFY!FUNK! echo Extracting array.h sed >array.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: array.h,v 1.0 87/12/18 13:04:46 root Exp $ X * X * $Log: array.h,v $ X * Revision 1.0 87/12/18 13:04:46 root X * Initial revision X * X */ X Xstruct atbl { X STR **ary_array; X int ary_max; X int ary_fill; X}; X XSTR *afetch(); Xbool astore(); Xbool adelete(); XSTR *apop(); XSTR *ashift(); Xbool apush(); Xlong alen(); XARRAY *anew(); !STUFFY!FUNK! echo Extracting t/op.join sed >t/op.join <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.join,v 1.0 87/12/18 13:13:46 root Exp $ X Xprint "1..3\n"; X X@x = (1, 2, 3); Xif (join(':',@x) eq '1:2:3') {print "ok 1\n";} else {print "not ok 1\n";} X Xif (join('',1,2,3) eq '123') {print "ok 2\n";} else {print "not ok 2\n";} X Xif (join(':',split(/ /,"1 2 3")) eq '1:2:3') {print "ok 3\n";} else {print "not ok 3\n";} !STUFFY!FUNK! echo Extracting t/op.crypt sed >t/op.crypt <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.crypt,v 1.0 87/12/18 13:13:17 root Exp $ X Xprint "1..2\n"; X X# this evaluates entirely at compile time! Xif (crypt('uh','oh') eq 'ohPnjpYtoi1NU') {print "ok 1\n";} else {print "not ok 1\n";} X X# this doesn't. X$uh = 'uh'; Xif (crypt($uh,'oh') eq 'ohPnjpYtoi1NU') {print "ok 2\n";} else {print "not ok 2\n";} !STUFFY!FUNK! echo Extracting t/op.chop sed >t/op.chop <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.chop,v 1.0 87/12/18 13:13:11 root Exp $ X Xprint "1..2\n"; X X# optimized X X$_ = 'abc'; X$c = do foo(); Xif ($c . $_ eq 'cab') {print "ok 1\n";} else {print "not ok 1\n";} X X# unoptimized X X$_ = 'abc'; X$c = chop($_); Xif ($c . $_ eq 'cab') {print "ok 2\n";} else {print "not ok 2\n";} X Xsub foo { X chop; X} !STUFFY!FUNK! echo Extracting version.c sed >version.c <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: version.c,v 1.0 87/12/18 13:06:41 root Exp $ X * X * $Log: version.c,v $ X * Revision 1.0 87/12/18 13:06:41 root X * Initial revision X * X */ X X#include "patchlevel.h" X X/* Print out the version number. */ X Xversion() X{ X extern char rcsid[]; X X printf("%s\r\nPatch level: %d\r\n", rcsid, PATCHLEVEL); X} !STUFFY!FUNK! echo Extracting t/op.unshift sed >t/op.unshift <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.unshift,v 1.0 87/12/18 13:14:37 root Exp $ X Xprint "1..2\n"; X X@a = (1,2,3); X$cnt1 = unshift(a,0); X Xif (join(' ',@a) eq '0 1 2 3') {print "ok 1\n";} else {print "not ok 1\n";} X$cnt2 = unshift(a,3,2,1); Xif (join(' ',@a) eq '3 2 1 0 1 2 3') {print "ok 2\n";} else {print "not ok 2\n";} X X !STUFFY!FUNK! echo Extracting t/op.oct sed >t/op.oct <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.oct,v 1.0 87/12/18 13:13:57 root Exp $ X Xprint "1..3\n"; X Xif (oct('01234') == 01234) {print "ok 1\n";} else {print "not ok 1\n";} Xif (oct('0x1234') == 0x1234) {print "ok 2\n";} else {print "not ok 2\n";} Xif (hex('01234') == 0x1234) {print "ok 3\n";} else {print "not ok 3\n";} !STUFFY!FUNK! echo Extracting t/op.ord sed >t/op.ord <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.ord,v 1.0 87/12/18 13:14:01 root Exp $ X Xprint "1..2\n"; X X# compile time evaluation X Xif (ord('A') == 65) {print "ok 1\n";} else {print "not ok 1\n";} X X# run time evaluation X X$x = 'ABC'; Xif (ord($x) == 65) {print "ok 2\n";} else {print "not ok 2\n";} !STUFFY!FUNK! echo Extracting t/op.exec sed >t/op.exec <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.exec,v 1.0 87/12/18 13:13:26 root Exp $ X X$| = 1; # flush stdout Xprint "1..4\n"; X Xsystem "echo ok \\1"; # shell interpreted Xsystem "echo ok 2"; # split and directly called Xsystem "echo", "ok", "3"; # directly called X Xexec "echo","ok","4"; !STUFFY!FUNK! echo Extracting t/op.fork sed >t/op.fork <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.fork,v 1.0 87/12/18 13:13:37 root Exp $ X X$| = 1; Xprint "1..2\n"; X Xif ($cid = fork) { X sleep 2; X if ($result = (kill 9, $cid)) {print "ok 2\n";} else {print "not ok 2 $result\n";} X} Xelse { X $| = 1; X print "ok 1\n"; X sleep 10; X} !STUFFY!FUNK! echo Extracting t/base.if sed >t/base.if <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: base.if,v 1.0 87/12/18 13:11:45 root Exp $ X Xprint "1..2\n"; X X# first test to see if we can run the tests. X X$x = 'test'; Xif ($x eq $x) { print "ok 1\n"; } else { print "not ok 1\n";} Xif ($x ne $x) { print "not ok 2\n"; } else { print "ok 2\n";} !STUFFY!FUNK! echo Extracting t/base.pat sed >t/base.pat <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: base.pat,v 1.0 87/12/18 13:11:56 root Exp $ X Xprint "1..2\n"; X X# first test to see if we can run the tests. X X$_ = 'test'; Xif (/^test/) { print "ok 1\n"; } else { print "not ok 1\n";} Xif (/^foo/) { print "not ok 2\n"; } else { print "ok 2\n";} !STUFFY!FUNK! echo Extracting t/op.cond sed >t/op.cond <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.cond,v 1.0 87/12/18 13:13:14 root Exp $ X Xprint "1..4\n"; X Xprint 1 ? "ok 1\n" : "not ok 1\n"; # compile time Xprint 0 ? "not ok 2\n" : "ok 2\n"; X X$x = 1; Xprint $x ? "ok 3\n" : "not ok 3\n"; # run time Xprint !$x ? "not ok 4\n" : "ok 4\n"; !STUFFY!FUNK! echo Extracting t/op.sprintf sed >t/op.sprintf <<'!STUFFY!FUNK!' -e 's/X//' X#!./perl X X# $Header: op.sprintf,v 1.0 87/12/18 13:14:24 root Exp $ X Xprint "1..1\n"; X X$x = sprintf("%3s %-4s foo %5d%c%3.1f","hi",123,456,65,3.0999); Xif ($x eq ' hi 123 foo 456A3.1') {print "ok 1\n";} else {print "not ok 1\n";} !STUFFY!FUNK! echo Extracting EXTERN.h sed >EXTERN.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: EXTERN.h,v 1.0 87/12/18 13:02:26 root Exp $ X * X * $Log: EXTERN.h,v $ X * Revision 1.0 87/12/18 13:02:26 root X * Initial revision X * X */ X X#undef EXT X#define EXT extern X X#undef INIT X#define INIT(x) X X#undef DOINIT !STUFFY!FUNK! echo Extracting x2p/EXTERN.h sed >x2p/EXTERN.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: EXTERN.h,v 1.0 87/12/18 13:06:44 root Exp $ X * X * $Log: EXTERN.h,v $ X * Revision 1.0 87/12/18 13:06:44 root X * Initial revision X * X */ X X#undef EXT X#define EXT extern X X#undef INIT X#define INIT(x) X X#undef DOINIT !STUFFY!FUNK! echo Extracting INTERN.h sed >INTERN.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: INTERN.h,v 1.0 87/12/18 13:02:39 root Exp $ X * X * $Log: INTERN.h,v $ X * Revision 1.0 87/12/18 13:02:39 root X * Initial revision X * X */ X X#undef EXT X#define EXT X X#undef INIT X#define INIT(x) = x X X#define DOINIT !STUFFY!FUNK! echo Extracting x2p/INTERN.h sed >x2p/INTERN.h <<'!STUFFY!FUNK!' -e 's/X//' X/* $Header: INTERN.h,v 1.0 87/12/18 13:06:48 root Exp $ X * X * $Log: INTERN.h,v $ X * Revision 1.0 87/12/18 13:06:48 root X * Initial revision X * X */ X X#undef EXT X#define EXT X X#undef INIT X#define INIT(x) = x X X#define DOINIT !STUFFY!FUNK! echo Extracting Wishlist sed >Wishlist <<'!STUFFY!FUNK!' -e 's/X//' Xdate support Xcase statement Xioctl() support Xrandom numbers Xdirectory reading via <> !STUFFY!FUNK! echo "" echo "End of kit 10 (of 10)" cat /dev/null >kit10isdone config=true for iskit in 1 2 3 4 5 6 7 8 9 10; do if test -f kit${iskit}isdone; then echo "You have run kit ${iskit}." else echo "You still need to run kit ${iskit}." config=false fi done case $config in true) echo "You have run all your kits. Please read README and then type Configure." chmod 755 Configure ;; esac : Someone might mail this, so... exit