summaryrefslogtreecommitdiff
path: root/test/testrunner.pl
blob: 4b599698dbc2931455c24373d7a1cd3d05eb9808 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
#!/bin/perl
#
# Testcase runner for libhubbub
#
# Usage: testrunner <directory> [<executable extension>]
#
# Operates upon INDEX files described in the README.
# Locates and executes testcases, feeding data files to programs 
# as appropriate.
# Logs testcase output to file.
# Aborts test sequence on detection of error.
#

use warnings;
use strict;
use File::Spec;
use IPC::Open3;

if (@ARGV < 1) {
	print "Usage: testrunner.pl <directory> [<exeext>]\n";
	exit;
}

# Get directory
my $directory = shift @ARGV;

# Get EXE extension (if any)
my $exeext = "";
$exeext = shift @ARGV if (@ARGV > 0);

# Open log file and /dev/null
open(LOG, ">$directory/log") or die "Failed opening test log";
open(NULL, "+<", File::Spec->devnull) or die "Failed opening /dev/null";

# Open testcase index
open(TINDEX, "<$directory/INDEX") or die "Failed opening test INDEX";

# Parse testcase index, looking for testcases
while (my $line = <TINDEX>) {
	next if ($line =~ /^(#.*)?$/);

	# Found one; decompose
	(my $test, my $desc, my $data) = split /\t+/, $line;

	# Strip whitespace
	$test =~ s/^\s+|\s+$//g;
	$desc =~ s/^\s+|\s+$//g;
	$data =~ s/^\s+|\s+$//g if ($data);

	# Append EXE extension to binary name
	$test = $test . $exeext;

	print "Test: $desc\n";

	my $pid;

	if ($data) {
		# Testcase has external data files

		# Open datafile index
		open(DINDEX, "<$directory/data/$data/INDEX") or 
			die "Failed opening $directory/data/$data/INDEX";

		# Parse datafile index, looking for datafiles
		while (my $dentry = <DINDEX>) {
			next if ($dentry =~ /^(#.*)?$/);

			# Found one; decompose
			(my $dtest, my $ddesc) = split /\t+/, $dentry;

			# Strip whitespace
			$dtest =~ s/^\s+|\s+$//g;
			$ddesc =~ s/^\s+|\s+$//g;

			print LOG "Running $directory/$test " .
					"$directory/data/Aliases " .
					"$directory/data/$data/$dtest\n";

			# Make message fit on an 80 column terminal
			my $msg = "    ==> $test [$data/$dtest]";
			$msg = $msg . "." x (80 - length($msg) - 8);

			print $msg;

			# Run testcase
			$pid = open3("&<NULL", \*OUT, \*ERR, 
					"$directory/$test", 
					"$directory/data/Aliases", 
					"$directory/data/$data/$dtest");

			my $last = "FAIL";

			# Marshal testcase output to log file
			while (my $output = <OUT>) {
				print LOG "    $output";
				$last = $output;
			}

			# Wait for child to finish
			waitpid($pid, 0);

			print substr($last, 0, 4) . "\n";

			# Bail, noisily, on failure
			if (substr($last, 0, 4) eq "FAIL") {
				# Write any stderr output to the log
				while (my $errors = <ERR>) {
					print LOG "    $errors";
				}

				print "\n\nFailure detected: " .
						"consult log file\n\n\n";

				exit(1);
			}
                }

		close(DINDEX);
	} else {
		# Testcase has no external data files
		print LOG "Running $directory/$test $directory/data/Aliases\n";

		# Make message fit on an 80 column terminal
		my $msg = "    ==> $test";
		$msg = $msg . "." x (80 - length($msg) - 8);

		print $msg;

		# Run testcase
		$pid = open3("&<NULL", \*OUT, \*ERR, 
				"$directory/$test", "$directory/data/Aliases");

		my $last = "FAIL";

		# Marshal testcase output to log file
		while (my $output = <OUT>) {
			print LOG "    $output";
			$last = $output;
		}

		# Wait for child to finish
		waitpid($pid, 0);

		print substr($last, 0, 4) . "\n";

		# Bail, noisily, on failure
		if (substr($last, 0, 4) eq "FAIL") {
			# Write any stderr output to the log
			while (my $errors = <ERR>) {
				print LOG "    $errors";
			}

			print "\n\nFailure detected: " . 
					"consult log file\n\n\n";

			exit(1);
		}
	}

	print "\n";
}

# Clean up
close(TINDEX);

close(NULL);
close(LOG);