testygen revision 5c526acb82c882e41b655c31f5fa4425c87b671c
436aad11e01e916f75e68a2e9cb89ac217a990d3Tinderbox User#! /usr/bin/perl -w
6fe48fb46e53ffc37542853a1edb74cb481b7d94Automatic Updater#
18920d790825d96ca3943aa2dcb6eb80dc611c5fTinderbox User# Copyright (c) 2002 Japan Network Information Center.
18920d790825d96ca3943aa2dcb6eb80dc611c5fTinderbox User# All rights reserved.
e9e4257668ff6c4e583b0c0db2508650b0b677b8Tinderbox User#
e9e4257668ff6c4e583b0c0db2508650b0b677b8Tinderbox User# By using this file, you agree to the terms and conditions set forth bellow.
c57668a2fbbe558c1bd21652813616f2f517c469Tinderbox User#
a7c412f37cc73d0332887a746e81220cbf09dd00Mark Andrews# LICENSE TERMS AND CONDITIONS
1f4c645185bd8fc70048e0a69eee46193a284e5cTinderbox User#
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews# The following License Terms and Conditions apply, unless a different
8de3f14f1c300c3e1ed99084cc03485b42c92bf1Tinderbox User# license is obtained from Japan Network Information Center ("JPNIC"),
950d203b64f512b85fcc093ee1e9e3e531a1aea3Tinderbox User# a Japanese association, Kokusai-Kougyou-Kanda Bldg 6F, 2-3-4 Uchi-Kanda,
b886b04d8d2b085cbf3e1bf4442dee87f43ba5e4Tinderbox User# Chiyoda-ku, Tokyo 101-0047, Japan.
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews#
e676a596869d8a80a644c99a848afb53d1c5975eMark Andrews# 1. Use, Modification and Redistribution (including distribution of any
e676a596869d8a80a644c99a848afb53d1c5975eMark Andrews# modified or derived work) in source and/or binary forms is permitted
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews# under this License Terms and Conditions.
a7c412f37cc73d0332887a746e81220cbf09dd00Mark Andrews#
a7c412f37cc73d0332887a746e81220cbf09dd00Mark Andrews# 2. Redistribution of source code must retain the copyright notices as they
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews# appear in each source code file, this License Terms and Conditions.
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews#
e676a596869d8a80a644c99a848afb53d1c5975eMark Andrews# 3. Redistribution in binary form must reproduce the Copyright Notice,
e676a596869d8a80a644c99a848afb53d1c5975eMark Andrews# this License Terms and Conditions, in the documentation and/or other
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews# materials provided with the distribution. For the purposes of binary
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User# distribution the "Copyright Notice" refers to the following language:
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews# "Copyright (c) 2000-2002 Japan Network Information Center. All rights reserved."
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User#
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews# 4. The name of JPNIC may not be used to endorse or promote products
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User# derived from this Software without specific prior written approval of
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews# JPNIC.
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User#
efb0e886f18894a1d2489f1ad74ad14b579e11c7Mark Andrews# 5. Disclaimer/Limitation of Liability: THIS SOFTWARE IS PROVIDED BY JPNIC
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL JPNIC BE LIABLE
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
b886b04d8d2b085cbf3e1bf4442dee87f43ba5e4Tinderbox User# ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews#
aa9c561961e9d877946ebaa8795fa2be054ab7bfEvan Huntuse FileHandle;
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox Useruse Getopt::Std;
0e573cdd111e060e5f6c18249b5ccacbe8abe278Tinderbox User
aa9c561961e9d877946ebaa8795fa2be054ab7bfEvan Hunt#
9513a2a6670951f5cf5477fcfec9f933fcaff628Automatic Updater# Parsing status.
16f6050f29b6b0422cee858e609f65e474e70ef2Tinderbox User#
9513a2a6670951f5cf5477fcfec9f933fcaff628Automatic Updatermy $STATUS_HEADER = 0;
aa9c561961e9d877946ebaa8795fa2be054ab7bfEvan Huntmy $STATUS_HEADER_COMMENT = 1;
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox Usermy $STATUS_SEPARATOR = 2;
0e573cdd111e060e5f6c18249b5ccacbe8abe278Tinderbox Usermy $STATUS_BODY = 3;
aa9c561961e9d877946ebaa8795fa2be054ab7bfEvan Huntmy $STATUS_GLOBAL = 4;
710bce1a85c96e85ca1a90471382055acd29d51fTinderbox Usermy $STATUS_GLOBAL_COMMENT = 5;
9513a2a6670951f5cf5477fcfec9f933fcaff628Automatic Updatermy $STATUS_PREAMBLE = 6;
9513a2a6670951f5cf5477fcfec9f933fcaff628Automatic Updater
9513a2a6670951f5cf5477fcfec9f933fcaff628Automatic Updatermy $LINENO_MARK = "<LINENO>";
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
cdfc81e048bd34c1d628380247bda6b80a89e20eAutomatic Updater#
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews# Create a new testsuite context.
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews#
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrewssub new_testsuite {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews return {'ntests' => 0,
9513a2a6670951f5cf5477fcfec9f933fcaff628Automatic Updater 'setups' => {},
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews 'teardowns' => {},
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews 'tests' => [],
16f6050f29b6b0422cee858e609f65e474e70ef2Tinderbox User 'titles' => [],
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews 'preambles' => ''};
9513a2a6670951f5cf5477fcfec9f933fcaff628Automatic Updater}
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
eabc9c3c07cd956d3c436bd7614cb162dabdda76Mark Andrews#
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews# Read `$file' and put the result into `$testsutie'.
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews#
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrewssub parse_file {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews my ($testsuite, $file, $lineinfo) = @_;
2ae159b376dac23870d8005563c585acf85a4b5aEvan Hunt my $parser = {'type' => '',
2ae159b376dac23870d8005563c585acf85a4b5aEvan Hunt 'group' => '',
2ae159b376dac23870d8005563c585acf85a4b5aEvan Hunt 'title' => '',
95637507c3d47481fbf0a8a8c750a57f944f677fMark Andrews 'status' => $STATUS_PREAMBLE,
2ae159b376dac23870d8005563c585acf85a4b5aEvan Hunt 'error' => '',
2ae159b376dac23870d8005563c585acf85a4b5aEvan Hunt 'file' => $file,
2ae159b376dac23870d8005563c585acf85a4b5aEvan Hunt 'lineno' => 0,
2ae159b376dac23870d8005563c585acf85a4b5aEvan Hunt 'lineinfo' => $lineinfo};
2ae159b376dac23870d8005563c585acf85a4b5aEvan Hunt
2ae159b376dac23870d8005563c585acf85a4b5aEvan Hunt my $handle = FileHandle->new($file, 'r');
2ae159b376dac23870d8005563c585acf85a4b5aEvan Hunt if (!defined($handle)) {
b886b04d8d2b085cbf3e1bf4442dee87f43ba5e4Tinderbox User die "failed to open the file, $!: $file\n";
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews }
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews
950d203b64f512b85fcc093ee1e9e3e531a1aea3Tinderbox User my ($result, $line);
27739dd25026283c24645c8a1044b95ef9eb5ac6Tinderbox User for (;;) {
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews $line = $handle->getline();
18920d790825d96ca3943aa2dcb6eb80dc611c5fTinderbox User last if (!defined($line));
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews
7a6494cfb6cc7d3f67af07359561e05e6bb8c0edTinderbox User chomp($line);
0e573cdd111e060e5f6c18249b5ccacbe8abe278Tinderbox User $line .= "\n";
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews $parser->{lineno}++;
18920d790825d96ca3943aa2dcb6eb80dc611c5fTinderbox User $result = parse_line($testsuite, $parser, $line);
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews if (!$result) {
7a6494cfb6cc7d3f67af07359561e05e6bb8c0edTinderbox User die sprintf("%s, at line %d\n",
77932ac533c711eca5cd86de4e7eca8d91102b43Tinderbox User $parser->{error}, $parser->{lineno});
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews }
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User }
91216cff91b34c9ff6e846dc23f248219cafe660Andreas Gustafsson
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User if ($parser->{status} != $STATUS_GLOBAL) {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews die "unexpected EOF, at line $.\n";
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User }
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $handle->close();
efb0e886f18894a1d2489f1ad74ad14b579e11c7Mark Andrews}
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox Usersub parse_line {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews my ($testsuite, $parser, $line) = @_;
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User my $result = 1;
91216cff91b34c9ff6e846dc23f248219cafe660Andreas Gustafsson
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User if ($parser->{status} == $STATUS_HEADER) {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews if ($line =~ /^\/\/--/) {
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $parser->{status} = $STATUS_HEADER_COMMENT;
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews } elsif ($line =~ /^\/\//) {
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $result = parse_header($testsuite, $parser, $line);
91216cff91b34c9ff6e846dc23f248219cafe660Andreas Gustafsson } elsif ($line =~ /^\s*$/) {
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $parser->{status} = $STATUS_SEPARATOR;
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $result = parse_endheader($testsuite, $parser, $line);
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User } elsif ($line =~ /^\{\s*$/) {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $parser->{status} = $STATUS_BODY;
28a5dd720187fddb16055a0f64b63a7b66f29f64Mark Andrews $result = parse_endheader($testsuite, $parser, $line)
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews && parse_startbody($testsuite, $parser, $line);
78f3ed4bc2fcd3d270bfd599804f3b27a1db4d91Mark Andrews } else {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $parser->{error} = 'syntax error';
0e573cdd111e060e5f6c18249b5ccacbe8abe278Tinderbox User $result = 0;
78f3ed4bc2fcd3d270bfd599804f3b27a1db4d91Mark Andrews }
fd972434c29fc1169d66594e4cc7697d33036c2bTinderbox User
37d8e0a4455876fe1e4cca511076cc2c5ab9eedeTinderbox User } elsif ($parser->{status} == $STATUS_HEADER_COMMENT) {
37d8e0a4455876fe1e4cca511076cc2c5ab9eedeTinderbox User if ($line =~ /^\/\//) {
fd972434c29fc1169d66594e4cc7697d33036c2bTinderbox User # nothing to be done.
2a31bd531072824ef252c18303859d6af7451b00Francis Dupont } elsif ($line =~ /^\s*$/) {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $parser->{status} = $STATUS_SEPARATOR;
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $result = parse_endheader($testsuite, $parser, $line);
2a31bd531072824ef252c18303859d6af7451b00Francis Dupont } elsif ($line =~ /^\{\s*$/) {
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews $parser->{status} = $STATUS_BODY;
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $result = parse_endheader($testsuite, $parser, $line)
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews && parse_startbody($testsuite, $parser, $line);
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews } else {
78f3ed4bc2fcd3d270bfd599804f3b27a1db4d91Mark Andrews $parser->{error} = 'syntax error';
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $result = 0;
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews }
78f3ed4bc2fcd3d270bfd599804f3b27a1db4d91Mark Andrews
78f3ed4bc2fcd3d270bfd599804f3b27a1db4d91Mark Andrews } elsif ($parser->{status} == $STATUS_SEPARATOR) {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews if ($line =~ /^\s*$/) {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews # nothing to be done.
78f3ed4bc2fcd3d270bfd599804f3b27a1db4d91Mark Andrews } elsif ($line =~ /^\{\s*$/) {
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews $parser->{status} = $STATUS_BODY;
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User $result = parse_startbody($testsuite, $parser, $line);
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews } else {
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews $parser->{error} = 'syntax error';
e20788e1216ed720aefa84f3295f7899d9f28c22Mark Andrews $result = 0;
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews }
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews
01a5c5503482fb3ba52088bf0178a7213273bf96Mark Andrews } elsif ($parser->{status} == $STATUS_BODY) {
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User if ($line =~ /^\}\s*$/) {
37d8e0a4455876fe1e4cca511076cc2c5ab9eedeTinderbox User $parser->{status} = $STATUS_GLOBAL;
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $result = parse_endbody($testsuite, $parser, $line);
cdfc81e048bd34c1d628380247bda6b80a89e20eAutomatic Updater } else {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $result = parse_body($testsuite, $parser, $line);
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User }
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User } elsif ($parser->{status} == $STATUS_GLOBAL) {
fe80a4909bf62b602feaf246866e9d29f7654194Automatic Updater if ($line =~ /^\/\/\#/) {
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $parser->{status} = $STATUS_HEADER;
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $result = parse_startheader($testsuite, $parser, $line);
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User } elsif ($line =~ /^\/\/--/) {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $parser->{status} = $STATUS_GLOBAL_COMMENT;
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User } elsif ($line =~ /^\s*$/) {
fa0326cc2cf428f67575b6ba3b97b528a31b0010Tinderbox User # nothing to be done.
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User } else {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $parser->{error} = 'syntax error';
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $result = 0;
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews }
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User
fe80a4909bf62b602feaf246866e9d29f7654194Automatic Updater } elsif ($parser->{status} == $STATUS_GLOBAL_COMMENT) {
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User if ($line =~ /^\/\//) {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews # nothing to be done.
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User } elsif ($line =~ /^\s*$/) {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $parser->{status} = $STATUS_GLOBAL;
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User } else {
91216cff91b34c9ff6e846dc23f248219cafe660Andreas Gustafsson $parser->{error} = 'syntax error';
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $result = 0;
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews }
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews } elsif ($parser->{status} == $STATUS_PREAMBLE) {
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User if ($line =~ /^\/\/\#/) {
dd65eb1efb40b1c47d57963192bfc54873b219beAutomatic Updater $parser->{status} = $STATUS_HEADER;
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $result = parse_startheader($testsuite, $parser, $line);
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews } elsif ($line =~ /^\/\/--/) {
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $parser->{status} = $STATUS_GLOBAL_COMMENT;
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews } else {
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $result = parse_preamble($testsuite, $parser, $line);
133e6d43fa82e80d3798be4de00f4540f485ec6cAutomatic Updater }
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews } else {
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $parser->{error} = 'syntax error';
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $result = 0;
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User }
91216cff91b34c9ff6e846dc23f248219cafe660Andreas Gustafsson
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User return $result;
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews}
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrewssub parse_startheader {
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User my ($testsuite, $parser, $line) = @_;
5f7586ddbd3edd11272cdd30ed613d936129328bTinderbox User
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User if ($line =~ /^\/\/\#\s*(SETUP|TEARDOWN|TESTCASE)\s*$/) {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $parser->{type} = $1;
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $parser->{group} = '';
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $parser->{title} = '';
b886b04d8d2b085cbf3e1bf4442dee87f43ba5e4Tinderbox User } else {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $parser->{error} = 'invalid test-header format';
a7c412f37cc73d0332887a746e81220cbf09dd00Mark Andrews return 0;
a7c412f37cc73d0332887a746e81220cbf09dd00Mark Andrews }
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User
37d8e0a4455876fe1e4cca511076cc2c5ab9eedeTinderbox User
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User return 1;
37d8e0a4455876fe1e4cca511076cc2c5ab9eedeTinderbox User}
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User
a7c412f37cc73d0332887a746e81220cbf09dd00Mark Andrewssub parse_header {
7ca715ad1587a68a531ea1cdea07515d7232567eTinderbox User my ($testsuite, $parser, $line) = @_;
269519eeb959d905ed125f96426e01d725c3b597Tinderbox User
8711e5c73ca872d59810760af0332194cbdd619bAutomatic Updater my $field = $line;
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater $field =~ s/^\/\/\s*//;
e676a596869d8a80a644c99a848afb53d1c5975eMark Andrews $field =~ s/^(\S+):\s*/$1:/;
91d187ce035f39073f0732ff2a401a45c3c955fbMark Andrews $field =~ s/\s+$//;
37d8e0a4455876fe1e4cca511076cc2c5ab9eedeTinderbox User
8e5fce1f9ceba17dd7e3ff0eb287e1e999c14249Mark Andrews return 1 if ($field eq '');
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews
91d187ce035f39073f0732ff2a401a45c3c955fbMark Andrews if ($field =~ /^group:(.*)$/) {
91d187ce035f39073f0732ff2a401a45c3c955fbMark Andrews my $group = $1;
bc0a53583d92309bebcf93c408e2f3247ebd3d3cAutomatic Updater
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater if ($parser->{group} ne '') {
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater $parser->{error} = "group defined twice in a header";
59528addd704f8d5757b54e540520f74e588a7c7Automatic Updater return 0;
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater }
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater if ($parser->{type} eq 'SETUP') {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews if ($group !~ /^[0-9A-Za-z_\-]+$/) {
59528addd704f8d5757b54e540520f74e588a7c7Automatic Updater $parser->{error} = "invalid group name";
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater return 0;
d7d105151a78d35afb4233d2a6dbd47b7ec0d9a5Tinderbox User }
37d8e0a4455876fe1e4cca511076cc2c5ab9eedeTinderbox User if (defined($testsuite->{setups}->{$group})) {
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater $parser->{error} = sprintf("SETUP \`%s' redefined", $group);
19b3dc94bce93fa76bd7e066f9298630dbc9dcb4Automatic Updater return 0;
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater }
9513a2a6670951f5cf5477fcfec9f933fcaff628Automatic Updater } elsif ($parser->{type} eq 'TEARDOWN') {
7f94d9a8162c9a96b56e66176702b66e79d8e1a2Automatic Updater if ($group !~ /^[0-9A-Za-z_\-]+$/) {
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater $parser->{error} = "invalid group name";
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater return 0;
5ecad47f69b3fd945472ab2900a9ff826a7ce2f6Automatic Updater }
37d8e0a4455876fe1e4cca511076cc2c5ab9eedeTinderbox User if (defined($testsuite->{teardowns}->{$group})) {
91d187ce035f39073f0732ff2a401a45c3c955fbMark Andrews $parser->{error} = sprintf("TEARDOWN \`%s' redefined", $group);
6a9d2121152c94cb9e35832126c3f2e4d18d81edTinderbox User return 0;
6a9d2121152c94cb9e35832126c3f2e4d18d81edTinderbox User }
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User } else {
96ea71632887c58a9d00f47eb318bf76b35903c3Mark Andrews foreach my $i (split(/[ \t]+/, $group)) {
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater if ($i !~ /^[0-9A-Za-z_\-]+$/) {
9cd5eb6fe0f26d65724b99216cb31dcdd12e4afdAutomatic Updater $parser->{error} = "invalid group name \`$i'";
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User return 0;
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User }
4cda4fd158d6ded5586bacea8c388445d99611eaAutomatic Updater if (!defined($testsuite->{setups}->{$i})
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews && !defined($testsuite->{teardowns}->{$i})) {
91d187ce035f39073f0732ff2a401a45c3c955fbMark Andrews $parser->{error} = sprintf("group \'%s' not defined", $i);
0e573cdd111e060e5f6c18249b5ccacbe8abe278Tinderbox User return 0;
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews }
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater }
4fe0411487e8e4401477684c0a2bac041ca7c2d5Tinderbox User }
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews $parser->{group} = $group;
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews
bf5e2127e92e52cbf661e77dd6a76e5aef43542fTinderbox User } elsif ($field =~ /^title:(.*)$/) {
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews my $title = $1;
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews if ($parser->{title} ne '') {
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater $parser->{error} = "title defined twice in a header";
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User return 0;
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User }
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater if ($title =~ /[\x00-\x1f\x7f-\xff\"\\]/ || $title eq '') {
a7c412f37cc73d0332887a746e81220cbf09dd00Mark Andrews $parser->{error} = "invalid title";
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews return 0;
da59e63e7af147a8bcef985b98b04443e04c3a0eTinderbox User }
710bce1a85c96e85ca1a90471382055acd29d51fTinderbox User if ($parser->{type} ne 'TESTCASE') {
757ff043760e4743dda1a10e7d58349275934902Tinderbox User $parser->{error} = sprintf("title for %s is not permitted",
cf7e98f59148b559946a7f1ca728471374f1eef3Automatic Updater $parser->{type});
6025cbbe8408f4b09d53d5ec1e95cb6da97e0a8dTinderbox User return 0;
e676a596869d8a80a644c99a848afb53d1c5975eMark Andrews }
757ff043760e4743dda1a10e7d58349275934902Tinderbox User $parser->{title} = $title;
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater
cf7e98f59148b559946a7f1ca728471374f1eef3Automatic Updater } else {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $parser->{error} = "invalid test-header field";
91216cff91b34c9ff6e846dc23f248219cafe660Andreas Gustafsson return 0;
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews }
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews return 1;
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews}
757ff043760e4743dda1a10e7d58349275934902Tinderbox User
757ff043760e4743dda1a10e7d58349275934902Tinderbox Usersub parse_endheader {
4fe0411487e8e4401477684c0a2bac041ca7c2d5Tinderbox User my ($testsuite, $parser, $line) = @_;
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User
b886b04d8d2b085cbf3e1bf4442dee87f43ba5e4Tinderbox User if ($parser->{type} ne 'TESTCASE' && $parser->{group} eq '') {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $parser->{error} = "missing \`group' in the header";
3857cb6fcabeb79d85de4b3e3e4ab99912b701f8Mark Andrews return 0;
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User }
0e573cdd111e060e5f6c18249b5ccacbe8abe278Tinderbox User
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews if ($parser->{type} eq 'TESTCASE' && $parser->{title} eq '') {
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User $parser->{error} = "missing \`title' in the header";
91216cff91b34c9ff6e846dc23f248219cafe660Andreas Gustafsson return 0;
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User }
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
9ecb5d33470ebfb3719a1b8d56bcefdf4b27f7b2Tinderbox User return 1;
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews}
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews
8292deab031e7599cd7622aa7675fbe139ca6095Mark Andrewssub parse_startbody {
e31cfd80616deb9781902306b34a69aa7309b6cbTinderbox User my ($testsuite, $parser, $line) = @_;
7ac34650fa344f42211d6da744ae486b0145a083Tinderbox User my $group = $parser->{group};
4f45d802dc97f12f87e23be2f2e0ba6216e6cea2Tinderbox User
78f3ed4bc2fcd3d270bfd599804f3b27a1db4d91Mark Andrews if ($parser->{type} eq 'SETUP') {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews if ($parser->{lineinfo}) {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{setups}->{$group} =
78f3ed4bc2fcd3d270bfd599804f3b27a1db4d91Mark Andrews generate_line_info($parser->{lineno} + 1, $parser->{file});
78f3ed4bc2fcd3d270bfd599804f3b27a1db4d91Mark Andrews }
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews } elsif ($parser->{type} eq 'TEARDOWN') {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews if ($parser->{lineinfo}) {
78f3ed4bc2fcd3d270bfd599804f3b27a1db4d91Mark Andrews $testsuite->{teardowns}->{$group} =
78f3ed4bc2fcd3d270bfd599804f3b27a1db4d91Mark Andrews generate_line_info($parser->{lineno} + 1, $parser->{file});
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews }
0e573cdd111e060e5f6c18249b5ccacbe8abe278Tinderbox User } else {
78f3ed4bc2fcd3d270bfd599804f3b27a1db4d91Mark Andrews $testsuite->{ntests}++;
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews push(@{$testsuite->{tests}}, '');
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews push(@{$testsuite->{titles}}, $parser->{title});
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{tests}->[-1] .= "\n";
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{tests}->[-1] .= "$LINENO_MARK\n";
e8fc8c884b44371784805e1e0d3100da403dd3f1Automatic Updater $testsuite->{tests}->[-1] .=
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews sprintf("static void\ntestcase\%d(idn_testsuite_t ctx__) {\n",
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{ntests});
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews my (@group_names) = split(/[ \t]+/, $group);
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews for (my $i = 0; $i < @group_names; $i++) {
e8fc8c884b44371784805e1e0d3100da403dd3f1Automatic Updater if (defined($testsuite->{setups}->{$group_names[$i]})) {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{tests}->[-1] .= "\t\{\n";
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{tests}->[-1] .= "#undef EXIT__\n";
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{tests}->[-1] .= "#define EXIT__ exit${i}__\n";
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $testsuite->{tests}->[-1] .=
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{setups}->{$group_names[$i]};
e8fc8c884b44371784805e1e0d3100da403dd3f1Automatic Updater }
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews }
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{tests}->[-1] .= "$LINENO_MARK\n";
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{tests}->[-1] .= "\t\{\n";
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $testsuite->{tests}->[-1] .= "#undef EXIT__\n";
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{tests}->[-1] .= "#define EXIT__ exit__\n";
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews if ($parser->{lineinfo}) {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{tests}->[-1] .=
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews generate_line_info($parser->{lineno} + 1, $parser->{file});
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews }
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews }
b30ec46fec40a1b246f7965fbcd341fc6cfd1cc1Mark Andrews
82a986aaa5d3384a541b5a7d6dae8cf0726d6513Tinderbox User return 1;
c5a97a549c89d562e999d4f906b882c5a2a474e1Tinderbox User}
0e573cdd111e060e5f6c18249b5ccacbe8abe278Tinderbox User
01a5c5503482fb3ba52088bf0178a7213273bf96Mark Andrewssub parse_body {
95c3a5e116c1da135f669c3f15398172fac6279dMark Andrews my ($testsuite, $parser, $line) = @_;
d7d105151a78d35afb4233d2a6dbd47b7ec0d9a5Tinderbox User my ($group) = $parser->{group};
d585233c52e283d9a8849f16f04f452419a2484eTinderbox User
d7d105151a78d35afb4233d2a6dbd47b7ec0d9a5Tinderbox User if ($parser->{type} eq 'SETUP') {
d585233c52e283d9a8849f16f04f452419a2484eTinderbox User $testsuite->{setups}->{$group} .= $line;
b886b04d8d2b085cbf3e1bf4442dee87f43ba5e4Tinderbox User } elsif ($parser->{type} eq 'TEARDOWN') {
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{teardowns}->{$group} .= $line;
59528addd704f8d5757b54e540520f74e588a7c7Automatic Updater } else {
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews $testsuite->{tests}->[-1] .= $line;
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User }
757ff043760e4743dda1a10e7d58349275934902Tinderbox User
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews return 1;
0e573cdd111e060e5f6c18249b5ccacbe8abe278Tinderbox User}
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews
37d8e0a4455876fe1e4cca511076cc2c5ab9eedeTinderbox Usersub parse_endbody {
c651f15b30f1dae5cc2f00878fb5da5b3a35a468Mark Andrews my ($testsuite, $parser, $line) = @_;
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater my ($group) = $parser->{group};
7f79131f9a8e804b93c57f3c679065cce878b726Automatic Updater
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews if ($parser->{type} eq 'TESTCASE') {
91216cff91b34c9ff6e846dc23f248219cafe660Andreas Gustafsson $testsuite->{tests}->[-1] .= "$LINENO_MARK\n";
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $testsuite->{tests}->[-1] .= "\t\}\n";
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $testsuite->{tests}->[-1] .= " exit__:\n";
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $testsuite->{tests}->[-1] .= "\t;\n";
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews my (@group_names) = split(/[ \t]+/, $group);
efb0e886f18894a1d2489f1ad74ad14b579e11c7Mark Andrews for (my $i = @group_names - 1; $i >= 0; $i--) {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $testsuite->{tests}->[-1] .= " exit${i}__:\n";
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $testsuite->{tests}->[-1] .= "\t;\n";
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews if (defined($testsuite->{teardowns}->{$group_names[$i]})) {
3a988722ad9e209ba4064604d482dc4efe0e19ebTinderbox User $testsuite->{tests}->[-1] .=
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington $testsuite->{teardowns}->{$group_names[$i]};
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington }
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $testsuite->{tests}->[-1] .= "$LINENO_MARK\n";
91d187ce035f39073f0732ff2a401a45c3c955fbMark Andrews $testsuite->{tests}->[-1] .= "\t\}\n";
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews }
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $testsuite->{tests}->[-1] .= "}\n";
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews }
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews return 1;
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews}
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
710bce1a85c96e85ca1a90471382055acd29d51fTinderbox Usersub parse_preamble {
710bce1a85c96e85ca1a90471382055acd29d51fTinderbox User my ($testsuite, $parser, $line) = @_;
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
a5636b773fa05a272b6876afd99309c0b3090e2fMark Andrews if ($parser->{lineinfo} && $parser->{lineno} == 1) {
a5636b773fa05a272b6876afd99309c0b3090e2fMark Andrews $testsuite->{preambles} .= generate_line_info(1, $parser->{file});
a5636b773fa05a272b6876afd99309c0b3090e2fMark Andrews }
a5636b773fa05a272b6876afd99309c0b3090e2fMark Andrews $testsuite->{preambles} .= $line;
a5636b773fa05a272b6876afd99309c0b3090e2fMark Andrews return 1;
f7369b2881b5e63d69600adcedc8ba938303d30cTinderbox User}
f7369b2881b5e63d69600adcedc8ba938303d30cTinderbox User
d6317350b1180aa4517f2e8a92fa8fbcbf904ad8Automatic Updatersub generate_line_info {
bc0a4c01beede169df81a3ee5b614ed9e82339dbAutomatic Updater my ($lineno, $file) = @_;
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews return "#line $lineno \"$file\"\n";
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington}
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington#
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington# Output `$testsuite' as source codes of C.
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington#
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellingtonsub output_tests {
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington my ($testsuite, $file, $lineinfo) = @_;
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington my $generator = {
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington 'file' => $file,
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington 'lineno' => 0
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington };
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington my $handle = FileHandle->new($file, 'w');
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington if (!defined($handle)) {
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington die "failed to open the file, $!: $file\n";
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington }
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington my $preamble_header =
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington "/* This file is automatically generated by testygen. */\n\n"
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington . "#define TESTYGEN 1\n"
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington . "\n";
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington output_lines($preamble_header, $generator, $handle, $lineinfo);
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington output_lines($testsuite->{preambles}, $generator, $handle, $lineinfo);
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington my $preamble_footer =
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington "\n"
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington . "$LINENO_MARK\n"
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington . "#include \"testsuite.h\"\n"
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington . "\n";
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington output_lines($preamble_footer, $generator, $handle, $lineinfo);
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington for (my $i = 0; $i < $testsuite->{ntests}; $i++) {
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington output_lines($testsuite->{tests}->[$i], $generator, $handle,
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington $lineinfo);
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington }
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington my $main_header =
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington "\n"
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington . "$LINENO_MARK\n"
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington . "int\n"
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington . "main(int argc, char *argv[]) {\n"
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington . "\tidn_testsuite_t ctx;\n"
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington . "\tconst char *title;\n"
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington . "\n"
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington . "\tidn_testsuite_create(&ctx);\n";
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington output_lines($main_header, $generator, $handle, $lineinfo);
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews for (my $i = 0; $i < $testsuite->{ntests}; $i++) {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews my $title = $testsuite->{titles}->[$i];
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews my $proc = sprintf("testcase%d", $i + 1);
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews output_lines("\tidn_testsuite_addtestcase(ctx, \"$title\", $proc);\n",
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $generator, $handle, $lineinfo);
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews }
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
22d32791e5daa0bc80335a0f10ab2de95f41ccdbTinderbox User my $main_footer =
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater "\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\tif (argc > 1 && strcmp(argv[1], \"-v\") == 0) {\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\t idn_testsuite_setverbose(ctx);\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\t argc--;\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\t argv++;\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\t}\n"
710bce1a85c96e85ca1a90471382055acd29d51fTinderbox User . "\tif (argc == 1)\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\t idn_testsuite_runall(ctx);\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\telse\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\t idn_testsuite_run(ctx, argv + 1);\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\tprintf(\"passed=%d, failed=%d, total=%d\\n\",\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\t idn_testsuite_npassed(ctx),\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\t idn_testsuite_nfailed(ctx),\n"
ae7e54b14c946e0984c191554db9abb4893f9349Automatic Updater . "\t idn_testsuite_ntestcases(ctx) - idn_testsuite_nskipped(ctx));\n"
b30ec46fec40a1b246f7965fbcd341fc6cfd1cc1Mark Andrews . "\n"
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User . "\tidn_testsuite_destroy(ctx);\n"
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User . "\treturn (0);\n"
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User . "\}\n";
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User output_lines($main_footer, $generator, $handle, $lineinfo);
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User $handle->close();
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User}
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox Usersub output_lines {
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User my ($lines, $generator, $handle, $lineinfo) = @_;
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews my ($line);
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews chomp($lines);
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $lines .= "\n";
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User while ($lines ne '') {
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User $lines =~ s/^([^\n]*)\n//;
c11c7b47726c02eb05e29ff7be56a3343146e396Tinderbox User $line = $1;
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews $generator->{lineno}++;
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews if ($line eq $LINENO_MARK) {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews if ($lineinfo) {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $handle->printf("#line %d \"%s\"\n", $generator->{lineno} + 1,
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $generator->{file});
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews }
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews } else {
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews $handle->print("$line\n");
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater }
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater }
febbdb34a7f7759922e239655e7429d78d3a8d26Tinderbox User}
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updatersub output_usage {
dc238a06bffa79de141ee7655765e2df91498a8aTinderbox User warn "$0: [-o output-file] input-file\n";
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrews}
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews#
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews# main.
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews#
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrewsmy (%options);
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrews
0eb371ca0dab50ae3462e98794a6126198c52f4bMark Andrewsif (!getopts('Lo:', \%options)) {
710bce1a85c96e85ca1a90471382055acd29d51fTinderbox User output_usage;
c01dec514a81ecf8c17ca3ef8c3ba95e437295ebAutomatic Updater exit(1);
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater}
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updaterif (@ARGV != 1) {
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater output_usage;
e8c42d50cdaf3a3b841074d8bf72b40ffbae2a4bTinderbox User exit(1);
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater}
ce9cad6bb04869c5e94d9dc721032b25117f9210Automatic Updater
e20309353e6246485c521278131d3fced73d7957Tinderbox Usermy ($in_file) = $ARGV[0];
dedefc0bdbb4e6e39eeb98aa2fc6883efec2ddb0Mark Andrewsmy ($out_file);
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellingtonif (!defined($options{o})) {
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington $out_file = $in_file;
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington $out_file .= '\.tsy' if ($out_file !~ /\.tsy$/);
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington $out_file =~ s/\.tsy$/\.c/;
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington} else {
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington $out_file = $options{o};
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington}
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellingtonmy $testsuite = new_testsuite();
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellingtonparse_file($testsuite, $in_file, !$options{L});
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellingtonoutput_tests($testsuite, $out_file, !$options{L});
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellingtonexit(0);
9e3a7b0faf417a10f5f689edf288807b2d5eedc5Brian Wellington