t_api.pl revision 0c27b3fe77ac1d5094ba3521e8142d9e7973133f
#
# Copyright (C) 1999-2001, 2004, 2007, 2012, 2016 Internet Systems Consortium, Inc. ("ISC")
#
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
# $Id: t_api.pl,v 1.10 2007/06/19 23:46:59 tbox Exp $
require "getopts.pl";
#
# a minimalistic test api in perl compatable with the C api
# used for the bind 9 regression tests
#
sub t_info {
package t_api;
printf("I:${format}%s", @rest);
}
sub t_result {
package t_api;
local($result) = @_;
$T_inresult = 1;
printf("R:$result\n");
}
sub t_assert {
package t_api;
}
sub t_getenv {
package t_api;
local($name) = @_;
}
package t_api;
$| = 1;
sub t_on_abort {
$T_aborted = 1;
&t_info("got abort\n");
die;
}
sub t_on_alarm {
$T_timedout = 1;
&t_info("got alarm\n");
die;
}
sub t_on_int {
$T_terminated = 1;
&t_info("got int\n");
die;
}
# initialize the test environment
sub t_initconf {
local($cfile) = @_;
if ((-f $cfile) && (-s _)) {
open(XXX, "< $cfile");
while (<XXX>) {
next if (/^\#/);
next unless (/=/);
chop;
}
close(XXX);
}
}
# dump the configuration to the journal
sub t_dumpconf {
&main't_info("%s\t%s\n", $name, $T_env{$name});
}
}
# run a test
sub doTestN {
package main;
local($testnumber) = @_;
local($status);
if (defined($T_testlist[$testnumber])) {
$t_api'T_inresult = 0;
$t_api'T_aborted = 0;
$t_api'T_timedout = 0;
$t_api'T_terminated = 0;
$t_api'T_unresolved = 0;
alarm($t_api'T_timeout);
alarm(0);
if (! defined($status)) {
&t_result("UNRESOLVED");
}
elsif (! $t_api'T_inresult) {
&t_result("NORESULT");
}
}
else {
&t_result("UNTESTED");
}
}
$T_usage = "Usage:
x : don't execute tests in a subproc (n/a)
";
# get command line args
# if -u, print usage and exit
if (defined($main'opt_u)) {
print $T_usage;
exit(0);
}
# implement -h and -t after we add test descriptions to T_testlist ZZZ
if (defined($main'opt_h)) {
print "the -h option is not implemented\n";
exit(0);
}
if (defined($main'opt_t)) {
print "the -t option is not implemented\n";
exit(0);
}
#
# silently ignore the -x option
# this exists in the C version of the api
# to facilitate exception debugging with gdb
# and is not meaningful here
#
$T_configfile = "t_config";
$T_debug = 0;
$T_timeout = 10;
$T_testnum = -1;
# print the start line
chop $date;
($cmd = $0) =~ s/\.\///g;
printf("S:$cmd:$date\n");
# initialize the test environment
&t_dumpconf() if ($T_debug);
# establish working directory if requested
# run the tests
if ($T_testnum == -1) {
# run all tests
$T_ntests = $#main'T_testlist + 1;
}
}
else {
# otherwise run the specified test
}
# print the end line
chop $date;
printf("E:$cmd:$date\n");
1;