summaryrefslogtreecommitdiff
path: root/try
diff options
context:
space:
mode:
authorLarry Wall <lwall@netlabs.com>1993-10-07 23:00:00 +0000
committerLarry Wall <lwall@netlabs.com>1993-10-07 23:00:00 +0000
commit79072805bf63abe5b5978b5928ab00d360ea3e7f (patch)
tree96688fcd69f9c8d2110e93c350b4d0025eaf240d /try
parente334a159a5616cab575044bafaf68f75b7bb3a16 (diff)
downloadperl-79072805bf63abe5b5978b5928ab00d360ea3e7f.tar.gz
perl 5.0 alpha 2perl-5a2
[editor's note: from history.perl.org. The sparc executables originally included in the distribution are not in this commit.]
Diffstat (limited to 'try')
-rwxr-xr-xtry100
1 files changed, 100 insertions, 0 deletions
diff --git a/try b/try
new file mode 100755
index 0000000000..e40f672213
--- /dev/null
+++ b/try
@@ -0,0 +1,100 @@
+#!./perl -Dxstp
+
+# This is written in a peculiar style, since we're trying to avoid
+# most of the constructs we'll be testing for.
+
+$| = 1;
+
+if ($ARGV[0] eq '-v') {
+ $verbose = 1;
+ shift;
+}
+
+chdir 't' if -f 't/TEST';
+
+if ($ARGV[0] eq '') {
+ @ARGV = split(/[ \n]/,
+ `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t lib/*.t`);
+}
+
+open(CONFIG,"../foo.sh");
+while (<CONFIG>) {
+ if (/sharpbang='(.*)'/) {
+ $sharpbang = ($1 eq '#!');
+ last;
+ }
+}
+$bad = 0;
+while ($test = shift) {
+ if ($test =~ /^$/) {
+ next;
+ }
+ $te = $test;
+ chop($te);
+ print "$te" . '.' x (15 - length($te));
+ if ($sharpbang) {
+ open(results,"./$test|") || (print "can't run.\n");
+ } else {
+ open(script,"$test") || die "Can't run $test.\n";
+ $_ = <script>;
+ close(script);
+ if (/#!..perl(.*)/) {
+ $switch = $1;
+ } else {
+ $switch = '';
+ }
+ open(results,"./perl$switch $test|") || (print "can't run.\n");
+ }
+ $ok = 0;
+ $next = 0;
+ while (<results>) {
+ if ($verbose) {
+ print $_;
+ }
+ unless (/^#/) {
+ if (/^1\.\.([0-9]+)/) {
+ $max = $1;
+ $totmax += $max;
+ $files += 1;
+ $next = 1;
+ $ok = 1;
+ } else {
+ $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
+ if (/^ok (.*)/ && $1 == $next) {
+ $next = $next + 1;
+ } else {
+ $ok = 0;
+ }
+ }
+ }
+ }
+ $next = $next - 1;
+ if ($ok && $next == $max) {
+ print "ok\n";
+ } else {
+ $next += 1;
+ print "FAILED on test $next\n";
+ $bad = $bad + 1;
+ $_ = $test;
+ if (/^base/) {
+ die "Failed a basic test--cannot continue.\n";
+ }
+ }
+}
+
+if ($bad == 0) {
+ if ($ok) {
+ print "All tests successful.\n";
+ } else {
+ die "FAILED--no tests were run for some reason.\n";
+ }
+} else {
+ if ($bad == 1) {
+ die "Failed 1 test.\n";
+ } else {
+ die "Failed $bad tests.\n";
+ }
+}
+($user,$sys,$cuser,$csys) = times;
+print sprintf("u=%g s=%g cu=%g cs=%g files=%d tests=%d\n",
+ $user,$sys,$cuser,$csys,$files,$totmax);