1#!/usr/local/bin/perl
2#
3# Copyright (C) 2004, 2007  Internet Systems Consortium, Inc. ("ISC")
4# Copyright (C) 1999-2001  Internet Software Consortium.
5#
6# Permission to use, copy, modify, and/or distribute this software for any
7# purpose with or without fee is hereby granted, provided that the above
8# copyright notice and this permission notice appear in all copies.
9#
10# THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH
11# REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
12# AND FITNESS.  IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT,
13# INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
14# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
15# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
16# PERFORMANCE OF THIS SOFTWARE.
17
18# $Id: t_api.pl,v 1.10 2007/06/19 23:46:59 tbox Exp $
19
20require "getopts.pl";
21
22#
23# a minimalistic test api in perl compatable with the C api
24# used for the bind 9 regression tests
25#
26
27sub t_info {
28	package t_api;
29	local($format, @rest) = @_;
30	printf("I:${format}%s", @rest);
31}
32
33sub t_result {
34	package t_api;
35	local($result) = @_;
36	$T_inresult = 1;
37	printf("R:$result\n");
38}
39
40sub t_assert {
41	package t_api;
42	local($component, $anum, $class, $what, @rest) = @_;
43	printf("A:%s:%d:%s:$what\n", $component, $anum, $class, @rest);
44}
45
46sub t_getenv {
47	package t_api;
48	local($name) = @_;
49	return($T_env{$name}) if (defined($T_env{$name}));
50}
51
52package t_api;
53
54$| = 1;
55
56sub t_on_abort {
57	$T_aborted = 1;
58	&t_info("got abort\n");
59	die;
60}
61
62sub t_on_alarm {
63	$T_timedout = 1;
64	&t_info("got alarm\n");
65	die;
66}
67
68sub t_on_int {
69	$T_terminated = 1;
70	&t_info("got int\n");
71	die;
72}
73
74# initialize the test environment
75sub t_initconf {
76	local($cfile) = @_;
77	local($name, $value);
78
79	if ((-f $cfile) && (-s _)) {
80		open(XXX, "< $cfile");
81		while (<XXX>) {
82			next if (/^\#/);
83			next unless (/=/);
84			chop;
85			($name, $value) = split(/=/, $_, 2);
86			$T_env{$name} = $value;
87		}
88		close(XXX);
89	}
90}
91
92# dump the configuration to the journal
93sub t_dumpconf {
94	local($name, $value);
95
96	foreach $name (sort keys %T_env) {
97		&main't_info("%s\t%s\n", $name, $T_env{$name});
98	}
99}
100
101# run a test
102sub doTestN {
103	package main;
104	local($testnumber) = @_;
105	local($status);
106
107	if (defined($T_testlist[$testnumber])) {
108
109		$t_api'T_inresult	= 0;
110		$t_api'T_aborted	= 0;
111		$t_api'T_timedout	= 0;
112		$t_api'T_terminated	= 0;
113		$t_api'T_unresolved	= 0;
114
115		alarm($t_api'T_timeout);
116		$status = eval($T_testlist[$testnumber]);
117		alarm(0);
118
119		if (! defined($status)) {
120			&t_info("The test case timed out\n") if ($t_api'T_timedout);
121			&t_info("The test case was terminated\n") if ($t_api'T_terminated);
122			&t_info("The test case was aborted\n") if ($t_api'T_aborted);
123			&t_result("UNRESOLVED");
124		}
125		elsif (! $t_api'T_inresult) {
126			&t_result("NORESULT");
127		}
128	}
129	else {
130		&t_info("Test %d is not defined\n", $testnumber);
131		&t_result("UNTESTED");
132	}
133}
134
135$T_usage = "Usage:
136	a               : run all tests
137        b <dir>         : cd to dir before running tests
138        c <configfile>  : use configfile instead of t_config
139        d <level>       : set debug level to level
140        h               : print test info                       (not implemented)
141        u               : print usage info
142        n <testnumber>  : run test number testnumber
143        t <name>        : run test named testname		(not implemented)
144        q <seconds>     : use seconds as the timeout value
145        x               : don't execute tests in a subproc      (n/a)
146";
147
148# get command line args
149&main'Getopts('ab:c:d:hun:t:q:x');
150
151# if -u, print usage and exit
152if (defined($main'opt_u)) {
153	print $T_usage;
154	exit(0);
155}
156
157# implement -h and -t after we add test descriptions to T_testlist ZZZ
158if (defined($main'opt_h)) {
159	print "the -h option is not implemented\n";
160	exit(0);
161}
162
163if (defined($main'opt_t)) {
164	print "the -t option is not implemented\n";
165	exit(0);
166}
167
168#
169# silently ignore the -x option
170# this exists in the C version of the api
171# to facilitate exception debugging with gdb
172# and is not meaningful here
173#
174
175$T_configfile	= "t_config";
176$T_debug	= 0;
177$T_timeout	= 10;
178$T_testnum	= -1;
179
180$T_dir		= $main'opt_b if (defined($main'opt_b));
181$T_debug	= $main'opt_d if (defined($main'opt_d));
182$T_configfile	= $main'opt_c if (defined($main'opt_c));
183$T_testnum	= $main'opt_n if (defined($main'opt_n));
184$T_timeout	= $main'opt_q if (defined($main'opt_q));
185
186$SIG{'ABRT'} = 't_api\'t_on_abort';
187$SIG{'ALRM'} = 't_api\'t_on_alarm';
188$SIG{'INT'}  = 't_api\'t_on_int';
189$SIG{'QUIT'} = 't_api\'t_on_int';
190
191# print the start line
192$date = `date`;
193chop $date;
194($cmd = $0) =~ s/\.\///g;
195printf("S:$cmd:$date\n");
196
197# initialize the test environment
198&t_initconf($T_configfile);
199&t_dumpconf() if ($T_debug);
200
201# establish working directory if requested
202chdir("$T_dir") if (defined($T_dir) && (-d "$T_dir"));
203
204# run the tests
205if ($T_testnum == -1) {
206	# run all tests
207	$T_ntests = $#main'T_testlist + 1;
208	for ($T_cnt = 0; $T_cnt < $T_ntests; ++$T_cnt) {
209		&doTestN($T_cnt);
210	}
211}
212else {
213	# otherwise run the specified test
214	&doTest($T_testnum);
215}
216
217# print the end line
218$date = `date`;
219chop $date;
220printf("E:$cmd:$date\n");
221
2221;
223
224