external/bsd/bind/dist/bin/tests/t_api.pl

   1 #!/usr/local/bin/perl
   2 #
   3 # Copyright (C) 2004, 2007, 2012  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
  20 require "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
  27 sub t_info {
  28         package t_api;
  29         local($format, @rest) = @_;
  30         printf("I:${format}%s", @rest);
  31 }
  32
  33 sub t_result {
  34         package t_api;
  35         local($result) = @_;
  36         $T_inresult = 1;
  37         printf("R:$result\n");
  38 }
  39
  40 sub 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
  46 sub t_getenv {
  47         package t_api;
  48         local($name) = @_;
  49         return($T_env{$name}) if (defined($T_env{$name}));
  50 }
  51
  52 package t_api;
  53
  54 $| = 1;
  55
  56 sub t_on_abort {
  57         $T_aborted = 1;
  58         &t_info("got abort\n");
  59         die;
  60 }
  61
  62 sub t_on_alarm {
  63         $T_timedout = 1;
  64         &t_info("got alarm\n");
  65         die;
  66 }
  67
  68 sub t_on_int {
  69         $T_terminated = 1;
  70         &t_info("got int\n");
  71         die;
  72 }
  73
  74 # initialize the test environment
  75 sub 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
  93 sub 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
 102 sub 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
 152 if (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
 158 if (defined($main'opt_h)) {
 159         print "the -h option is not implemented\n";
 160         exit(0);
 161 }
 162
 163 if (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`;
 193 chop $date;
 194 ($cmd = $0) =~ s/\.\///g;
 195 printf("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
 202 chdir("$T_dir") if (defined($T_dir) && (-d "$T_dir"));
 203
 204 # run the tests
 205 if ($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 }
 212 else {
 213         # otherwise run the specified test
 214         &doTest($T_testnum);
 215 }
 216
 217 # print the end line
 218 $date = `date`;
 219 chop $date;
 220 printf("E:$cmd:$date\n");
 221
 222 1;
 223