diff options
Diffstat (limited to 'bin/tests/t_api.pl')
| -rw-r--r-- | bin/tests/t_api.pl | 223 |
1 files changed, 223 insertions, 0 deletions
diff --git a/bin/tests/t_api.pl b/bin/tests/t_api.pl new file mode 100644 index 0000000..daf0161 --- /dev/null +++ b/bin/tests/t_api.pl @@ -0,0 +1,223 @@ +#!/usr/local/bin/perl +# +# Copyright (C) 2004, 2007 Internet Systems Consortium, Inc. ("ISC") +# Copyright (C) 1999-2001 Internet Software Consortium. +# +# Permission to use, copy, modify, and/or distribute this software for any +# purpose with or without fee is hereby granted, provided that the above +# copyright notice and this permission notice appear in all copies. +# +# THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH +# REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY +# AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, +# INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM +# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE +# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR +# PERFORMANCE OF THIS SOFTWARE. + +# $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; + local($format, @rest) = @_; + 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; + local($component, $anum, $class, $what, @rest) = @_; + printf("A:%s:%d:%s:$what\n", $component, $anum, $class, @rest); +} + +sub t_getenv { + package t_api; + local($name) = @_; + return($T_env{$name}) if (defined($T_env{$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) = @_; + local($name, $value); + + if ((-f $cfile) && (-s _)) { + open(XXX, "< $cfile"); + while (<XXX>) { + next if (/^\#/); + next unless (/=/); + chop; + ($name, $value) = split(/=/, $_, 2); + $T_env{$name} = $value; + } + close(XXX); + } +} + +# dump the configuration to the journal +sub t_dumpconf { + local($name, $value); + + foreach $name (sort keys %T_env) { + &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); + $status = eval($T_testlist[$testnumber]); + alarm(0); + + if (! defined($status)) { + &t_info("The test case timed out\n") if ($t_api'T_timedout); + &t_info("The test case was terminated\n") if ($t_api'T_terminated); + &t_info("The test case was aborted\n") if ($t_api'T_aborted); + &t_result("UNRESOLVED"); + } + elsif (! $t_api'T_inresult) { + &t_result("NORESULT"); + } + } + else { + &t_info("Test %d is not defined\n", $testnumber); + &t_result("UNTESTED"); + } +} + +$T_usage = "Usage: + a : run all tests + b <dir> : cd to dir before running tests + c <configfile> : use configfile instead of t_config + d <level> : set debug level to level + h : print test info (not implemented) + u : print usage info + n <testnumber> : run test number testnumber + t <name> : run test named testname (not implemented) + q <seconds> : use seconds as the timeout value + x : don't execute tests in a subproc (n/a) +"; + +# get command line args +&main'Getopts('ab:c:d:hun:t:q:x'); + +# 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; + +$T_dir = $main'opt_b if (defined($main'opt_b)); +$T_debug = $main'opt_d if (defined($main'opt_d)); +$T_configfile = $main'opt_c if (defined($main'opt_c)); +$T_testnum = $main'opt_n if (defined($main'opt_n)); +$T_timeout = $main'opt_q if (defined($main'opt_q)); + +$SIG{'ABRT'} = 't_api\'t_on_abort'; +$SIG{'ALRM'} = 't_api\'t_on_alarm'; +$SIG{'INT'} = 't_api\'t_on_int'; +$SIG{'QUIT'} = 't_api\'t_on_int'; + +# print the start line +$date = `date`; +chop $date; +($cmd = $0) =~ s/\.\///g; +printf("S:$cmd:$date\n"); + +# initialize the test environment +&t_initconf($T_configfile); +&t_dumpconf() if ($T_debug); + +# establish working directory if requested +chdir("$T_dir") if (defined($T_dir) && (-d "$T_dir")); + +# run the tests +if ($T_testnum == -1) { + # run all tests + $T_ntests = $#main'T_testlist + 1; + for ($T_cnt = 0; $T_cnt < $T_ntests; ++$T_cnt) { + &doTestN($T_cnt); + } +} +else { + # otherwise run the specified test + &doTest($T_testnum); +} + +# print the end line +$date = `date`; +chop $date; +printf("E:$cmd:$date\n"); + +1; + |