summaryrefslogtreecommitdiff
path: root/gnu/usr.bin/perl/t/TEST
diff options
context:
space:
mode:
authorJason Downs <downsj@cvs.openbsd.org>1996-08-19 10:13:38 +0000
committerJason Downs <downsj@cvs.openbsd.org>1996-08-19 10:13:38 +0000
commit14856225739aa48b6c9cf4c17925362b2d95cea3 (patch)
treedfd38f1b654fb5bbdfc38887c1a829b658e71530 /gnu/usr.bin/perl/t/TEST
parent77469082517e44fe6ca347d9e8dc7dffd1583637 (diff)
Import of Perl 5.003 into the tree. Makefile.bsd-wrapper and
config.sh.OpenBSD are the only local changes.
Diffstat (limited to 'gnu/usr.bin/perl/t/TEST')
-rw-r--r--gnu/usr.bin/perl/t/TEST112
1 files changed, 112 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/t/TEST b/gnu/usr.bin/perl/t/TEST
new file mode 100644
index 00000000000..291eab5bdb3
--- /dev/null
+++ b/gnu/usr.bin/perl/t/TEST
@@ -0,0 +1,112 @@
+#!./perl
+
+# $RCSfile: TEST,v $$Revision: 4.1 $$Date: 92/08/07 18:27:00 $
+
+# 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';
+
+die "You need to run \"make test\" first to set things up.\n"
+ unless -e 'perl' or -e 'perl.exe';
+
+$ENV{EMXSHELL} = 'sh'; # For OS/2
+
+if ($ARGV[0] eq '') {
+ @ARGV = split(/[ \n]/,
+ `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t lib/*.t`);
+}
+
+open(CONFIG,"../config.sh");
+while (<CONFIG>) {
+ if (/sharpbang='(.*)'/) {
+ $sharpbang = ($1 eq '#!');
+ last;
+ }
+}
+$sharpbang = 0 if $ENV{OS2_SHELL}; # OS/2
+$bad = 0;
+$good = 0;
+$total = @ARGV;
+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";
+ $good = $good + 1;
+ } 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 {
+ $pct = sprintf("%.2f", $good / $total * 100);
+ if ($bad == 1) {
+ warn "Failed 1 test, $pct% okay.\n";
+ } else {
+ die "Failed $bad/$total tests, $pct% okay.\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);