5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#! /usr/bin/perl -w
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# Copyright (c) 2002 Japan Network Information Center.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# All rights reserved.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# By using this file, you agree to the terms and conditions set forth bellow.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# LICENSE TERMS AND CONDITIONS
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# The following License Terms and Conditions apply, unless a different
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# license is obtained from Japan Network Information Center ("JPNIC"),
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# a Japanese association, Kokusai-Kougyou-Kanda Bldg 6F, 2-3-4 Uchi-Kanda,
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# Chiyoda-ku, Tokyo 101-0047, Japan.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# 1. Use, Modification and Redistribution (including distribution of any
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# modified or derived work) in source and/or binary forms is permitted
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# under this License Terms and Conditions.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# 2. Redistribution of source code must retain the copyright notices as they
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# appear in each source code file, this License Terms and Conditions.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# 3. Redistribution in binary form must reproduce the Copyright Notice,
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# this License Terms and Conditions, in the documentation and/or other
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# materials provided with the distribution. For the purposes of binary
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# distribution the "Copyright Notice" refers to the following language:
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# "Copyright (c) 2000-2002 Japan Network Information Center. All rights reserved."
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# 4. The name of JPNIC may not be used to endorse or promote products
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# derived from this Software without specific prior written approval of
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# JPNIC.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# 5. Disclaimer/Limitation of Liability: THIS SOFTWARE IS PROVIDED BY JPNIC
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL JPNIC BE LIABLE
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsuse FileHandle;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsuse Getopt::Std;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# Parsing status.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsmy $STATUS_HEADER = 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsmy $STATUS_HEADER_COMMENT = 1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsmy $STATUS_SEPARATOR = 2;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsmy $STATUS_BODY = 3;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsmy $STATUS_GLOBAL = 4;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsmy $STATUS_GLOBAL_COMMENT = 5;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsmy $STATUS_PREAMBLE = 6;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsmy $LINENO_MARK = "<LINENO>";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# Create a new testsuite context.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub new_testsuite {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return {'ntests' => 0,
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'setups' => {},
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'teardowns' => {},
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'tests' => [],
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'titles' => [],
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'preambles' => ''};
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# Read `$file' and put the result into `$testsutie'.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub parse_file {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($testsuite, $file, $lineinfo) = @_;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $parser = {'type' => '',
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'group' => '',
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'title' => '',
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'status' => $STATUS_PREAMBLE,
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'error' => '',
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'file' => $file,
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'lineno' => 0,
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'lineinfo' => $lineinfo};
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $handle = FileHandle->new($file, 'r');
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if (!defined($handle)) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews die "failed to open the file, $!: $file\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($result, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews for (;;) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $line = $handle->getline();
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews last if (!defined($line));
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews chomp($line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $line .= "\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{lineno}++;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = parse_line($testsuite, $parser, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if (!$result) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews die sprintf("%s, at line %d\n",
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error}, $parser->{lineno});
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{status} != $STATUS_GLOBAL) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews die "unexpected EOF, at line $.\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $handle->close();
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub parse_line {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($testsuite, $parser, $line) = @_;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $result = 1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{status} == $STATUS_HEADER) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($line =~ /^\/\/--/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{status} = $STATUS_HEADER_COMMENT;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($line =~ /^\/\//) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = parse_header($testsuite, $parser, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($line =~ /^\s*$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{status} = $STATUS_SEPARATOR;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = parse_endheader($testsuite, $parser, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($line =~ /^\{\s*$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{status} = $STATUS_BODY;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = parse_endheader($testsuite, $parser, $line)
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews && parse_startbody($testsuite, $parser, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = 'syntax error';
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($parser->{status} == $STATUS_HEADER_COMMENT) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($line =~ /^\/\//) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews # nothing to be done.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($line =~ /^\s*$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{status} = $STATUS_SEPARATOR;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = parse_endheader($testsuite, $parser, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($line =~ /^\{\s*$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{status} = $STATUS_BODY;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = parse_endheader($testsuite, $parser, $line)
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews && parse_startbody($testsuite, $parser, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = 'syntax error';
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($parser->{status} == $STATUS_SEPARATOR) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($line =~ /^\s*$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews # nothing to be done.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($line =~ /^\{\s*$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{status} = $STATUS_BODY;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = parse_startbody($testsuite, $parser, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = 'syntax error';
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($parser->{status} == $STATUS_BODY) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($line =~ /^\}\s*$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{status} = $STATUS_GLOBAL;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = parse_endbody($testsuite, $parser, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = parse_body($testsuite, $parser, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($parser->{status} == $STATUS_GLOBAL) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($line =~ /^\/\/\#/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{status} = $STATUS_HEADER;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = parse_startheader($testsuite, $parser, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($line =~ /^\/\/--/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{status} = $STATUS_GLOBAL_COMMENT;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($line =~ /^\s*$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews # nothing to be done.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = 'syntax error';
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($parser->{status} == $STATUS_GLOBAL_COMMENT) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($line =~ /^\/\//) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews # nothing to be done.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($line =~ /^\s*$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{status} = $STATUS_GLOBAL;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = 'syntax error';
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($parser->{status} == $STATUS_PREAMBLE) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($line =~ /^\/\/\#/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{status} = $STATUS_HEADER;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = parse_startheader($testsuite, $parser, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($line =~ /^\/\/--/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{status} = $STATUS_GLOBAL_COMMENT;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = parse_preamble($testsuite, $parser, $line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = 'syntax error';
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $result = 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return $result;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub parse_startheader {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($testsuite, $parser, $line) = @_;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($line =~ /^\/\/\#\s*(SETUP|TEARDOWN|TESTCASE)\s*$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{type} = $1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{group} = '';
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{title} = '';
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = 'invalid test-header format';
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub parse_header {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($testsuite, $parser, $line) = @_;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $field = $line;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $field =~ s/^\/\/\s*//;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $field =~ s/^(\S+):\s*/$1:/;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $field =~ s/\s+$//;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 1 if ($field eq '');
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($field =~ /^group:(.*)$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $group = $1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{group} ne '') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = "group defined twice in a header";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{type} eq 'SETUP') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($group !~ /^[0-9A-Za-z_\-]+$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = "invalid group name";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if (defined($testsuite->{setups}->{$group})) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = sprintf("SETUP \`%s' redefined", $group);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($parser->{type} eq 'TEARDOWN') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($group !~ /^[0-9A-Za-z_\-]+$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = "invalid group name";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if (defined($testsuite->{teardowns}->{$group})) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = sprintf("TEARDOWN \`%s' redefined", $group);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews foreach my $i (split(/[ \t]+/, $group)) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($i !~ /^[0-9A-Za-z_\-]+$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = "invalid group name \`$i'";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if (!defined($testsuite->{setups}->{$i})
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews && !defined($testsuite->{teardowns}->{$i})) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = sprintf("group \'%s' not defined", $i);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{group} = $group;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($field =~ /^title:(.*)$/) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $title = $1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{title} ne '') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = "title defined twice in a header";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($title =~ /[\x00-\x1f\x7f-\xff\"\\]/ || $title eq '') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = "invalid title";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{type} ne 'TESTCASE') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = sprintf("title for %s is not permitted",
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{type});
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{title} = $title;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = "invalid test-header field";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub parse_endheader {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($testsuite, $parser, $line) = @_;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{type} ne 'TESTCASE' && $parser->{group} eq '') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = "missing \`group' in the header";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{type} eq 'TESTCASE' && $parser->{title} eq '') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $parser->{error} = "missing \`title' in the header";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 0;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub parse_startbody {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($testsuite, $parser, $line) = @_;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $group = $parser->{group};
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{type} eq 'SETUP') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{lineinfo}) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{setups}->{$group} =
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews generate_line_info($parser->{lineno} + 1, $parser->{file});
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($parser->{type} eq 'TEARDOWN') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{lineinfo}) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{teardowns}->{$group} =
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews generate_line_info($parser->{lineno} + 1, $parser->{file});
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{ntests}++;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews push(@{$testsuite->{tests}}, '');
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews push(@{$testsuite->{titles}}, $parser->{title});
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "$LINENO_MARK\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .=
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews sprintf("static void\ntestcase\%d(idn_testsuite_t ctx__) {\n",
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{ntests});
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my (@group_names) = split(/[ \t]+/, $group);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews for (my $i = 0; $i < @group_names; $i++) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if (defined($testsuite->{setups}->{$group_names[$i]})) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "\t\{\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "#undef EXIT__\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "#define EXIT__ exit${i}__\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .=
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{setups}->{$group_names[$i]};
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "$LINENO_MARK\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "\t\{\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "#undef EXIT__\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "#define EXIT__ exit__\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{lineinfo}) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .=
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews generate_line_info($parser->{lineno} + 1, $parser->{file});
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub parse_body {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($testsuite, $parser, $line) = @_;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($group) = $parser->{group};
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{type} eq 'SETUP') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{setups}->{$group} .= $line;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } elsif ($parser->{type} eq 'TEARDOWN') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{teardowns}->{$group} .= $line;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= $line;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub parse_endbody {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($testsuite, $parser, $line) = @_;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($group) = $parser->{group};
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{type} eq 'TESTCASE') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "$LINENO_MARK\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "\t\}\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= " exit__:\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "\t;\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my (@group_names) = split(/[ \t]+/, $group);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews for (my $i = @group_names - 1; $i >= 0; $i--) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= " exit${i}__:\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "\t;\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if (defined($testsuite->{teardowns}->{$group_names[$i]})) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .=
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{teardowns}->{$group_names[$i]};
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "$LINENO_MARK\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "\t\}\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{tests}->[-1] .= "}\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub parse_preamble {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($testsuite, $parser, $line) = @_;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($parser->{lineinfo} && $parser->{lineno} == 1) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{preambles} .= generate_line_info(1, $parser->{file});
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $testsuite->{preambles} .= $line;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return 1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub generate_line_info {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($lineno, $file) = @_;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews return "#line $lineno \"$file\"\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# Output `$testsuite' as source codes of C.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub output_tests {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($testsuite, $file, $lineinfo) = @_;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $generator = {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'file' => $file,
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews 'lineno' => 0
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews };
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $handle = FileHandle->new($file, 'w');
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if (!defined($handle)) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews die "failed to open the file, $!: $file\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $preamble_header =
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews "/* This file is automatically generated by testygen. */\n\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "#define TESTYGEN 1\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews output_lines($preamble_header, $generator, $handle, $lineinfo);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews output_lines($testsuite->{preambles}, $generator, $handle, $lineinfo);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $preamble_footer =
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews "\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "$LINENO_MARK\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "#include \"testsuite.h\"\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews output_lines($preamble_footer, $generator, $handle, $lineinfo);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews for (my $i = 0; $i < $testsuite->{ntests}; $i++) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews output_lines($testsuite->{tests}->[$i], $generator, $handle,
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $lineinfo);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $main_header =
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews "\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "$LINENO_MARK\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "int\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "main(int argc, char *argv[]) {\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\tidn_testsuite_t ctx;\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\tconst char *title;\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\tidn_testsuite_create(&ctx);\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews output_lines($main_header, $generator, $handle, $lineinfo);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews for (my $i = 0; $i < $testsuite->{ntests}; $i++) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $title = $testsuite->{titles}->[$i];
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $proc = sprintf("testcase%d", $i + 1);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews output_lines("\tidn_testsuite_addtestcase(ctx, \"$title\", $proc);\n",
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $generator, $handle, $lineinfo);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my $main_footer =
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews "\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\tif (argc > 1 && strcmp(argv[1], \"-v\") == 0) {\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\t idn_testsuite_setverbose(ctx);\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\t argc--;\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\t argv++;\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\t}\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\tif (argc == 1)\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\t idn_testsuite_runall(ctx);\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\telse\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\t idn_testsuite_run(ctx, argv + 1);\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\tprintf(\"passed=%d, failed=%d, total=%d\\n\",\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\t idn_testsuite_npassed(ctx),\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\t idn_testsuite_nfailed(ctx),\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\t idn_testsuite_ntestcases(ctx) - idn_testsuite_nskipped(ctx));\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\tidn_testsuite_destroy(ctx);\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\treturn (0);\n"
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews . "\}\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews output_lines($main_footer, $generator, $handle, $lineinfo);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $handle->close();
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub output_lines {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($lines, $generator, $handle, $lineinfo) = @_;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews my ($line);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews chomp($lines);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $lines .= "\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews while ($lines ne '') {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $lines =~ s/^([^\n]*)\n//;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $line = $1;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $generator->{lineno}++;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($line eq $LINENO_MARK) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews if ($lineinfo) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $handle->printf("#line %d \"%s\"\n", $generator->{lineno} + 1,
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $generator->{file});
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews } else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $handle->print("$line\n");
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews }
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewssub output_usage {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews warn "$0: [-o output-file] input-file\n";
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews# main.
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews#
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsmy (%options);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsif (!getopts('Lo:', \%options)) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews output_usage;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews exit(1);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsif (@ARGV != 1) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews output_usage;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews exit(1);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsmy ($in_file) = $ARGV[0];
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsmy ($out_file);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsif (!defined($options{o})) {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $out_file = $in_file;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $out_file .= '\.tsy' if ($out_file !~ /\.tsy$/);
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $out_file =~ s/\.tsy$/\.c/;
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews} else {
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews $out_file = $options{o};
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews}
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsmy $testsuite = new_testsuite();
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsparse_file($testsuite, $in_file, !$options{L});
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsoutput_tests($testsuite, $out_file, !$options{L});
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrews
5c526acb82c882e41b655c31f5fa4425c87b671cMark Andrewsexit(0);