Path: utzoo!attcan!uunet!bbn.com!rsalz
From: rsalz@bbn.com (Rich Salz)
Newsgroups: comp.sources.unix
Subject: v15i103:  Perl, version 2, Part14/15
Message-ID: <997@fig.bbn.com>
Date: 13 Jul 88 04:19:24 GMT
Organization: BBN Laboratories Inc., Cambridge MA
Lines: 1962
Approved: rsalz@uunet.UU.NET

Submitted-by: Larry Wall 
Posting-number: Volume 15, Issue 103
Archive-name: perl2/part14

#! /bin/sh
# Make a new directory for the perl sources, cd to it, and run kits 1
# thru 15 through sh.  When all 15 kits have been run, read README.

echo "This is perl 2.0 kit 14 (of 15).  If kit 14 is complete, the line"
echo '"'"End of kit 14 (of 15)"'" will echo at the end.'
echo ""
export PATH || (echo "You didn't use sh, you clunch." ; kill $$)
mkdir eg eg/g eg/scan eg/van lib t x2p 2>/dev/null
echo Extracting t/op.auto
sed >t/op.auto <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.auto,v 2.0 88/06/05 00:13:19 root Exp $
X
Xprint "1..34\n";
X
X$x = 10000;
Xif (0 + ++$x - 1 == 10000) { print "ok 1\n";} else {print "not ok 1\n";}
Xif (0 + $x-- - 1 == 10000) { print "ok 2\n";} else {print "not ok 2\n";}
Xif (1 * $x == 10000) { print "ok 3\n";} else {print "not ok 3\n";}
Xif (0 + $x-- - 0 == 10000) { print "ok 4\n";} else {print "not ok 4\n";}
Xif (1 + $x == 10000) { print "ok 5\n";} else {print "not ok 5\n";}
Xif (1 + $x++ == 10000) { print "ok 6\n";} else {print "not ok 6\n";}
Xif (0 + $x == 10000) { print "ok 7\n";} else {print "not ok 7\n";}
Xif (0 + --$x + 1 == 10000) { print "ok 8\n";} else {print "not ok 8\n";}
Xif (0 + ++$x + 0 == 10000) { print "ok 9\n";} else {print "not ok 9\n";}
Xif ($x == 10000) { print "ok 10\n";} else {print "not ok 10\n";}
X
X$x[0] = 10000;
Xif (0 + ++$x[0] - 1 == 10000) { print "ok 11\n";} else {print "not ok 11\n";}
Xif (0 + $x[0]-- - 1 == 10000) { print "ok 12\n";} else {print "not ok 12\n";}
Xif (1 * $x[0] == 10000) { print "ok 13\n";} else {print "not ok 13\n";}
Xif (0 + $x[0]-- - 0 == 10000) { print "ok 14\n";} else {print "not ok 14\n";}
Xif (1 + $x[0] == 10000) { print "ok 15\n";} else {print "not ok 15\n";}
Xif (1 + $x[0]++ == 10000) { print "ok 16\n";} else {print "not ok 16\n";}
Xif (0 + $x[0] == 10000) { print "ok 17\n";} else {print "not ok 17\n";}
Xif (0 + --$x[0] + 1 == 10000) { print "ok 18\n";} else {print "not ok 18\n";}
Xif (0 + ++$x[0] + 0 == 10000) { print "ok 19\n";} else {print "not ok 19\n";}
Xif ($x[0] == 10000) { print "ok 20\n";} else {print "not ok 20\n";}
X
X$x{0} = 10000;
Xif (0 + ++$x{0} - 1 == 10000) { print "ok 21\n";} else {print "not ok 21\n";}
Xif (0 + $x{0}-- - 1 == 10000) { print "ok 22\n";} else {print "not ok 22\n";}
Xif (1 * $x{0} == 10000) { print "ok 23\n";} else {print "not ok 23\n";}
Xif (0 + $x{0}-- - 0 == 10000) { print "ok 24\n";} else {print "not ok 24\n";}
Xif (1 + $x{0} == 10000) { print "ok 25\n";} else {print "not ok 25\n";}
Xif (1 + $x{0}++ == 10000) { print "ok 26\n";} else {print "not ok 26\n";}
Xif (0 + $x{0} == 10000) { print "ok 27\n";} else {print "not ok 27\n";}
Xif (0 + --$x{0} + 1 == 10000) { print "ok 28\n";} else {print "not ok 28\n";}
Xif (0 + ++$x{0} + 0 == 10000) { print "ok 29\n";} else {print "not ok 29\n";}
Xif ($x{0} == 10000) { print "ok 30\n";} else {print "not ok 30\n";}
X
X# test magical autoincrement
X
Xif (++($foo = '99') eq '100') {print "ok 31\n";} else {print "not ok 31\n";}
Xif (++($foo = 'a0') eq 'a1') {print "ok 32\n";} else {print "not ok 32\n";}
Xif (++($foo = 'Az') eq 'Ba') {print "ok 33\n";} else {print "not ok 33\n";}
Xif (++($foo = 'zz') eq 'aaa') {print "ok 34\n";} else {print "not ok 34\n";}
!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 88/06/05 00:14:20 root Exp $
X
Xprint "1..30\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@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";}
!STUFFY!FUNK!
echo Extracting eg/g/gcp
sed >eg/g/gcp <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: gcp,v 2.0 88/06/05 00:17:02 root Exp $
X
X# Here is a script to do global rcps.  See man page.
X
X$#ARGV >= 1 || die "Not enough arguments.\n";
X
Xif ($ARGV[0] eq '-r') {
X    $rcp = 'rcp -r';
X    shift;
X} else {
X    $rcp = 'rcp';
X}
X$args = $rcp;
X$dest = $ARGV[$#ARGV];
X
X$SIG{'QUIT'} = 'CLEANUP';
X$SIG{'INT'} = 'CONT';
X
Xwhile ($arg = shift) {
X    if ($arg =~ /^([-a-zA-Z0-9_+]+):/) {
X	if ($systype && $systype ne $1) {
X	    die "Can't mix system type specifers ($systype vs $1).\n";
X	}
X	$#ARGV < 0 || $arg !~ /:$/ || die "No source file specified.\n";
X	$systype = $1;
X	$args .= " $arg";
X    } else {
X	if ($#ARGV >= 0) {
X	    if ($arg =~ /^[\/~]/) {
X		$arg =~ /^(.*)\// && ($dir = $1);
X	    } else {
X		if (!$pwd) {
X		    chop($pwd = `pwd`);
X		}
X		$dir = $pwd;
X	    }
X	}
X	if ($olddir && $dir ne $olddir && $dest =~ /:$/) {
X	    $args .= " $dest$olddir; $rcp";
X	}
X	$olddir = $dir;
X	$args .= " $arg";
X    }
X}
X
Xdie "No system type specified.\n" unless $systype;
X
X$args =~ s/:$/:$olddir/;
X
Xchop($thishost = `hostname`);
X
X$one_of_these = ":$systype:";
Xif ($systype =~ s/\+/[+]/g) {
X    $one_of_these =~ s/\+/:/g;
X}
X$one_of_these =~ s/-/:-/g;
X
X@ARGV = ();
Xpush(@ARGV,'.grem') if -f '.grem';
Xpush(@ARGV,'.ghosts') if -f '.ghosts';
Xpush(@ARGV,'/etc/ghosts');
X
X$remainder = '';
X
Xline: while (<>) {
X    s/[ \t]*\n//;
X    if (!$_ || /^#/) {
X	next line;
X    }
X    if (/^([a-zA-Z_0-9]+)=(.+)/) {
X	$name = $1; $repl = $2;
X	$repl =~ s/\+/:/g;
X	$repl =~ s/-/:-/g;
X	$one_of_these =~ s/:$name:/:$repl:/;
X	$repl =~ s/:/:-/g;
X	$one_of_these =~ s/:-$name:/:-$repl:/g;
X	next line;
X    }
X    @gh = split(' ');
X    $host = $gh[0];
X  next line if $host eq $thishost;	# should handle aliases too
X    $wanted = 0;
X    foreach $class (@gh) {
X	$wanted++ if index($one_of_these,":$class:") >= 0;
X	$wanted = -9999 if index($one_of_these,":-$class:") >= 0;
X    }
X    if ($wanted > 0) {
X	($cmd = $args) =~ s/[ \t]$systype:/ $host:/g;
X	print "$cmd\n";
X	$result = `$cmd 2>&1`;
X	$remainder .= "$host+" if
X	    $result =~ /Connection timed out|Permission denied/;
X	print $result;
X    }
X}
X
Xif ($remainder) {
X    chop($remainder);
X    open(grem,">.grem") || (printf stderr "Can't create .grem\n");
X    print grem 'rem=', $remainder, "\n";
X    close(grem);
X    print 'rem=', $remainder, "\n";
X}
X
Xsub CLEANUP {
X    exit;
X}
X
Xsub CONT {
X    print "Continuing...\n";	# Just ignore the signal that kills rcp
X    $remainder .= "$host+";
X}
!STUFFY!FUNK!
echo Extracting t/cmd.while
sed >t/cmd.while <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: cmd.while,v 2.0 88/06/05 00:12:31 root Exp $
X
Xprint "1..10\n";
X
Xopen (tmp,'>Cmd.while.tmp') || die "Can't create Cmd.while.tmp.";
Xprint tmp "tvi925\n";
Xprint tmp "tvi920\n";
Xprint tmp "vt100\n";
Xprint tmp "Amiga\n";
Xprint tmp "paper\n";
Xclose tmp;
X
X# test "last" command
X
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xwhile () {
X    last if /vt100/;
X}
Xif (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1\n";}
X
X# test "next" command
X
X$bad = '';
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xwhile () {
X    next if /vt100/;
X    $bad = 1 if /vt100/;
X}
Xif (!eof || /vt100/ || $bad) {print "not ok 2\n";} else {print "ok 2\n";}
X
X# test "redo" command
X
X$bad = '';
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xwhile () {
X    if (s/vt100/VT100/g) {
X	s/VT100/Vt100/g;
X	redo;
X    }
X    $bad = 1 if /vt100/;
X    $bad = 1 if /VT100/;
X}
Xif (!eof || $bad) {print "not ok 3\n";} else {print "ok 3\n";}
X
X# now do the same with a label and a continue block
X
X# test "last" command
X
X$badcont = '';
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xline: while () {
X    if (/vt100/) {last line;}
X} continue {
X    $badcont = 1 if /vt100/;
X}
Xif (!eof && /vt100/) {print "ok 4\n";} else {print "not ok 4\n";}
Xif (!$badcont) {print "ok 5\n";} else {print "not ok 5\n";}
X
X# test "next" command
X
X$bad = '';
X$badcont = 1;
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xentry: while () {
X    next entry if /vt100/;
X    $bad = 1 if /vt100/;
X} continue {
X    $badcont = '' if /vt100/;
X}
Xif (!eof || /vt100/ || $bad) {print "not ok 6\n";} else {print "ok 6\n";}
Xif (!$badcont) {print "ok 7\n";} else {print "not ok 7\n";}
X
X# test "redo" command
X
X$bad = '';
X$badcont = '';
Xopen(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
Xloop: while () {
X    if (s/vt100/VT100/g) {
X	s/VT100/Vt100/g;
X	redo loop;
X    }
X    $bad = 1 if /vt100/;
X    $bad = 1 if /VT100/;
X} continue {
X    $badcont = 1 if /vt100/;
X}
Xif (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";}
Xif (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";}
X
X`/bin/rm -f Cmd.while.tmp`;
X
X#$x = 0;
X#while (1) {
X#    if ($x > 1) {last;}
X#    next;
X#} continue {
X#    if ($x++ > 10) {last;}
X#    next;
X#}
X#
X#if ($x < 10) {print "ok 10\n";} else {print "not ok 10\n";}
X
X$i = 9;
X{
X    $i++;
X}
Xprint "ok $i\n";
!STUFFY!FUNK!
echo Extracting eg/scan/scanner
sed >eg/scan/scanner <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X
X# $Header: scanner,v 2.0 88/06/05 00:17:42 root Exp $
X
X# This runs all the scan_* routines on all the machines in /etc/ghosts.
X# We run this every morning at about 6 am:
X
X#	!/bin/sh
X#	cd /usr/adm/private
X#	decrypt scanner | perl >scan.out 2>&1
X#	mail admin = 0) {
X    @scanlist = @ARGV;
X} else {
X    @scanlist = split(/[ \t\n]+/,`echo scan_*`);
X}
X
Xscan: while ($scan = shift(@scanlist)) {
X    print "\n********** $scan **********\n";
X    $showhost++;
X
X    $systype = 'all';
X
X    open(ghosts, '/etc/ghosts') || die 'No /etc/ghosts file';
X
X    $one_of_these = ":$systype:";
X    if ($systype =~ s/\+/[+]/g) {
X	$one_of_these =~ s/\+/:/g;
X    }
X
X    line: while () {
X	s/[ \t]*\n//;
X	if (!$_ || /^#/) {
X	    next line;
X	}
X	if (/^([a-zA-Z_0-9]+)=(.+)/) {
X	    $name = $1; $repl = $2;
X	    $repl =~ s/\+/:/g;
X	    $one_of_these =~ s/:$name:/:$repl:/;
X	    next line;
X	}
X	@gh = split;
X	$host = $gh[0];
X	if ($showhost) { $showhost = "$host:\t"; }
X	class: while ($class = pop(gh)) {
X	    if (index($one_of_these,":$class:") >=0) {
X		$iter = 0;
X		`exec crypt -inquire <$scan >.x 2>/dev/null`;
X		unless (open(scan,'.x')) {
X		    print "Can't run $scan.";
X		    next scan;
X		}
X		$cmd = ;
X		unless ($cmd =~ s/#!(.*)\n/$1/) {
X		    $cmd = '/usr/bin/perl';
X		}
X		close(scan);
X		if (open(pipe,"exec rsh $host '$cmd' <.x|")) {
X		    sleep(5);
X		    unlink '.x';
X		    while () {
X			last if $iter++ > 1000;		# must be looping
X			next if /^[0-9.]+u [0-9.]+s/;
X			print $showhost,$_;
X		    }
X		    close(pipe);
X		} else {
X		    print "(Can't execute rsh.)\n";
X		}
X		last class;
X	    }
X	}
X    }
X}
!STUFFY!FUNK!
echo Extracting eg/g/gsh.man
sed >eg/g/gsh.man <<'!STUFFY!FUNK!' -e 's/X//'
X.\" $Header: gsh.man,v 2.0 88/06/05 00:17:23 root Exp $
X.TH GSH 8 "13 May 1988"
X.SH NAME
Xgsh \- global shell
X.SH SYNOPSIS
X.B gsh
X[options]
X.I host
X[options] 
X.I command
X.SH DESCRIPTION
X.I gsh
Xworks just like rsh(1C) except that you may specify a set of hosts to execute
Xthe command on.
XThe host sets are defined in the file /etc/ghosts.
X(An individual host name can be used as a set containing one member.)
XYou can give a command like
X
X	gsh sun /etc/mungmotd
X
Xto run /etc/mungmotd on all your Suns.
X.P
XYou may specify the union of two or more sets by using + as follows:
X
X	gsh 750+mc /etc/mungmotd
X
Xwhich will run mungmotd on all 750's and Masscomps.
X.P
XCommonly used sets should be defined in /etc/ghosts.
XFor example, you could add a line that says
X
X	pep=manny+moe+jack
X
XAnother way to do that would be to add the word "pep" after each of the host
Xentries:
X
X	manny	sun3 pep
X.br
X	moe		sun3 pep
X.br
X	jack		sun3 pep
X
XHosts and sets of host can also be excluded:
X
X	foo=sun-sun2
X
XAny host so excluded will never be included, even if a subsequent set on the
Xline includes it:
X
X	foo=abc+def
X	bar=xyz-abc+foo
X
Xcomes out to xyz+def.
X
XYou can define private host sets by creating .ghosts in your current directory
Xwith entries just like /etc/ghosts.
XAlso, if there is a file .grem, it defines "rem" to be the remaining hosts
Xfrom the last gsh or gcp that didn't succeed everywhere.
X
XOptions include all those defined by rsh, as well as
X
X.IP "\-d" 8
XCauses gsh to collect input till end of file, and then distribute that input
Xto each invokation of rsh.
X.IP "\-h" 8
XRather than print out the command followed by the output, merely prepends the
Xhost name to each line of output.
X.IP "\-s" 8
XDo work silently.
X.PP
XInterrupting with a SIGINT will cause the rsh to the current host to be skipped
Xand execution resumed with the next host.
XTo stop completely, send a SIGQUIT.
X.SH SEE ALSO
Xrsh(1C)
X.SH BUGS
XAll the bugs of rsh, since it calls rsh.
X
XAlso, will not properly return data from the remote execution that contains
Xnull characters.
!STUFFY!FUNK!
echo Extracting eg/g/gcp.man
sed >eg/g/gcp.man <<'!STUFFY!FUNK!' -e 's/X//'
X.\" $Header: gcp.man,v 2.0 88/06/05 00:17:05 root Exp $
X.TH GCP 1C "13 May 1988"
X.SH NAME
Xgcp \- global file copy
X.SH SYNOPSIS
X.B gcp
Xfile1 file2
X.br
X.B gcp
X[
X.B \-r
X] file ... directory
X.SH DESCRIPTION
X.I gcp
Xworks just like rcp(1C) except that you may specify a set of hosts to copy files
Xfrom or to.
XThe host sets are defined in the file /etc/ghosts.
X(An individual host name can be used as a set containing one member.)
XYou can give a command like
X
X	gcp /etc/motd sun:
X
Xto copy your /etc/motd file to /etc/motd on all the Suns.
XIf, on the other hand, you say
X
X	gcp /a/foo /b/bar sun:/tmp
X
Xthen your files will be copied to /tmp on all the Suns.
XThe general rule is that if you don't specify the destination directory,
Xfiles go to the same directory they are in currently.
X.P
XYou may specify the union of two or more sets by using + as follows:
X
X	gcp /a/foo /b/bar 750+mc:
X
Xwhich will copy /a/foo to /a/foo on all 750's and Masscomps, and then copy
X/b/bar to /b/bar on all 750's and Masscomps.
X.P
XCommonly used sets should be defined in /etc/ghosts.
XFor example, you could add a line that says
X
X	pep=manny+moe+jack
X
XAnother way to do that would be to add the word "pep" after each of the host
Xentries:
X
X	manny	sun3 pep
X.br
X	moe		sun3 pep
X.br
X	jack		sun3 pep
X
XHosts and sets of host can also be excluded:
X
X	foo=sun-sun2
X
XAny host so excluded will never be included, even if a subsequent set on the
Xline includes it:
X
X	foo=abc+def
X.br
X	bar=xyz-abc+foo
X
Xcomes out to xyz+def.
X
XYou can define private host sets by creating .ghosts in your current directory
Xwith entries just like /etc/ghosts.
XAlso, if there is a file .grem, it defines "rem" to be the remaining hosts
Xfrom the last gsh or gcp that didn't succeed everywhere.
X.PP
XInterrupting with a SIGINT will cause the rcp to the current host to be skipped
Xand execution resumed with the next host.
XTo stop completely, send a SIGQUIT.
X.SH SEE ALSO
Xrcp(1C)
X.SH BUGS
XAll the bugs of rcp, since it calls rcp.
!STUFFY!FUNK!
echo Extracting t/op.study
sed >t/op.study <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: op.study,v 2.0 88/06/05 00:14:45 root Exp $
X
Xprint "1..24\n";
X
X$x = "abc\ndef\n";
Xstudy($x);
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';
Xstudy;
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
Xstudy($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';
Xstudy;
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';
Xstudy;
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';
Xstudy;
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';
Xstudy;
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";}
!STUFFY!FUNK!
echo Extracting t/TEST
sed >t/TEST <<'!STUFFY!FUNK!' -e 's/X//'
X#!./perl
X
X# $Header: TEST,v 2.0 88/06/05 00:11:47 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
Xchdir 't' if -f 't/TEST';
X
Xif ($ARGV[0] eq '') {
X    @ARGV = split(/[ \n]/,`echo base.* comp.* cmd.* io.* op.*`);
X}
X
Xopen(config,"../config.sh");
Xwhile () {
X    if (/sharpbang='(.*)'/) {
X	$sharpbang = ($1 eq '#!');
X	last;
X    }
X}
X$bad = 0;
Xwhile ($test = shift) {
X    if ($test =~ /\.orig$/) {
X	next;
X    }
X    print "$test...";
X    if ($sharpbang) {
X	open(results,"./$test|") || (print "can't run.\n");
X    } else {
X	open(script,"$test") || die "Can't run $test.\n";
X	$_ =