perl 3.0 beta kit [20/23]
Larry Wall
lwall at jato.Jpl.Nasa.Gov
Mon Sep 4 05:00:17 AEST 1989
#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 23 through sh. When all 23 kits have been run, read README.
echo "This is perl 3.0 kit 20 (of 23). If kit 20 is complete, the line"
echo '"'"End of kit 20 (of 23)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir eg/g eg lib t x2p 2>/dev/null
echo Extracting makelib.SH
sed >makelib.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
X: This forces SH files to create target in same directory as SH file.
X: This is so that make depend always knows where to find SH derivatives.
Xcase "$0" in
X*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
Xesac
Xecho "Extracting makelib (with variable substitutions)"
X: This section of the file will have variable substitutions done on it.
X: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
X: Protect any dollar signs and backticks that you do not want interpreted
X: by putting a backslash in front. You may delete these comments.
X$spitshell >makelib <<!GROK!THIS!
X#!/usr/bin/perl
X
X\$perlincl = '$privlib';
X!GROK!THIS!
X
X: In the following dollars and backticks do not need the extra backslash.
X$spitshell >>makelib <<'!NO!SUBS!'
X
Xchdir '/usr/include' || die "Can't cd /usr/include";
X
X%isatype = ('char',1,'short',1,'int',1,'long',1);
X
Xforeach $file (@ARGV) {
X print $file,"\n";
X if ($file =~ m|^(.*)/|) {
X $dir = $1;
X if (!-d "$perlincl/$dir") {
X mkdir("$perlincl/$dir",0777);
X }
X }
X open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
X open(OUT,">$perlincl/$file") || die "Can't create $file: $!\n";
X while (<IN>) {
X chop;
X while (/\\$/) {
X chop;
X $_ .= <IN>;
X chop;
X }
X if (s:/\*:\200:g) {
X s:\*/:\201:g;
X s/\200[^\201]*\201//g; # delete single line comments
X if (s/\200.*//) { # begin multi-line comment?
X $_ .= '/*';
X $_ .= <IN>;
X redo;
X }
X }
X if (s/^#\s*//) {
X if (s/^define\s+(\w+)//) {
X $name = $1;
X $new = '';
X s/\s+$//;
X if (s/^\(([\w,\s]*)\)//) {
X $args = $1;
X if ($args ne '') {
X foreach $arg (split(/,\s*/,$args)) {
X $curargs{$arg} = 1;
X }
X $args =~ s/\b(\w)/\$$1/g;
X $args = "local($args) = \@_;\n$t ";
X }
X s/^\s+//;
X do expr();
X $new =~ s/(["\\])/\\$1/g;
X if ($t ne '') {
X $new =~ s/(['\\])/\\$1/g;
X print OUT $t,
X "eval 'sub $name {\n$t ${args}eval \"$new\";\n$t}';\n";
X }
X else {
X print OUT "sub $name {\n ${args}eval \"$new\";\n}\n";
X }
X %curargs = ();
X }
X else {
X s/^\s+//;
X do expr();
X $new = 1 if $new eq '';
X if ($t ne '') {
X $new =~ s/(['\\])/\\$1/g;
X print OUT $t,"eval 'sub $name {",$new,";}';\n";
X }
X else {
X print OUT $t,"sub $name {",$new,";}\n";
X }
X }
X }
X elsif (/^include <(.*)>/) {
X print OUT $t,"do '$1' || die \"Can't include $1: \$!\";\n";
X }
X elsif (/^ifdef\s+(\w+)/) {
X print OUT $t,"if (defined &$1) {\n";
X $tab += 4;
X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
X }
X elsif (/^ifndef\s+(\w+)/) {
X print OUT $t,"if (!defined &$1) {\n";
X $tab += 4;
X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
X }
X elsif (s/^if\s+//) {
X $new = '';
X do expr();
X print OUT $t,"if ($new) {\n";
X $tab += 4;
X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
X }
X elsif (s/^elif\s+//) {
X $new = '';
X do expr();
X $tab -= 4;
X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
X print OUT $t,"}\n${t}elsif ($new) {\n";
X $tab += 4;
X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
X }
X elsif (/^else/) {
X $tab -= 4;
X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
X print OUT $t,"}\n${t}else {\n";
X $tab += 4;
X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
X }
X elsif (/^endif/) {
X $tab -= 4;
X $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
X print OUT $t,"}\n";
X }
X }
X }
X print OUT "1;\n";
X}
X
Xsub expr {
X while ($_ ne '') {
X s/^(\s+)// && do {$new .= ' '; next;};
X s/^(0x[0-9a-fA-F]+)// && do {$new .= $1; next;};
X s/^(\d+)// && do {$new .= $1; next;};
X s/^("(\\"|[^"])*")// && do {$new .= $1; next;};
X s/^'((\\"|[^"])*)'// && do {
X if ($curargs{$1}) {
X $new .= "ord('\$$1')";
X }
X else {
X $new .= "ord('$1')";
X }
X next;
X };
X s/^(struct\s+\w+)// && do {$new .= "'$1'"; next;};
X s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
X $new .= '$sizeof';
X next;
X };
X s/^([_a-zA-Z]\w*)// && do {
X $id = $1;
X if ($curargs{$id}) {
X $new .= '$' . $id;
X }
X elsif ($id eq 'defined') {
X $new .= 'defined';
X }
X elsif (/^\(/) {
X s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/; # cheat
X $new .= "&$id";
X }
X elsif ($isatype{$id}) {
X $new .= "'$id'";
X }
X else {
X $new .= '&' . $id;
X }
X next;
X };
X s/^(.)// && do {$new .= $1; next;};
X }
X}
X!NO!SUBS!
Xchmod 755 makelib
X$eunicefix makelib
!STUFFY!FUNK!
echo Extracting str.h
sed >str.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: str.h,v 2.0.1.3 88/11/19 00:22:40 lwall Locked $
X *
X * Copyright (c) 1989, Larry Wall
X *
X * You may distribute under the terms of the GNU General Public License
X * as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log: str.h,v $
X */
X
Xstruct string {
X char * str_ptr; /* pointer to malloced string */
X union {
X double str_nval; /* numeric value, if any */
X STAB *str_stab; /* magic stab for magic "key" string */
X long str_useful; /* is this search optimization effective? */
X ARG *str_args; /* list of args for interpreted string */
X HASH *str_hash; /* string represents an assoc array (stab?) */
X ARRAY *str_array; /* string represents an array */
X } str_u;
X int str_len; /* allocated size */
X int str_cur; /* length of str_ptr as a C string */
X STR *str_magic; /* while free, link to next free str */
X /* while in use, ptr to "key" for magic items */
X char str_pok; /* state of str_ptr */
X char str_nok; /* state of str_nval */
X unsigned char str_rare; /* used by search strings */
X unsigned char str_state; /* one of SS_* below */
X /* also used by search strings for backoff */
X#ifdef TAINT
X bool str_tainted; /* 1 if possibly under control of $< */
X#endif
X};
X
Xstruct stab { /* should be identical, except for str_ptr */
X STBP * str_ptr; /* pointer to malloced string */
X union {
X double str_nval; /* numeric value, if any */
X STAB *str_stab; /* magic stab for magic "key" string */
X long str_useful; /* is this search optimization effective? */
X ARG *str_args; /* list of args for interpreted string */
X HASH *str_hash; /* string represents an assoc array (stab?) */
X ARRAY *str_array; /* string represents an array */
X } str_u;
X int str_len; /* allocated size */
X int str_cur; /* length of str_ptr as a C string */
X STR *str_magic; /* while free, link to next free str */
X /* while in use, ptr to "key" for magic items */
X char str_pok; /* state of str_ptr */
X char str_nok; /* state of str_nval */
X unsigned char str_rare; /* used by search strings */
X unsigned char str_state; /* one of SS_* below */
X /* also used by search strings for backoff */
X#ifdef TAINT
X bool str_tainted; /* 1 if possibly under control of $< */
X#endif
X};
X
X/* some extra info tacked to some lvalue strings */
X
Xstruct lstring {
X struct string lstr;
X int lstr_offset;
X int lstr_len;
X};
X
X/* These are the values of str_pok: */
X#define SP_VALID 1 /* str_ptr is valid */
X#define SP_FBM 2 /* string was compiled for fbm search */
X#define SP_STUDIED 4 /* string was studied */
X#define SP_CASEFOLD 8 /* case insensitive fbm search */
X#define SP_INTRP 16 /* string was compiled for interping */
X#define SP_TAIL 32 /* fbm string is tail anchored: /foo$/ */
X#define SP_MULTI 64 /* symbol table entry probably isn't a typo */
X
X#define Nullstr Null(STR*)
X
X/* These are the values of str_state: */
X#define SS_NORM 0 /* normal string */
X#define SS_INCR 1 /* normal string, incremented ptr */
X#define SS_SARY 2 /* array on save stack */
X#define SS_SHASH 3 /* associative array on save stack */
X#define SS_SINT 4 /* integer on save stack */
X#define SS_SLONG 5 /* long on save stack */
X#define SS_SSTRP 6 /* STR* on save stack */
X#define SS_SHPTR 7 /* HASH* on save stack */
X#define SS_SNSTAB 8 /* non-stab on save stack */
X#define SS_HASH 253 /* carrying an hash */
X#define SS_ARY 254 /* carrying an array */
X#define SS_FREE 255 /* in free list */
X/* str_state may have any value 0-255 when used to hold fbm pattern, in which */
X/* case it indicates offset to rarest character in screaminstr key */
X
X/* the following macro updates any magic values this str is associated with */
X
X#ifdef TAINT
X#define STABSET(x) \
X (x)->str_tainted |= tainted; \
X if ((x)->str_magic) \
X stabset((x)->str_magic,(x))
X#else
X#define STABSET(x) \
X if ((x)->str_magic) \
X stabset((x)->str_magic,(x))
X#endif
X
X#define STR_SSET(dst,src) if (dst != src) str_sset(dst,src)
X
XEXT STR **tmps_list;
XEXT int tmps_max INIT(-1);
XEXT int tmps_base INIT(-1);
X
Xchar *str_2ptr();
Xdouble str_2num();
XSTR *str_static();
XSTR *str_make();
XSTR *str_nmake();
XSTR *str_smake();
Xint str_cmp();
Xint str_eq();
Xvoid str_magic();
Xvoid str_insert();
!STUFFY!FUNK!
echo Extracting makedepend.SH
sed >makedepend.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 makedepend (with variable substitutions)"
X$spitshell >makedepend <<!GROK!THIS!
X$startsh
X# $Header: makedepend.SH,v 2.0.1.1 88/11/22 01:09:44 lwall Locked $
X#
X# $Log: makedepend.SH,v $
X
Xexport PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$)
X
Xcat='$cat'
Xccflags='$ccflags'
Xcp='$cp'
Xcpp='$cppstdin'
Xecho='$echo'
Xegrep='$egrep'
Xexpr='$expr'
Xmv='$mv'
Xrm='$rm'
Xsed='$sed'
Xsort='$sort'
Xtest='$test'
Xtr='$tr'
Xuniq='$uniq'
X!GROK!THIS!
X
X$spitshell >>makedepend <<'!NO!SUBS!'
X
X: the following weeds options from ccflags that are of no interest to cpp
Xcase "$ccflags" in
X'');;
X*) set X $ccflags
X ccflags=''
X for flag do
X case $flag in
X -D*|-I*) ccflags="$ccflags $flag";;
X esac
X done
X ;;
Xesac
X
X$cat /dev/null >.deptmp
X$rm -f *.c.c c/*.c.c
Xif test -f Makefile; then
X mf=Makefile
Xelse
X mf=makefile
Xfi
Xif test -f $mf; then
X defrule=`<$mf sed -n \
X -e '/^\.c\.o:.*;/{' \
X -e 's/\$\*\.c//' \
X -e 's/^[^;]*;[ ]*//p' \
X -e q \
X -e '}' \
X -e '/^\.c\.o: *$/{' \
X -e N \
X -e 's/\$\*\.c//' \
X -e 's/^.*\n[ ]*//p' \
X -e q \
X -e '}'`
Xfi
Xcase "$defrule" in
X'') defrule='$(CC) -c $(CFLAGS)' ;;
Xesac
X
Xmake clist || ($echo "Searching for .c files..."; \
X $echo *.c | $tr ' ' '\012' | $egrep -v '\*' >.clist)
Xfor file in `$cat .clist`; do
X# for file in `cat /dev/null`; do
X case "$file" in
X *.c) filebase=`basename $file .c` ;;
X *.y) filebase=`basename $file .c` ;;
X esac
X $echo "Finding dependencies for $filebase.o."
X $sed -n <$file >$file.c \
X -e "/^${filebase}_init(/q" \
X -e '/^#/{' \
X -e 's|/\*.*$||' \
X -e 's|\\$||' \
X -e p \
X -e '}'
X $cpp -I/usr/local/include -I. $ccflags $file.c | \
X $sed \
X -e '/^# *[0-9]/!d' \
X -e 's/^.*"\(.*\)".*$/'$filebase'.o: \1/' \
X -e 's|: \./|: |' \
X -e 's|\.c\.c|.c|' | \
X $uniq | $sort | $uniq >> .deptmp
Xdone
X
X$sed <Makefile >Makefile.new -e '1,/^# AUTOMATICALLY/!d'
X
Xmake shlist || ($echo "Searching for .SH files..."; \
X $echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist)
Xif $test -s .deptmp; then
X for file in `cat .shlist`; do
X $echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \
X /bin/sh $file >> .deptmp
X done
X $echo "Updating Makefile..."
X $echo "# If this runs make out of memory, delete /usr/include lines." \
X >> Makefile.new
X $sed 's|^\(.*\.o:\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
X >>Makefile.new
Xelse
X make hlist || ($echo "Searching for .h files..."; \
X $echo *.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist)
X $echo "You don't seem to have a proper C preprocessor. Using grep instead."
X $egrep '^#include ' `cat .clist` `cat .hlist` >.deptmp
X $echo "Updating Makefile..."
X <.clist $sed -n \
X -e '/\//{' \
X -e 's|^\(.*\)/\(.*\)\.c|\2.o: \1/\2.c; '"$defrule \1/\2.c|p" \
X -e d \
X -e '}' \
X -e 's|^\(.*\)\.c|\1.o: \1.c|p' >> Makefile.new
X <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed
X <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \
X $sed 's|^[^;]*/||' | \
X $sed -f .hsed >> Makefile.new
X <.deptmp $sed -n 's|c:#include <\(.*\)>.*$|o: /usr/include/\1|p' \
X >> Makefile.new
X <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \
X $sed -f .hsed >> Makefile.new
X <.deptmp $sed -n 's|h:#include <\(.*\)>.*$|h: /usr/include/\1|p' \
X >> Makefile.new
X for file in `$cat .shlist`; do
X $echo `$expr X$file : 'X\(.*\).SH`: $file config.sh \; \
X /bin/sh $file >> Makefile.new
X done
Xfi
X$rm -f Makefile.old
X$cp Makefile Makefile.old
X$cp Makefile.new Makefile
X$rm Makefile.new
X$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> Makefile
X$rm -f .deptmp `sed 's/\.c/.c.c/' .clist` .shlist .clist .hlist .hsed
X
X!NO!SUBS!
X$eunicefix makedepend
Xchmod +x makedepend
Xcase `pwd` in
X*SH)
X $rm -f ../makedepend
X ln makedepend ../makedepend
X ;;
Xesac
!STUFFY!FUNK!
echo Extracting t/op.subst
sed >t/op.subst <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.subst,v 2.0 88/06/05 00:14:49 root Exp $
X
Xprint "1..42\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$b = 'cd';
X($a = 'abcdef') =~ 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 $a\n";}
X
Xif (($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx')
X {print "ok 7\n";} else {print "not ok 7 $a\n";}
X
X$_ = 'ABACADA';
Xif (/a/i && s///gi && $_ eq 'BCD') {print "ok 8\n";} else {print "not ok 8 $_\n";}
X
X$_ = '\\' x 4;
Xif (length($_) == 4) {print "ok 9\n";} else {print "not ok 9\n";}
Xs/\\/\\\\/g;
Xif ($_ eq '\\' x 8) {print "ok 10\n";} else {print "not ok 10\n";}
X
X$_ = '\/' x 4;
Xif (length($_) == 8) {print "ok 11\n";} else {print "not ok 11\n";}
Xs/\//\/\//g;
Xif ($_ eq '\\//' x 4) {print "ok 12\n";} else {print "not ok 12\n";}
Xif (length($_) == 12) {print "ok 13\n";} else {print "not ok 13\n";}
X
X$_ = 'aaaXXXXbbb';
Xs/^a//;
Xprint $_ eq 'aaXXXXbbb' ? "ok 14\n" : "not ok 14\n";
X
X$_ = 'aaaXXXXbbb';
Xs/a//;
Xprint $_ eq 'aaXXXXbbb' ? "ok 15\n" : "not ok 15\n";
X
X$_ = 'aaaXXXXbbb';
Xs/^a/b/;
Xprint $_ eq 'baaXXXXbbb' ? "ok 16\n" : "not ok 16\n";
X
X$_ = 'aaaXXXXbbb';
Xs/a/b/;
Xprint $_ eq 'baaXXXXbbb' ? "ok 17\n" : "not ok 17\n";
X
X$_ = 'aaaXXXXbbb';
Xs/aa//;
Xprint $_ eq 'aXXXXbbb' ? "ok 18\n" : "not ok 18\n";
X
X$_ = 'aaaXXXXbbb';
Xs/aa/b/;
Xprint $_ eq 'baXXXXbbb' ? "ok 19\n" : "not ok 19\n";
X
X$_ = 'aaaXXXXbbb';
Xs/b$//;
Xprint $_ eq 'aaaXXXXbb' ? "ok 20\n" : "not ok 20\n";
X
X$_ = 'aaaXXXXbbb';
Xs/b//;
Xprint $_ eq 'aaaXXXXbb' ? "ok 21\n" : "not ok 21\n";
X
X$_ = 'aaaXXXXbbb';
Xs/bb//;
Xprint $_ eq 'aaaXXXXb' ? "ok 22\n" : "not ok 22\n";
X
X$_ = 'aaaXXXXbbb';
Xs/aX/y/;
Xprint $_ eq 'aayXXXbbb' ? "ok 23\n" : "not ok 23\n";
X
X$_ = 'aaaXXXXbbb';
Xs/Xb/z/;
Xprint $_ eq 'aaaXXXzbb' ? "ok 24\n" : "not ok 24\n";
X
X$_ = 'aaaXXXXbbb';
Xs/aaX.*Xbb//;
Xprint $_ eq 'ab' ? "ok 25\n" : "not ok 25\n";
X
X$_ = 'aaaXXXXbbb';
Xs/bb/x/;
Xprint $_ eq 'aaaXXXXxb' ? "ok 26\n" : "not ok 26\n";
X
X# now for some unoptimized versions of the same.
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/^a//;
Xprint $_ eq 'aaXXXXbbb' ? "ok 27\n" : "not ok 27\n";
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/a//;
Xprint $_ eq 'aaXXXXbbb' ? "ok 28\n" : "not ok 28\n";
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/^a/b/;
Xprint $_ eq 'baaXXXXbbb' ? "ok 29\n" : "not ok 29\n";
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/a/b/;
Xprint $_ eq 'baaXXXXbbb' ? "ok 30\n" : "not ok 30\n";
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/aa//;
Xprint $_ eq 'aXXXXbbb' ? "ok 31\n" : "not ok 31\n";
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/aa/b/;
Xprint $_ eq 'baXXXXbbb' ? "ok 32\n" : "not ok 32\n";
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/b$//;
Xprint $_ eq 'aaaXXXXbb' ? "ok 33\n" : "not ok 33\n";
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/b//;
Xprint $_ eq 'aaaXXXXbb' ? "ok 34\n" : "not ok 34\n";
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/bb//;
Xprint $_ eq 'aaaXXXXb' ? "ok 35\n" : "not ok 35\n";
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/aX/y/;
Xprint $_ eq 'aayXXXbbb' ? "ok 36\n" : "not ok 36\n";
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/Xb/z/;
Xprint $_ eq 'aaaXXXzbb' ? "ok 37\n" : "not ok 37\n";
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/aaX.*Xbb//;
Xprint $_ eq 'ab' ? "ok 38\n" : "not ok 38\n";
X
X$_ = 'aaaXXXXbbb';
X$x ne $x || s/bb/x/;
Xprint $_ eq 'aaaXXXXxb' ? "ok 39\n" : "not ok 39\n";
X
X$_ = 'abc123xyz';
Xs/\d+/$&*2/e; # yields 'abc246xyz'
Xprint $_ eq 'abc246xyz' ? "ok 40\n" : "not ok 40\n";
Xs/\d+/sprintf("%5d",$&)/e; # yields 'abc 246xyz'
Xprint $_ eq 'abc 246xyz' ? "ok 41\n" : "not ok 41\n";
Xs/\w/$& x 2/eg; # yields 'aabbcc 224466xxyyzz'
Xprint $_ eq 'aabbcc 224466xxyyzz' ? "ok 42\n" : "not ok 42\n";
!STUFFY!FUNK!
echo Extracting cmd.h
sed >cmd.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: cmd.h,v 2.0.1.1 88/11/22 01:05:06 lwall Locked $
X *
X * Copyright (c) 1989, Larry Wall
X *
X * You may distribute under the terms of the GNU General Public License
X * as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log: cmd.h,v $
X */
X
X#define C_NULL 0
X#define C_IF 1
X#define C_ELSE 2
X#define C_WHILE 3
X#define C_BLOCK 4
X#define C_EXPR 5
X#define C_NEXT 6
X#define C_ELSIF 7 /* temporary--turns into an IF + ELSE */
X#define C_CSWITCH 8 /* created by switch optimization in block_head() */
X#define C_NSWITCH 9 /* likewise */
X
X#ifdef DEBUGGING
X#ifndef DOINIT
Xextern char *cmdname[];
X#else
Xchar *cmdname[] = {
X "NULL",
X "IF",
X "ELSE",
X "WHILE",
X "BLOCK",
X "EXPR",
X "NEXT",
X "ELSIF",
X "CSWITCH",
X "NSWITCH",
X "10"
X};
X#endif
X#endif /* DEBUGGING */
X
X#define CF_OPTIMIZE 077 /* type of optimization */
X#define CF_FIRSTNEG 0100/* conditional is ($register NE 'string') */
X#define CF_NESURE 0200 /* if short doesn't match we're sure */
X#define CF_EQSURE 0400 /* if short does match we're sure */
X#define CF_COND 01000 /* test c_expr as conditional first, if not null. */
X /* Set for everything except do {} while currently */
X#define CF_LOOP 02000 /* loop on the c_expr conditional (loop modifiers) */
X#define CF_INVERT 04000 /* it's an "unless" or an "until" */
X#define CF_ONCE 010000 /* we've already pushed the label on the stack */
X#define CF_FLIP 020000 /* on a match do flipflop */
X
X#define CFT_FALSE 0 /* c_expr is always false */
X#define CFT_TRUE 1 /* c_expr is always true */
X#define CFT_REG 2 /* c_expr is a simple register */
X#define CFT_ANCHOR 3 /* c_expr is an anchored search /^.../ */
X#define CFT_STROP 4 /* c_expr is a string comparison */
X#define CFT_SCAN 5 /* c_expr is an unanchored search /.../ */
X#define CFT_GETS 6 /* c_expr is <filehandle> */
X#define CFT_EVAL 7 /* c_expr is not optimized, so call eval() */
X#define CFT_UNFLIP 8 /* 2nd half of range not optimized */
X#define CFT_CHOP 9 /* c_expr is a chop on a register */
X#define CFT_ARRAY 10 /* this is a foreach loop */
X#define CFT_INDGETS 11 /* c_expr is <$variable> */
X#define CFT_NUMOP 12 /* c_expr is a numeric comparison */
X#define CFT_CCLASS 13 /* c_expr must start with one of these characters */
X
X#ifdef DEBUGGING
X#ifndef DOINIT
Xextern char *cmdopt[];
X#else
Xchar *cmdopt[] = {
X "FALSE",
X "TRUE",
X "REG",
X "ANCHOR",
X "STROP",
X "SCAN",
X "GETS",
X "EVAL",
X "UNFLIP",
X "CHOP",
X "ARRAY",
X "INDGETS",
X "NUMOP",
X "CCLASS",
X "14"
X};
X#endif
X#endif /* DEBUGGING */
X
Xstruct acmd {
X STAB *ac_stab; /* a symbol table entry */
X ARG *ac_expr; /* any associated expression */
X};
X
Xstruct ccmd {
X CMD *cc_true; /* normal code to do on if and while */
X CMD *cc_alt; /* else cmd ptr or continue code */
X};
X
Xstruct scmd {
X CMD **sc_next; /* array of pointers to commands */
X short sc_offset; /* first value - 1 */
X short sc_max; /* last value + 1 */
X};
X
Xstruct cmd {
X CMD *c_next; /* the next command at this level */
X ARG *c_expr; /* conditional expression */
X CMD *c_head; /* head of this command list */
X STR *c_short; /* string to match as shortcut */
X STAB *c_stab; /* a symbol table entry, mostly for fp */
X SPAT *c_spat; /* pattern used by optimization */
X char *c_label; /* label for this construct */
X union ucmd {
X struct acmd acmd; /* normal command */
X struct ccmd ccmd; /* compound command */
X struct scmd scmd; /* switch command */
X } ucmd;
X short c_slen; /* len of c_short, if not null */
X short c_flags; /* optimization flags--see above */
X char *c_file; /* file the following line # is from */
X line_t c_line; /* line # of this command */
X char c_type; /* what this command does */
X};
X
X#define Nullcmd Null(CMD*)
X
XEXT CMD *main_root INIT(Nullcmd);
XEXT CMD *eval_root INIT(Nullcmd);
X
Xstruct compcmd {
X CMD *comp_true;
X CMD *comp_alt;
X};
X
Xvoid opt_arg();
Xvoid evalstatic();
Xint cmd_exec();
!STUFFY!FUNK!
echo Extracting ioctl.pl
sed >ioctl.pl <<'!STUFFY!FUNK!' -e 's/X//'
X$TIOCGSIZE = 0x40087468;
X$TIOCSSIZE = 0x80087467;
X$IOCPARM_MASK = 0x1fff;
X$IOCPARM_MAX = 0x200;
X$IOC_VOID = 0x20000000;
X$IOC_OUT = 0x40000000;
X$IOC_IN = 0x80000000;
X$IOC_INOUT = 0xC0000000;
X$IOC_DIRMASK = 0xe0000000;
X$TIOCGETD = 0x40047400;
X$TIOCSETD = 0x80047401;
X$TIOCHPCL = 0x20007402;
X$TIOCMODG = 0x40047403;
X$TIOCMODS = 0x80047404;
X$TIOCM_LE = 0001;
X$TIOCM_DTR = 0002;
X$TIOCM_RTS = 0004;
X$TIOCM_ST = 0010;
X$TIOCM_SR = 0020;
X$TIOCM_CTS = 0040;
X$TIOCM_CAR = 0100;
X$TIOCM_CD = 0x40;
X$TIOCM_RNG = 0200;
X$TIOCM_RI = 0x80;
X$TIOCM_DSR = 0400;
X$TIOCGETP = 0x40067408;
X$TIOCSETP = 0x80067409;
X$TIOCSETN = 0x8006740A;
X$TIOCEXCL = 0x2000740D;
X$TIOCNXCL = 0x2000740E;
X$TIOCFLUSH = 0x80047410;
X$TIOCSETC = 0x80067411;
X$TIOCGETC = 0x40067412;
X$TANDEM = 0x00000001;
X$CBREAK = 0x00000002;
X$LCASE = 0x00000004;
X$ECHO = 0x00000008;
X$CRMOD = 0x00000010;
X$RAW = 0x00000020;
X$ODDP = 0x00000040;
X$EVENP = 0x00000080;
X$ANYP = 0x000000c0;
X$NLDELAY = 0x00000300;
X$NL0 = 0x00000000;
X$NL1 = 0x00000100;
X$NL2 = 0x00000200;
X$NL3 = 0x00000300;
X$TBDELAY = 0x00000c00;
X$TAB0 = 0x00000000;
X$TAB1 = 0x00000400;
X$TAB2 = 0x00000800;
X$XTABS = 0x00000c00;
X$CRDELAY = 0x00003000;
X$CR0 = 0x00000000;
X$CR1 = 0x00001000;
X$CR2 = 0x00002000;
X$CR3 = 0x00003000;
X$VTDELAY = 0x00004000;
X$FF0 = 0x00000000;
X$FF1 = 0x00004000;
X$BSDELAY = 0x00008000;
X$BS0 = 0x00000000;
X$BS1 = 0x00008000;
X$ALLDELAY = 0xFF00;
X$CRTBS = 0x00010000;
X$PRTERA = 0x00020000;
X$CRTERA = 0x00040000;
X$TILDE = 0x00080000;
X$MDMBUF = 0x00100000;
X$LITOUT = 0x00200000;
X$TOSTOP = 0x00400000;
X$FLUSHO = 0x00800000;
X$NOHANG = 0x01000000;
X$L001000 = 0x02000000;
X$CRTKIL = 0x04000000;
X$PASS8 = 0x08000000;
X$CTLECH = 0x10000000;
X$PENDIN = 0x20000000;
X$DECCTQ = 0x40000000;
X$NOFLSH = 0x80000000;
X$TIOCLBIS = 0x8004747F;
X$TIOCLBIC = 0x8004747E;
X$TIOCLSET = 0x8004747D;
X$TIOCLGET = 0x4004747C;
X$LCRTBS = 0x1;
X$LPRTERA = 0x2;
X$LCRTERA = 0x4;
X$LTILDE = 0x8;
X$LMDMBUF = 0x10;
X$LLITOUT = 0x20;
X$LTOSTOP = 0x40;
X$LFLUSHO = 0x80;
X$LNOHANG = 0x100;
X$LCRTKIL = 0x400;
X$LPASS8 = 0x800;
X$LCTLECH = 0x1000;
X$LPENDIN = 0x2000;
X$LDECCTQ = 0x4000;
X$LNOFLSH = 0xFFFF8000;
X$TIOCSBRK = 0x2000747B;
X$TIOCCBRK = 0x2000747A;
X$TIOCSDTR = 0x20007479;
X$TIOCCDTR = 0x20007478;
X$TIOCGPGRP = 0x40047477;
X$TIOCSPGRP = 0x80047476;
X$TIOCSLTC = 0x80067475;
X$TIOCGLTC = 0x40067474;
X$TIOCOUTQ = 0x40047473;
X$TIOCSTI = 0x80017472;
X$TIOCNOTTY = 0x20007471;
X$TIOCPKT = 0x80047470;
X$TIOCPKT_DATA = 0x00;
X$TIOCPKT_FLUSHREAD = 0x01;
X$TIOCPKT_FLUSHWRITE = 0x02;
X$TIOCPKT_STOP = 0x04;
X$TIOCPKT_START = 0x08;
X$TIOCPKT_NOSTOP = 0x10;
X$TIOCPKT_DOSTOP = 0x20;
X$TIOCSTOP = 0x2000746F;
X$TIOCSTART = 0x2000746E;
X$TIOCMSET = 0x8004746D;
X$TIOCMBIS = 0x8004746C;
X$TIOCMBIC = 0x8004746B;
X$TIOCMGET = 0x4004746A;
X$TIOCREMOTE = 0x80047469;
X$TIOCGWINSZ = 0x40087468;
X$TIOCSWINSZ = 0x80087467;
X$TIOCUCNTL = 0x80047466;
X$TIOCSSOFTC = 0x80047465;
X$TIOCGSOFTC = 0x40047464;
X$TIOCSCARR = 0x80047463;
X$TIOCWCARR = 0x20007462;
X$OTTYDISC = 0;
X$NETLDISC = 1;
X$NTTYDISC = 2;
X$TABLDISC = 3;
X$SLIPDISC = 4;
X$FIOCLEX = 0x20006601;
X$FIONCLEX = 0x20006602;
X$FIONREAD = 0x4004667F;
X$FIONBIO = 0x8004667E;
X$FIOASYNC = 0x8004667D;
X$FIOSETOWN = 0x8004667C;
X$FIOGETOWN = 0x4004667B;
X$SIOCSHIWAT = 0x80047300;
X$SIOCGHIWAT = 0x40047301;
X$SIOCSLOWAT = 0x80047302;
X$SIOCGLOWAT = 0x40047303;
X$SIOCATMARK = 0x40047307;
X$SIOCSPGRP = 0x80047308;
X$SIOCGPGRP = 0x40047309;
X$SIOCADDRT = 0x8030720A;
X$SIOCDELRT = 0x8030720B;
X$SIOCSIFADDR = 0x8020690C;
X$SIOCGIFADDR = 0xC020690D;
X$SIOCSIFDSTADDR = 0x8020690E;
X$SIOCGIFDSTADDR = 0xC020690F;
X$SIOCSIFFLAGS = 0x80206910;
X$SIOCGIFFLAGS = 0xC0206911;
X$SIOCGIFBRDADDR = 0xC0206912;
X$SIOCSIFBRDADDR = 0x80206913;
X$SIOCGIFCONF = 0xC0086914;
X$SIOCGIFNETMASK = 0xC0206915;
X$SIOCSIFNETMASK = 0x80206916;
X$SIOCGIFMETRIC = 0xC0206917;
X$SIOCSIFMETRIC = 0x80206918;
X$SIOCSARP = 0x8024691E;
X$SIOCGARP = 0xC024691F;
X$SIOCDARP = 0x80246920;
!STUFFY!FUNK!
echo Extracting lib/validate.pl
sed >lib/validate.pl <<'!STUFFY!FUNK!' -e 's/X//'
X;# $Header$
X
X;# The validate routine takes a single multiline string consisting of
X;# lines containing a filename plus a file test to try on it. (The
X;# file test may also be a 'cd', causing subsequent relative filenames
X;# to be interpreted relative to that directory.) After the file test
X;# you may put '|| die' to make it a fatal error if the file test fails.
X;# The default is '|| warn'. The file test may optionally have a ! prepended
X;# to test for the opposite condition. If you do a cd and then list some
X;# relative filenames, you may want to indent them slightly for readability.
X;# If you supply your own "die" or "warn" message, you can use $file to
X;# interpolate the filename.
X
X;# Filetests may be bunched: -rwx tests for all of -r, -w and -x.
X;# Only the first failed test of the bunch will produce a warning.
X
X;# The routine returns the number of warnings issued.
X
X;# Usage:
X;# $warnings += do validate('
X;# /vmunix -e || die
X;# /boot -e || die
X;# /bin cd
X;# csh -ex
X;# csh !-ug
X;# sh -ex
X;# sh !-ug
X;# /usr -d || warn "What happened to $file?\n"
X;# ');
X
Xsub validate {
X local($file,$test,$warnings,$oldwarnings);
X foreach $check (split(/\n/,$_[0])) {
X next if $check =~ /^#/;
X next if $check =~ /^$/;
X ($file,$test) = split(' ',$check,2);
X if ($test =~ s/^(!?-)(\w{2,}\b)/$1Z/) {
X $testlist = $2;
X @testlist = split(//,$testlist);
X }
X else {
X @testlist = ('Z');
X }
X $oldwarnings = $warnings;
X foreach $one (@testlist) {
X $this = $test;
X $this =~ s/(-\w\b)/$1 \$file/g;
X $this =~ s/-Z/-$one/;
X $this .= ' || warn' unless $this =~ /\|\|/;
X $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || do valmess('$2','$1')/;
X $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g;
X eval $this;
X last if $warnings > $oldwarnings;
X }
X }
X $warnings;
X}
X
Xsub valmess {
X local($disposition,$this) = @_;
X $file = $cwd . '/' . $file unless $file =~ m|^/|;
X if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) {
X $neg = $1;
X $tmp = $2;
X $tmp eq 'r' && ($mess = "$file is not readable by uid $>.");
X $tmp eq 'w' && ($mess = "$file is not writable by uid $>.");
X $tmp eq 'x' && ($mess = "$file is not executable by uid $>.");
X $tmp eq 'o' && ($mess = "$file is not owned by uid $>.");
X $tmp eq 'R' && ($mess = "$file is not readable by you.");
X $tmp eq 'W' && ($mess = "$file is not writable by you.");
X $tmp eq 'X' && ($mess = "$file is not executable by you.");
X $tmp eq 'O' && ($mess = "$file is not owned by you.");
X $tmp eq 'e' && ($mess = "$file does not exist.");
X $tmp eq 'z' && ($mess = "$file does not have zero size.");
X $tmp eq 's' && ($mess = "$file does not have non-zero size.");
X $tmp eq 'f' && ($mess = "$file is not a plain file.");
X $tmp eq 'd' && ($mess = "$file is not a directory.");
X $tmp eq 'l' && ($mess = "$file is not a symbolic link.");
X $tmp eq 'p' && ($mess = "$file is not a named pipe (FIFO).");
X $tmp eq 'S' && ($mess = "$file is not a socket.");
X $tmp eq 'b' && ($mess = "$file is not a block special file.");
X $tmp eq 'c' && ($mess = "$file is not a character special file.");
X $tmp eq 'u' && ($mess = "$file does not have the setuid bit set.");
X $tmp eq 'g' && ($mess = "$file does not have the setgid bit set.");
X $tmp eq 'k' && ($mess = "$file does not have the sticky bit set.");
X $tmp eq 'T' && ($mess = "$file is not a text file.");
X $tmp eq 'B' && ($mess = "$file is not a binary file.");
X if ($neg eq '!') {
X $mess =~ s/ is not / should not be / ||
X $mess =~ s/ does not / should not / ||
X $mess =~ s/ not / /;
X }
X print stderr $mess,"\n";
X }
X else {
X $this =~ s/\$file/'$file'/g;
X print stderr "Can't do $this.\n";
X }
X if ($disposition eq 'die') { exit 1; }
X ++$warnings;
X}
X
X1;
!STUFFY!FUNK!
echo Extracting t/op.pat
sed >t/op.pat <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.pat,v 2.0.1.1 88/07/11 23:09:57 root Exp $
X
Xprint "1..43\n";
X
X$x = "abc\ndef\n";
X
Xif ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
Xif ($x !~ /^def/) {print "ok 2\n";} else {print "not ok 2\n";}
X
X$* = 1;
Xif ($x =~ /^def/) {print "ok 3\n";} else {print "not ok 3\n";}
X$* = 0;
X
X$_ = '123';
Xif (/^([0-9][0-9]*)/) {print "ok 4\n";} else {print "not ok 4\n";}
X
Xif ($x =~ /^xxx/) {print "not ok 5\n";} else {print "ok 5\n";}
Xif ($x !~ /^abc/) {print "not ok 6\n";} else {print "ok 6\n";}
X
Xif ($x =~ /def/) {print "ok 7\n";} else {print "not ok 7\n";}
Xif ($x !~ /def/) {print "not ok 8\n";} else {print "ok 8\n";}
X
Xif ($x !~ /.def/) {print "ok 9\n";} else {print "not ok 9\n";}
Xif ($x =~ /.def/) {print "not ok 10\n";} else {print "ok 10\n";}
X
Xif ($x =~ /\ndef/) {print "ok 11\n";} else {print "not ok 11\n";}
Xif ($x !~ /\ndef/) {print "not ok 12\n";} else {print "ok 12\n";}
X
X$_ = 'aaabbbccc';
Xif (/(a*b*)(c*)/ && $1 eq 'aaabbb' && $2 eq 'ccc') {
X print "ok 13\n";
X} else {
X print "not ok 13\n";
X}
Xif (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
X print "ok 14\n";
X} else {
X print "not ok 14\n";
X}
X
Xif (/a+b?c+/) {print "not ok 15\n";} else {print "ok 15\n";}
X
X$_ = 'aaabccc';
Xif (/a+b?c+/) {print "ok 16\n";} else {print "not ok 16\n";}
Xif (/a*b+c*/) {print "ok 17\n";} else {print "not ok 17\n";}
X
X$_ = 'aaaccc';
Xif (/a*b?c*/) {print "ok 18\n";} else {print "not ok 18\n";}
Xif (/a*b+c*/) {print "not ok 19\n";} else {print "ok 19\n";}
X
X$_ = 'abcdef';
Xif (/bcd|xyz/) {print "ok 20\n";} else {print "not ok 20\n";}
Xif (/xyz|bcd/) {print "ok 21\n";} else {print "not ok 21\n";}
X
Xif (m|bc/*d|) {print "ok 22\n";} else {print "not ok 22\n";}
X
Xif (/^$_$/) {print "ok 23\n";} else {print "not ok 23\n";}
X
X$* = 1; # test 3 only tested the optimized version--this one is for real
Xif ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
X$* = 0;
X
X$XXX{123} = 123;
X$XXX{234} = 234;
X$XXX{345} = 345;
X
X at XXX = ('ok 25','not ok 25', 'ok 26','not ok 26','not ok 27');
Xwhile ($_ = shift(XXX)) {
X ?(.*)? && (print $1,"\n");
X /not/ && reset;
X /not ok 26/ && reset 'X';
X}
X
Xwhile (($key,$val) = each(XXX)) {
X print "not ok 27\n";
X exit;
X}
X
Xprint "ok 27\n";
X
X'cde' =~ /[^ab]*/;
X'xyz' =~ //;
Xif ($& eq 'xyz') {print "ok 28\n";} else {print "not ok 28\n";}
X
X$foo = '[^ab]*';
X'cde' =~ /$foo/;
X'xyz' =~ //;
Xif ($& eq 'xyz') {print "ok 29\n";} else {print "not ok 29\n";}
X
X$foo = '[^ab]*';
X'cde' =~ /$foo/;
X'xyz' =~ /$null/;
Xif ($& eq 'xyz') {print "ok 30\n";} else {print "not ok 30\n";}
X
X$_ = 'abcdefghi';
X/def/; # optimized up to cmd
Xif ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 31\n";} else {print "not ok 31\n";}
X
X/cde/ + 0; # optimized only to spat
Xif ("$`:$&:$'" eq 'ab:cde:fghi') {print "ok 32\n";} else {print "not ok 32\n";}
X
X/[d][e][f]/; # not optimized
Xif ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 33\n";} else {print "not ok 33\n";}
X
X$_ = 'now is the {time for all} good men to come to.';
X/ {([^}]*)}/;
Xif ($1 eq 'time for all') {print "ok 34\n";} else {print "not ok 34 $1\n";}
X
X$_ = 'xxx {3,4} yyy zzz';
Xprint /( {3,4})/ ? "ok 35\n" : "not ok 35\n";
Xprint $1 eq ' ' ? "ok 36\n" : "not ok 36\n";
Xprint /( {4,})/ ? "not ok 37\n" : "ok 37\n";
Xprint /( {2,3}.)/ ? "ok 38\n" : "not ok 38\n";
Xprint $1 eq ' y' ? "ok 39\n" : "not ok 39\n";
Xprint /(y{2,3}.)/ ? "ok 40\n" : "not ok 40\n";
Xprint $1 eq 'yyy ' ? "ok 41\n" : "not ok 41\n";
Xprint /x {3,4}/ ? "not ok 42\n" : "ok 42\n";
Xprint /^xxx {3,4}/ ? "not ok 43\n" : "ok 43\n";
!STUFFY!FUNK!
echo Extracting x2p/Makefile.SH
sed >x2p/Makefile.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
Xcase "$mallocsrc" in
X'') ;;
X*) mallocsrc="../$mallocsrc";;
Xesac
Xecho "Extracting x2p/Makefile (with variable substitutions)"
Xcat >Makefile <<!GROK!THIS!
X# $Header: Makefile.SH,v 2.0.1.2 88/09/07 17:13:30 lwall Locked $
X#
X# $Log: Makefile.SH,v $
X# Revision 2.0.1.2 88/09/07 17:13:30 lwall
X# patch14: added redirection of stderr to /dev/null
X#
X# Revision 2.0.1.1 88/07/11 23:13:39 root
X# patch2: now expects more shift/reduce errors
X#
X# Revision 2.0 88/06/05 00:15:31 root
X# Baseline version 2.0.
X#
X#
X
XCC = $cc
Xbin = $bin
Xlib = $lib
Xmansrc = $mansrc
Xmanext = $manext
XCFLAGS = $ccflags -O
XLDFLAGS = $ldflags
XSMALL = $small
XLARGE = $large $split
Xmallocsrc = $mallocsrc
Xmallocobj = $mallocobj
X
Xlibs = $libnm -lm
X!GROK!THIS!
X
Xcat >>Makefile <<'!NO!SUBS!'
X
Xpublic = a2p s2p
X
Xprivate =
X
Xmanpages = a2p.man s2p.man
X
Xutil =
X
Xsh = Makefile.SH makedepend.SH
X
Xh = EXTERN.h INTERN.h config.h handy.h hash.h a2p.h str.h util.h
X
Xc = hash.c $(mallocsrc) str.c util.c walk.c
X
Xobj = hash.o $(mallocobj) str.o util.o walk.o
X
Xlintflags = -phbvxac
X
Xaddedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7
X
X# grrr
XSHELL = /bin/sh
X
X.c.o:
X $(CC) -c $(CFLAGS) $(LARGE) $*.c
X
Xall: $(public) $(private) $(util)
X touch all
X
Xa2p: $(obj) a2p.o
X $(CC) $(LDFLAGS) $(LARGE) $(obj) a2p.o $(libs) -o a2p
X
Xa2p.c: a2p.y
X @ echo Expect 208 shift/reduce conflicts...
X yacc a2p.y
X mv y.tab.c a2p.c
X
Xa2p.o: a2p.c a2py.c a2p.h EXTERN.h util.h INTERN.h handy.h ../config.h
X $(CC) -c $(CFLAGS) $(LARGE) a2p.c
X
X# if a .h file depends on another .h file...
X$(h):
X touch $@
Xinstall: a2p s2p
X# won't work with csh
X export PATH || exit 1
X - mv $(bin)/a2p $(bin)/a2p.old 2>/dev/null
X - mv $(bin)/s2p $(bin)/s2p.old 2>/dev/null
X - if test `pwd` != $(bin); then cp $(public) $(bin); fi
X cd $(bin); \
Xfor pub in $(public); do \
Xchmod +x `basename $$pub`; \
Xdone
X# chmod +x makedir
X# - ./makedir `filexp $(lib)`
X# - \
X#if test `pwd` != `filexp $(lib)`; then \
X#cp $(private) `filexp $(lib)`; \
X#fi
X# cd `filexp $(lib)`; \
X#for priv in $(private); do \
X#chmod +x `basename $$priv`; \
X#done
X - if test `pwd` != $(mansrc); then \
Xfor page in $(manpages); do \
Xcp $$page $(mansrc)/`basename $$page .man`.$(manext); \
Xdone; \
Xfi
X
Xclean:
X rm -f *.o
X
Xrealclean:
X rm -f a2p *.orig */*.orig *.o core $(addedbyconf)
X
X# The following lint has practically everything turned on. Unfortunately,
X# you have to wade through a lot of mumbo jumbo that can't be suppressed.
X# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message
X# for that spot.
X
Xlint:
X lint $(lintflags) $(defs) $(c) > a2p.fuzz
X
Xdepend: ../makedepend
X ../makedepend
X
Xclist:
X echo $(c) | tr ' ' '\012' >.clist
X
Xhlist:
X echo $(h) | tr ' ' '\012' >.hlist
X
Xshlist:
X echo $(sh) | tr ' ' '\012' >.shlist
X
X# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
X$(obj):
X @ echo "You haven't done a "'"make depend" yet!'; exit 1
Xmakedepend: makedepend.SH
X /bin/sh makedepend.SH
X!NO!SUBS!
X$eunicefix Makefile
Xcase `pwd` in
X*SH)
X $rm -f ../Makefile
X ln Makefile ../Makefile
X ;;
Xesac
!STUFFY!FUNK!
echo Extracting stab.h
sed >stab.h <<'!STUFFY!FUNK!' -e 's/X//'
X/* $Header: stab.h,v 2.0.1.1 88/11/19 00:20:26 lwall Locked $
X *
X * Copyright (c) 1989, Larry Wall
X *
X * You may distribute under the terms of the GNU General Public License
X * as specified in the README file that comes with the perl 3.0 kit.
X *
X * $Log: stab.h,v $
X */
X
Xstruct stabptrs {
X char stbp_magic[4];
X STR *stbp_val; /* scalar value */
X struct stio *stbp_io; /* filehandle value */
X FCMD *stbp_form; /* format value */
X ARRAY *stbp_array; /* array value */
X HASH *stbp_hash; /* associative array value */
X SUBR *stbp_sub; /* subroutine value */
X int stbp_lastexpr; /* used by nothing_in_common() */
X line_t stbp_line; /* line first declared at (for -w) */
X char stbp_flags;
X};
X
X#define stab_magic(stab) ((STBP*)(stab->str_ptr))->stbp_magic
X#define stab_val(stab) ((STBP*)(stab->str_ptr))->stbp_val
X#define stab_io(stab) ((STBP*)(stab->str_ptr))->stbp_io
X#define stab_form(stab) ((STBP*)(stab->str_ptr))->stbp_form
X#define stab_xarray(stab) ((STBP*)(stab->str_ptr))->stbp_array
X#define stab_array(stab) (((STBP*)(stab->str_ptr))->stbp_array ? \
X ((STBP*)(stab->str_ptr))->stbp_array : \
X ((STBP*)(aadd(stab)->str_ptr))->stbp_array)
X#define stab_xhash(stab) ((STBP*)(stab->str_ptr))->stbp_hash
X#define stab_hash(stab) (((STBP*)(stab->str_ptr))->stbp_hash ? \
X ((STBP*)(stab->str_ptr))->stbp_hash : \
X ((STBP*)(hadd(stab)->str_ptr))->stbp_hash)
X#define stab_sub(stab) ((STBP*)(stab->str_ptr))->stbp_sub
X#define stab_lastexpr(stab) ((STBP*)(stab->str_ptr))->stbp_lastexpr
X#define stab_line(stab) ((STBP*)(stab->str_ptr))->stbp_line
X#define stab_flags(stab) ((STBP*)(stab->str_ptr))->stbp_flags
X#define stab_name(stab) (stab->str_magic->str_ptr)
X
X#define SF_VMAGIC 1 /* call routine to dereference STR val */
X#define SF_MULTI 2 /* seen more than once */
X
Xstruct stio {
X FILE *ifp; /* ifp and ofp are normally the same */
X FILE *ofp; /* but sockets need separate streams */
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 short subprocess; /* -| or |- */
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
Xstruct sub {
X CMD *cmd;
X char *filename;
X long depth; /* >= 2 indicates recursive call */
X ARRAY *tosave;
X};
X
X#define Nullstab Null(STAB*)
X
X#define STAB_STR(s) (tmpstab = (s), stab_flags(tmpstab) & SF_VMAGIC ? stab_str(stab_val(tmpstab)->str_magic) : stab_val(tmpstab))
X#define STAB_GET(s) (tmpstab = (s), str_get(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab)))
X#define STAB_GNUM(s) (tmpstab = (s), str_gnum(stab_flags(tmpstab) & SF_VMAGIC ? stab_str(tmpstab->str_magic) : stab_val(tmpstab)))
X
XEXT STAB *tmpstab;
X
XEXT STAB *stab_index[128];
X
XEXT unsigned short statusvalue;
X
XSTAB *aadd();
XSTAB *hadd();
!STUFFY!FUNK!
echo Extracting eg/g/gsh
sed >eg/g/gsh <<'!STUFFY!FUNK!' -e 's/X//'
X#!/bin/perl
X
X# $Header: gsh,v 2.0 88/06/05 00:17:20 root Exp $
X
X# Do rsh globally--see man page
X
X$SIG{'QUIT'} = 'quit'; # install signal handler for SIGQUIT
X
Xsub getswitches {
X while ($ARGV[0] =~ /^-/) { # parse switches
X $ARGV[0] =~ /^-h/ && ($showhost++,$silent++,shift,next);
X $ARGV[0] =~ /^-s/ && ($silent++,shift,next);
X $ARGV[0] =~ /^-d/ && ($dodist++,shift,next);
X $ARGV[0] =~ /^-n/ && ($n=' -n',shift,next);
X $ARGV[0] =~ /^-l/ && ($l=' -l ' . $ARGV[1],shift,shift,next);
X last;
X }
X}
X
Xdo getswitches(); # get any switches before class
X$systype = shift; # get name representing set of hosts
Xdo getswitches(); # same switches allowed after class
X
Xif ($dodist) { # distribute input over all rshes?
X `cat >/tmp/gsh$$`; # get input into a handy place
X $dist = " </tmp/gsh$$"; # each rsh takes input from there
X}
X
X$cmd = join(' ', at ARGV); # remaining args constitute the command
X$cmd =~ s/'/'"'"'/g; # quote any embedded single quotes
X
X$one_of_these = ":$systype:"; # prepare to expand "macros"
X$one_of_these =~ s/\+/:/g; # we hope to end up with list of
X$one_of_these =~ s/-/:-/g; # colon separated attributes
X
X at ARGV = ();
Xpush(@ARGV,'.grem') if -f '.grem';
Xpush(@ARGV,'.ghosts') if -f '.ghosts';
Xpush(@ARGV,'/etc/ghosts');
X
X$remainder = '';
X
Xline: while (<>) { # for each line of ghosts
X
X s/[ \t]*\n//; # trim trailing whitespace
X if (!$_ || /^#/) { # skip blank line or comment
X next line;
X }
X
X if (/^(\w+)=(.+)/) { # a macro line?
X $name = $1; $repl = $2;
X $repl =~ s/\+/:/g;
X $repl =~ s/-/:-/g;
X $one_of_these =~ s/:$name:/:$repl:/; # do expansion in "wanted" list
X $repl =~ s/:/:-/g;
X $one_of_these =~ s/:-$name:/:-$repl:/;
X next line;
X }
X
X # we have a normal line
X
X @attr = split(' '); # a list of attributes to match against
X # which we put into an array
X $host = $attr[0]; # the first attribute is the host name
X if ($showhost) {
X $showhost = "$host:\t";
X }
X
X $wanted = 0;
X foreach $attr (@attr) { # iterate over attribute array
X $wanted++ if index($one_of_these,":$attr:") >= 0;
X $wanted = -9999 if index($one_of_these,":-$attr:") >= 0;
X }
X if ($wanted > 0) {
X print "rsh $host$l$n '$cmd'\n" unless $silent;
X $SIG{'INT'} = 'DEFAULT';
X if (open(pipe,"rsh $host$l$n '$cmd'$dist 2>&1|")) { # start an rsh
X $SIG{'INT'} = 'cont';
X for ($iter=0; <pipe>; $iter++) {
X unless ($iter) {
X $remainder .= "$host+"
X if /Connection timed out|Permission denied/;
X }
X print $showhost,$_;
X }
X close(pipe);
X } else {
X print "(Can't execute rsh: $!)\n";
X $SIG{'INT'} = 'cont';
X }
X }
X}
X
Xunlink "/tmp/gsh$$" if $dodist;
X
Xif ($remainder) {
X chop($remainder);
X open(grem,">.grem") || (printf stderr "Can't make a .grem file: $!\n");
X print grem 'rem=', $remainder, "\n";
X close(grem);
X print 'rem=', $remainder, "\n";
X}
X
X# here are a couple of subroutines that serve as signal handlers
X
Xsub cont {
X print "\rContinuing...\n";
X $remainder .= "$host+";
X}
X
Xsub quit {
X $| = 1;
X print "\r";
X $SIG{'INT'} = '';
X kill 2, $$;
X}
!STUFFY!FUNK!
echo Extracting t/re_tests
sed >t/re_tests <<'!STUFFY!FUNK!' -e 's/X//'
Xabc abc y $& abc
Xabc xbc n - -
Xabc axc n - -
Xabc abx n - -
Xabc xabcy y $& abc
Xabc ababc y $& abc
Xab*c abc y $& abc
Xab*bc abc y $& abc
Xab*bc abbc y $& abbc
Xab*bc abbbbc y $& abbbbc
Xab{0,}bc abbbbc y $& abbbbc
Xab+bc abbc y $& abbc
Xab+bc abc n - -
Xab+bc abq n - -
Xab{1,}bc abq n - -
Xab+bc abbbbc y $& abbbbc
Xab{1,}bc abbbbc y $& abbbbc
Xab{1,3}bc abbbbc y $& abbbbc
Xab{3,4}bc abbbbc y $& abbbbc
Xab{4,5}bc abbbbc n - -
Xab?bc abbc y $& abbc
Xab?bc abc y $& abc
Xab{0,1}bc abc y $& abc
Xab?bc abbbbc n - -
Xab?c abc y $& abc
Xab{0,1}c abc y $& abc
X^abc$ abc y $& abc
X^abc$ abcc n - -
X^abc abcc y $& abc
X^abc$ aabc n - -
Xabc$ aabc y $& abc
X^ abc y $&
X$ abc y $&
Xa.c abc y $& abc
Xa.c axc y $& axc
Xa.*c axyzc y $& axyzc
Xa.*c axyzd n - -
Xa[bc]d abc n - -
Xa[bc]d abd y $& abd
Xa[b-d]e abd n - -
Xa[b-d]e ace y $& ace
Xa[b-d] aac y $& ac
Xa[-b] a- y $& a-
Xa[b-] a- y $& a-
Xa[b-a] - c - -
Xa[]b - c - -
Xa[ - c - -
Xa] a] y $& a]
Xa[]]b a]b y $& a]b
Xa[^bc]d aed y $& aed
Xa[^bc]d abd n - -
Xa[^-b]c adc y $& adc
Xa[^-b]c a-c n - -
Xa[^]b]c a]c n - -
Xa[^]b]c adc y $& adc
Xab|cd abc y $& ab
Xab|cd abcd y $& ab
X()ef def y $&-$1 ef-
X()* - c - -
X*a - c - -
X^* - c - -
X$* - c - -
X(*)b - c - -
X$b b n - -
Xa\ - c - -
Xa\(b a(b y $&-$1 a(b-
Xa\(*b ab y $& ab
Xa\(*b a((b y $& a((b
Xa\\b a\b y $& a\b
Xabc) - c - -
X(abc - c - -
X((a)) abc y $&-$1-$2 a-a-a
X(a)b(c) abc y $&-$1-$2 abc-a-c
Xa+b+c aabbabc y $& abc
Xa{1,}b{1,}c aabbabc y $& abc
Xa** - c - -
Xa*? - c - -
X(a*)* - c - -
X(a*)+ - c - -
X(a|)* - c - -
X(a*|b)* - c - -
X(a+|b)* ab y $&-$1 ab-b
X(a+|b){0,} ab y $&-$1 ab-b
X(a+|b)+ ab y $&-$1 ab-b
X(a+|b){1,} ab y $&-$1 ab-b
X(a+|b)? ab y $&-$1 a-a
X(a+|b){0,1} ab y $&-$1 a-a
X(^)* - c - -
X(ab|)* - c - -
X)( - c - -
X[^ab]* cde y $& cde
Xabc n - -
Xa* y $&
X([abc])*d abbbcd y $&-$1 abbbcd-c
X([abc])*bcd abcd y $&-$1 abcd-a
Xa|b|c|d|e e y $& e
X(a|b|c|d|e)f ef y $&-$1 ef-e
X((a*|b))* - c - -
Xabcd*efg abcdefg y $& abcdefg
Xab* xabyabbbz y $& ab
Xab* xayabbbz y $& a
X(ab|cd)e abcde y $&-$1 cde-cd
X[abhgefdc]ij hij y $& hij
X^(ab|cd)e abcde n x$1y xy
X(abc|)ef abcdef y $&-$1 ef-
X(a|b)c*d abcd y $&-$1 bcd-b
X(ab|ab*)bc abc y $&-$1 abc-a
Xa([bc]*)c* abc y $&-$1 abc-bc
Xa([bc]*)(c*d) abcd y $&-$1-$2 abcd-bc-d
Xa([bc]+)(c*d) abcd y $&-$1-$2 abcd-bc-d
Xa([bc]*)(c+d) abcd y $&-$1-$2 abcd-b-cd
Xa[bcd]*dcdcde adcdcde y $& adcdcde
Xa[bcd]+dcdcde adcdcde n - -
X(ab|a)b*c abc y $&-$1 abc-ab
X((a)(b)c)(d) abcd y $1-$2-$3-$4 abc-a-b-d
X[a-zA-Z_][a-zA-Z0-9_]* alpha y $& alpha
X^a(bc+|b[eh])g|.h$ abh y $&-$1 bh-
X(bc+d$|ef*g.|h?i(j|k)) effgz y $&-$1-$2 effgz-effgz-
X(bc+d$|ef*g.|h?i(j|k)) ij y $&-$1-$2 ij-ij-j
X(bc+d$|ef*g.|h?i(j|k)) effg n - -
X(bc+d$|ef*g.|h?i(j|k)) bcdd n - -
X(bc+d$|ef*g.|h?i(j|k)) reffgz y $&-$1-$2 effgz-effgz-
X((((((((((a)))))))))) - c - -
X(((((((((a))))))))) a y $& a
Xmultiple words of text uh-uh n - -
Xmultiple words multiple words, yeah y $& multiple words
X(.*)c(.*) abcde y $&-$1-$2 abcde-ab-de
X\((.*), (.*)\) (a, b) y ($2, $1) (b, a)
X[k] ab n - -
Xabcd abcd y $&-\$&-\\$& abcd-$&-\abcd
Xa(bc)d abcd y $1-\$1-\\$1 bc-$1-\bc
Xa[-]?c ac y $& ac
X(abc)\1 abcabc y $1 abc
X([a-c]*)\1 abcabc y $1 abc
!STUFFY!FUNK!
echo Extracting t/op.substr
sed >t/op.substr <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header$
X
Xprint "1..19\n";
X
X$a = 'abcdefxyz';
X
Xprint (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n");
Xprint (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n");
Xprint (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n");
Xprint (substr($a,999,999) eq '' ? "ok 4\n" : "not ok 4\n");
Xprint (substr($a,6,-1) eq '' ? "ok 5\n" : "not ok 5\n");
Xprint (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n");
X
X$[ = 1;
X
Xprint (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n");
Xprint (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n");
Xprint (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n");
Xprint (substr($a,999,999) eq '' ? "ok 10\n" : "not ok 10\n");
Xprint (substr($a,7,-1) eq '' ? "ok 11\n" : "not ok 11\n");
Xprint (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n");
X
X$[ = 0;
X
Xsubstr($a,3,3) = 'XYZ';
Xprint $a eq 'abcXYZxyz' ? "ok 13\n" : "not ok 13\n";
Xsubstr($a,0,2) = '';
Xprint $a eq 'cXYZxyz' ? "ok 14\n" : "not ok 14\n";
Xy/a/a/;
Xsubstr($a,0,0) = 'ab';
Xprint $a eq 'abcXYZxyz' ? "ok 15\n" : "not ok 15 $a\n";
Xsubstr($a,0,0) = '12345678';
Xprint $a eq '12345678abcXYZxyz' ? "ok 16\n" : "not ok 16\n";
Xsubstr($a,-3,3) = 'def';
Xprint $a eq '12345678abcXYZdef' ? "ok 17\n" : "not ok 17\n";
Xsubstr($a,-3,3) = '<';
Xprint $a eq '12345678abcXYZ<' ? "ok 18\n" : "not ok 18\n";
Xsubstr($a,-1,1) = '12345678';
Xprint $a eq '12345678abcXYZ12345678' ? "ok 19\n" : "not ok 19\n";
X
!STUFFY!FUNK!
echo ""
echo "End of kit 20 (of 23)"
cat /dev/null >kit20isdone
run=''
config=''
for iskit in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23; do
if test -f kit${iskit}isdone; then
run="$run $iskit"
else
todo="$todo $iskit"
fi
done
case $todo in
'')
echo "You have run all your kits. Please read README and then type Configure."
chmod 755 Configure
;;
*) echo "You have run$run."
echo "You still need to run$todo."
;;
esac
: Someone might mail this, so...
exit
More information about the Alt.sources
mailing list