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# 44use FileHandle; 45use Getopt::Std; 46 47# 48# Parsing status. 49# 50my $STATUS_HEADER = 0; 51my $STATUS_HEADER_COMMENT = 1; 52my $STATUS_SEPARATOR = 2; 53my $STATUS_BODY = 3; 54my $STATUS_GLOBAL = 4; 55my $STATUS_GLOBAL_COMMENT = 5; 56my $STATUS_PREAMBLE = 6; 57 58my $LINENO_MARK = "<LINENO>"; 59 60# 61# Create a new testsuite context. 62# 63sub 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# 75sub 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 113sub 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 209sub 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 225sub 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 301sub 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 317sub 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 365sub 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 380sub 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 408sub 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 418sub 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# 426sub 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 503sub 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 525sub output_usage { 526 warn "$0: [-o output-file] input-file\n"; 527} 528 529# 530# main. 531# 532my (%options); 533 534if (!getopts('Lo:', \%options)) { 535 output_usage; 536 exit(1); 537} 538if (@ARGV != 1) { 539 output_usage; 540 exit(1); 541} 542 543my ($in_file) = $ARGV[0]; 544my ($out_file); 545if (!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 553my $testsuite = new_testsuite(); 554parse_file($testsuite, $in_file, !$options{L}); 555output_tests($testsuite, $out_file, !$options{L}); 556 557exit(0); 558