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