external/bsd/bind/dist/contrib/idn/idnkit-1.0-src/lib/tests/testygen

   1 #! /usr/bin/perl -w
   2 #
   3 # Copyright (c) 2002 Japan Network Information Center.
   4 # All rights reserved.
   5 #
   6 # By using this file, you agree to the terms and conditions set forth bellow.
   7 #
   8 #                       LICENSE TERMS AND CONDITIONS
   9 #
  10 # The following License Terms and Conditions apply, unless a different
  11 # license is obtained from Japan Network Information Center ("JPNIC"),
  12 # a Japanese association, Kokusai-Kougyou-Kanda Bldg 6F, 2-3-4 Uchi-Kanda,
  13 # Chiyoda-ku, Tokyo 101-0047, Japan.
  14 #
  15 # 1. Use, Modification and Redistribution (including distribution of any
  16 #    modified or derived work) in source and/or binary forms is permitted
  17 #    under this License Terms and Conditions.
  18 #
  19 # 2. Redistribution of source code must retain the copyright notices as they
  20 #    appear in each source code file, this License Terms and Conditions.
  21 #
  22 # 3. Redistribution in binary form must reproduce the Copyright Notice,
  23 #    this License Terms and Conditions, in the documentation and/or other
  24 #    materials provided with the distribution.  For the purposes of binary
  25 #    distribution the "Copyright Notice" refers to the following language:
  26 #    "Copyright (c) 2000-2002 Japan Network Information Center.  All rights reserved."
  27 #
  28 # 4. The name of JPNIC may not be used to endorse or promote products
  29 #    derived from this Software without specific prior written approval of
  30 #    JPNIC.
  31 #
  32 # 5. Disclaimer/Limitation of Liability: THIS SOFTWARE IS PROVIDED BY JPNIC
  33 #    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  34 #    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
  35 #    PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL JPNIC BE LIABLE
  36 #    FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  37 #    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  38 #    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  39 #    BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  40 #    WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  41 #    OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  42 #    ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
  43 #
  44 use FileHandle;
  45 use Getopt::Std;
  46
  47 #
  48 # Parsing status.
  49 #
  50 my $STATUS_HEADER         = 0;
  51 my $STATUS_HEADER_COMMENT = 1;
  52 my $STATUS_SEPARATOR      = 2;
  53 my $STATUS_BODY           = 3;
  54 my $STATUS_GLOBAL         = 4;
  55 my $STATUS_GLOBAL_COMMENT = 5;
  56 my $STATUS_PREAMBLE       = 6;
  57
  58 my $LINENO_MARK = "<LINENO>";
  59
  60 #
  61 # Create a new testsuite context.
  62 #
  63 sub new_testsuite {
  64     return {'ntests'    => 0,
  65             'setups'    => {},
  66             'teardowns' => {},
  67             'tests'     => [],
  68             'titles'    => [],
  69             'preambles' => ''};
  70 }
  71
  72 #
  73 # Read `$file' and put the result into `$testsutie'.
  74 #
  75 sub parse_file {
  76     my ($testsuite, $file, $lineinfo) = @_;
  77     my $parser = {'type'     => '',
  78                   'group'    => '',
  79                   'title'    => '',
  80                   'status'   => $STATUS_PREAMBLE,
  81                   'error'    => '',
  82                   'file'     => $file,
  83                   'lineno'   => 0,
  84                   'lineinfo' => $lineinfo};
  85
  86     my $handle = FileHandle->new($file, 'r');
  87     if (!defined($handle)) {
  88         die "failed to open the file, $!: $file\n";
  89     }
  90
  91     my ($result, $line);
  92     for (;;) {
  93         $line = $handle->getline();
  94         last if (!defined($line));
  95
  96         chomp($line);
  97         $line .= "\n";
  98         $parser->{lineno}++;
  99         $result = parse_line($testsuite, $parser, $line);
 100         if (!$result) {
 101             die sprintf("%s, at line %d\n",
 102                         $parser->{error}, $parser->{lineno});
 103         }
 104     }
 105
 106     if ($parser->{status} != $STATUS_GLOBAL) {
 107         die "unexpected EOF, at line $.\n";
 108     }
 109
 110     $handle->close();
 111 }
 112
 113 sub parse_line {
 114     my ($testsuite, $parser, $line) = @_;
 115     my $result = 1;
 116
 117     if ($parser->{status} == $STATUS_HEADER) {
 118         if ($line =~ /^\/\/--/) {
 119             $parser->{status} = $STATUS_HEADER_COMMENT;
 120         } elsif ($line =~ /^\/\//) {
 121             $result = parse_header($testsuite, $parser, $line);
 122         } elsif ($line =~ /^\s*$/) {
 123             $parser->{status} = $STATUS_SEPARATOR;
 124             $result = parse_endheader($testsuite, $parser, $line);
 125         } elsif ($line =~ /^\{\s*$/) {
 126             $parser->{status} = $STATUS_BODY;
 127             $result = parse_endheader($testsuite, $parser, $line)
 128                 && parse_startbody($testsuite, $parser, $line);
 129         } else {
 130             $parser->{error} = 'syntax error';
 131             $result = 0;
 132         }
 133
 134     } elsif ($parser->{status} == $STATUS_HEADER_COMMENT) {
 135         if ($line =~ /^\/\//) {
 136             # nothing to be done.
 137         } elsif ($line =~ /^\s*$/) {
 138             $parser->{status} = $STATUS_SEPARATOR;
 139             $result = parse_endheader($testsuite, $parser, $line);
 140         } elsif ($line =~ /^\{\s*$/) {
 141             $parser->{status} = $STATUS_BODY;
 142             $result = parse_endheader($testsuite, $parser, $line)
 143                 && parse_startbody($testsuite, $parser, $line);
 144         } else {
 145             $parser->{error} = 'syntax error';
 146             $result = 0;
 147         }
 148
 149     } elsif ($parser->{status} == $STATUS_SEPARATOR) {
 150         if ($line =~ /^\s*$/) {
 151             # nothing to be done.
 152         } elsif ($line =~ /^\{\s*$/) {
 153             $parser->{status} = $STATUS_BODY;
 154             $result = parse_startbody($testsuite, $parser, $line);
 155         } else {
 156             $parser->{error} = 'syntax error';
 157             $result = 0;
 158         }
 159
 160     } elsif ($parser->{status} == $STATUS_BODY) {
 161         if ($line =~ /^\}\s*$/) {
 162             $parser->{status} = $STATUS_GLOBAL;
 163             $result = parse_endbody($testsuite, $parser, $line);
 164         } else {
 165             $result = parse_body($testsuite, $parser, $line);
 166         }
 167
 168     } elsif ($parser->{status} == $STATUS_GLOBAL) {
 169         if ($line =~ /^\/\/\#/) {
 170             $parser->{status} = $STATUS_HEADER;
 171             $result = parse_startheader($testsuite, $parser, $line);
 172         } elsif ($line =~ /^\/\/--/) {
 173             $parser->{status} = $STATUS_GLOBAL_COMMENT;
 174         } elsif ($line =~ /^\s*$/) {
 175             # nothing to be done.
 176         } else {
 177             $parser->{error} = 'syntax error';
 178             $result = 0;
 179         }
 180
 181     } elsif ($parser->{status} == $STATUS_GLOBAL_COMMENT) {
 182         if ($line =~ /^\/\//) {
 183             # nothing to be done.
 184         } elsif ($line =~ /^\s*$/) {
 185             $parser->{status} = $STATUS_GLOBAL;
 186         } else {
 187             $parser->{error} = 'syntax error';
 188             $result = 0;
 189         }
 190
 191     } elsif ($parser->{status} == $STATUS_PREAMBLE) {
 192         if ($line =~ /^\/\/\#/) {
 193             $parser->{status} = $STATUS_HEADER;
 194             $result = parse_startheader($testsuite, $parser, $line);
 195         } elsif ($line =~ /^\/\/--/) {
 196             $parser->{status} = $STATUS_GLOBAL_COMMENT;
 197         } else {
 198             $result = parse_preamble($testsuite, $parser, $line);
 199         }
 200
 201     } else {
 202         $parser->{error} = 'syntax error';
 203         $result = 0;
 204     }
 205
 206     return $result;
 207 }
 208
 209 sub parse_startheader {
 210     my ($testsuite, $parser, $line) = @_;
 211
 212     if ($line =~ /^\/\/\#\s*(SETUP|TEARDOWN|TESTCASE)\s*$/) {
 213         $parser->{type}  = $1;
 214         $parser->{group} = '';
 215         $parser->{title} = '';
 216     } else {
 217         $parser->{error} = 'invalid test-header format';
 218         return 0;
 219     }
 220
 221
 222     return 1;
 223 }
 224
 225 sub parse_header {
 226     my ($testsuite, $parser, $line) = @_;
 227
 228     my $field = $line;
 229     $field =~ s/^\/\/\s*//;
 230     $field =~ s/^(\S+):\s*/$1:/;
 231     $field =~ s/\s+$//;
 232
 233     return 1 if ($field eq '');
 234
 235     if ($field =~ /^group:(.*)$/) {
 236         my $group = $1;
 237
 238         if ($parser->{group} ne '') {
 239             $parser->{error} = "group defined twice in a header";
 240             return 0;
 241         }
 242         if ($parser->{type} eq 'SETUP') {
 243             if ($group !~ /^[0-9A-Za-z_\-]+$/) {
 244                 $parser->{error} = "invalid group name";
 245                 return 0;
 246             }
 247             if (defined($testsuite->{setups}->{$group})) {
 248                 $parser->{error} = sprintf("SETUP \`%s' redefined", $group);
 249                 return 0;
 250             }
 251         } elsif ($parser->{type} eq 'TEARDOWN') {
 252             if ($group !~ /^[0-9A-Za-z_\-]+$/) {
 253                 $parser->{error} = "invalid group name";
 254                 return 0;
 255             }
 256             if (defined($testsuite->{teardowns}->{$group})) {
 257                 $parser->{error} = sprintf("TEARDOWN \`%s' redefined", $group);
 258                 return 0;
 259             }
 260         } else {
 261             foreach my $i (split(/[ \t]+/, $group)) {
 262                 if ($i !~ /^[0-9A-Za-z_\-]+$/) {
 263                     $parser->{error} = "invalid group name \`$i'";
 264                     return 0;
 265                 }
 266                 if (!defined($testsuite->{setups}->{$i})
 267                     && !defined($testsuite->{teardowns}->{$i})) {
 268                     $parser->{error} = sprintf("group \'%s' not defined", $i);
 269                     return 0;
 270                 }
 271             }
 272         }
 273         $parser->{group} = $group;
 274
 275     } elsif ($field =~ /^title:(.*)$/) {
 276         my $title = $1;
 277
 278         if ($parser->{title} ne '') {
 279             $parser->{error} = "title defined twice in a header";
 280             return 0;
 281         }
 282         if ($title =~ /[\x00-\x1f\x7f-\xff\"\\]/ || $title eq '') {
 283             $parser->{error} = "invalid title";
 284             return 0;
 285         }
 286         if ($parser->{type} ne 'TESTCASE') {
 287             $parser->{error} = sprintf("title for %s is not permitted",
 288                                        $parser->{type});
 289             return 0;
 290         }
 291         $parser->{title} = $title;
 292
 293     } else {
 294         $parser->{error} = "invalid test-header field";
 295         return 0;
 296     }
 297
 298     return 1;
 299 }
 300
 301 sub parse_endheader {
 302     my ($testsuite, $parser, $line) = @_;
 303
 304     if ($parser->{type} ne 'TESTCASE' && $parser->{group} eq '') {
 305         $parser->{error} = "missing \`group' in the header";
 306         return 0;
 307     }
 308
 309     if ($parser->{type} eq 'TESTCASE' && $parser->{title} eq '') {
 310         $parser->{error} = "missing \`title' in the header";
 311         return 0;
 312     }
 313
 314     return 1;
 315 }
 316
 317 sub parse_startbody {
 318     my ($testsuite, $parser, $line) = @_;
 319     my $group = $parser->{group};
 320
 321     if ($parser->{type} eq 'SETUP') {
 322         if ($parser->{lineinfo}) {
 323             $testsuite->{setups}->{$group} =
 324                 generate_line_info($parser->{lineno} + 1, $parser->{file});
 325         }
 326     } elsif ($parser->{type} eq 'TEARDOWN') {
 327         if ($parser->{lineinfo}) {
 328             $testsuite->{teardowns}->{$group} =
 329                 generate_line_info($parser->{lineno} + 1, $parser->{file});
 330         }
 331     } else {
 332         $testsuite->{ntests}++;
 333         push(@{$testsuite->{tests}}, '');
 334         push(@{$testsuite->{titles}}, $parser->{title});
 335
 336         $testsuite->{tests}->[-1] .= "\n";
 337         $testsuite->{tests}->[-1] .= "$LINENO_MARK\n";
 338         $testsuite->{tests}->[-1] .=
 339             sprintf("static void\ntestcase\%d(idn_testsuite_t ctx__) {\n",
 340                     $testsuite->{ntests});
 341
 342         my (@group_names) = split(/[ \t]+/, $group);
 343         for (my $i = 0; $i < @group_names; $i++) {
 344             if (defined($testsuite->{setups}->{$group_names[$i]})) {
 345                 $testsuite->{tests}->[-1] .= "\t\{\n";
 346                 $testsuite->{tests}->[-1] .= "#undef EXIT__\n";
 347                 $testsuite->{tests}->[-1] .= "#define EXIT__ exit${i}__\n";
 348                 $testsuite->{tests}->[-1] .=
 349                     $testsuite->{setups}->{$group_names[$i]};
 350             }
 351         }
 352         $testsuite->{tests}->[-1] .= "$LINENO_MARK\n";
 353         $testsuite->{tests}->[-1] .= "\t\{\n";
 354         $testsuite->{tests}->[-1] .= "#undef EXIT__\n";
 355         $testsuite->{tests}->[-1] .= "#define EXIT__ exit__\n";
 356         if ($parser->{lineinfo}) {
 357             $testsuite->{tests}->[-1] .=
 358                 generate_line_info($parser->{lineno} + 1, $parser->{file});
 359         }
 360     }
 361
 362     return 1;
 363 }
 364
 365 sub parse_body {
 366     my ($testsuite, $parser, $line) = @_;
 367     my ($group) = $parser->{group};
 368
 369     if ($parser->{type} eq 'SETUP') {
 370         $testsuite->{setups}->{$group} .= $line;
 371     } elsif ($parser->{type} eq 'TEARDOWN') {
 372         $testsuite->{teardowns}->{$group} .= $line;
 373     } else {
 374         $testsuite->{tests}->[-1] .= $line;
 375     }
 376
 377     return 1;
 378 }
 379
 380 sub parse_endbody {
 381     my ($testsuite, $parser, $line) = @_;
 382     my ($group) = $parser->{group};
 383
 384     if ($parser->{type} eq 'TESTCASE') {
 385         $testsuite->{tests}->[-1] .= "$LINENO_MARK\n";
 386         $testsuite->{tests}->[-1] .= "\t\}\n";
 387         $testsuite->{tests}->[-1] .= "  exit__:\n";
 388         $testsuite->{tests}->[-1] .= "\t;\n";
 389
 390         my (@group_names) = split(/[ \t]+/, $group);
 391         for (my $i = @group_names - 1; $i >= 0; $i--) {
 392             $testsuite->{tests}->[-1] .= "  exit${i}__:\n";
 393             $testsuite->{tests}->[-1] .= "\t;\n";
 394             if (defined($testsuite->{teardowns}->{$group_names[$i]})) {
 395                 $testsuite->{tests}->[-1] .=
 396                     $testsuite->{teardowns}->{$group_names[$i]};
 397             }
 398             $testsuite->{tests}->[-1] .= "$LINENO_MARK\n";
 399             $testsuite->{tests}->[-1] .= "\t\}\n";
 400         }
 401
 402         $testsuite->{tests}->[-1] .= "}\n";
 403     }
 404
 405     return 1;
 406 }
 407
 408 sub parse_preamble {
 409     my ($testsuite, $parser, $line) = @_;
 410
 411     if ($parser->{lineinfo} && $parser->{lineno} == 1) {
 412         $testsuite->{preambles} .= generate_line_info(1, $parser->{file});
 413     }
 414     $testsuite->{preambles} .= $line;
 415     return 1;
 416 }
 417
 418 sub generate_line_info {
 419     my ($lineno, $file) = @_;
 420     return "#line $lineno \"$file\"\n";
 421 }
 422
 423 #
 424 # Output `$testsuite' as source codes of C.
 425 #
 426 sub output_tests {
 427     my ($testsuite, $file, $lineinfo) = @_;
 428
 429     my $generator = {
 430         'file' => $file,
 431         'lineno' => 0
 432     };
 433
 434     my $handle = FileHandle->new($file, 'w');
 435     if (!defined($handle)) {
 436         die "failed to open the file, $!: $file\n";
 437     }
 438
 439     my $preamble_header =
 440         "/* This file is automatically generated by testygen. */\n\n"
 441         . "#define TESTYGEN 1\n"
 442         . "\n";
 443     output_lines($preamble_header, $generator, $handle, $lineinfo);
 444
 445     output_lines($testsuite->{preambles}, $generator, $handle, $lineinfo);
 446
 447     my $preamble_footer =
 448         "\n"
 449         . "$LINENO_MARK\n"
 450         . "#include \"testsuite.h\"\n"
 451         . "\n";
 452     output_lines($preamble_footer, $generator, $handle, $lineinfo);
 453
 454
 455     for (my $i = 0; $i < $testsuite->{ntests}; $i++) {
 456         output_lines($testsuite->{tests}->[$i], $generator, $handle,
 457                      $lineinfo);
 458     }
 459
 460     my $main_header =
 461         "\n"
 462         . "$LINENO_MARK\n"
 463         . "int\n"
 464         . "main(int argc, char *argv[]) {\n"
 465         . "\tidn_testsuite_t ctx;\n"
 466         . "\tconst char *title;\n"
 467         . "\n"
 468         . "\tidn_testsuite_create(&ctx);\n";
 469     output_lines($main_header, $generator, $handle, $lineinfo);
 470
 471     for (my $i = 0; $i < $testsuite->{ntests}; $i++) {
 472         my $title = $testsuite->{titles}->[$i];
 473         my $proc = sprintf("testcase%d", $i + 1);
 474         output_lines("\tidn_testsuite_addtestcase(ctx, \"$title\", $proc);\n",
 475                      $generator, $handle, $lineinfo);
 476     }
 477
 478     my $main_footer =
 479         "\n"
 480         . "\tif (argc > 1 && strcmp(argv[1], \"-v\") == 0) {\n"
 481         . "\t   idn_testsuite_setverbose(ctx);\n"
 482         . "\t   argc--;\n"
 483         . "\t   argv++;\n"
 484         . "\t}\n"
 485         . "\tif (argc == 1)\n"
 486         . "\t   idn_testsuite_runall(ctx);\n"
 487         . "\telse\n"
 488         . "\t   idn_testsuite_run(ctx, argv + 1);\n"
 489         . "\n"
 490         . "\tprintf(\"passed=%d, failed=%d, total=%d\\n\",\n"
 491         . "\t       idn_testsuite_npassed(ctx),\n"
 492         . "\t       idn_testsuite_nfailed(ctx),\n"
 493         . "\t       idn_testsuite_ntestcases(ctx) - idn_testsuite_nskipped(ctx));\n"
 494         . "\n"
 495         . "\tidn_testsuite_destroy(ctx);\n"
 496         . "\treturn (0);\n"
 497         . "\}\n";
 498     output_lines($main_footer, $generator, $handle, $lineinfo);
 499
 500     $handle->close();
 501 }
 502
 503 sub output_lines {
 504     my ($lines, $generator, $handle, $lineinfo) = @_;
 505     my ($line);
 506
 507     chomp($lines);
 508     $lines .= "\n";
 509
 510     while ($lines ne '') {
 511         $lines =~ s/^([^\n]*)\n//;
 512         $line = $1;
 513         $generator->{lineno}++;
 514         if ($line eq $LINENO_MARK) {
 515             if ($lineinfo) {
 516                 $handle->printf("#line %d \"%s\"\n", $generator->{lineno} + 1,
 517                                 $generator->{file});
 518             }
 519         } else {
 520             $handle->print("$line\n");
 521         }
 522     }
 523 }
 524
 525 sub output_usage {
 526     warn "$0: [-o output-file] input-file\n";
 527 }
 528
 529 #
 530 # main.
 531 #
 532 my (%options);
 533
 534 if (!getopts('Lo:', \%options)) {
 535     output_usage;
 536     exit(1);
 537 }
 538 if (@ARGV != 1) {
 539     output_usage;
 540     exit(1);
 541 }
 542
 543 my ($in_file) = $ARGV[0];
 544 my ($out_file);
 545 if (!defined($options{o})) {
 546     $out_file = $in_file;
 547     $out_file .= '\.tsy' if ($out_file !~ /\.tsy$/);
 548     $out_file =~ s/\.tsy$/\.c/;
 549 } else {
 550     $out_file = $options{o};
 551 }
 552
 553 my $testsuite = new_testsuite();
 554 parse_file($testsuite, $in_file, !$options{L});
 555 output_tests($testsuite, $out_file, !$options{L});
 556
 557 exit(0);