#!/usr/bin/env perl
#
# opp_test: regression testing tool for OMNeT++/OMNEST
#
use File::Path;
use File::Basename;

# Note: use of perl modules (e.g. cwd.pm) is avoided, because we don't want
# to install a full-blown perl on windows, only a perl.exe
sub cwd {
   my $d=`pwd` || die "error running `pwd' program: cannot determine name of current directory, exiting";
   chomp($d);
   $d =~ s/\r$//; # cygwin/mingw perl does not do CR/LF translation
   $d;
}

#
# If no args, print usage
#
$Usage = 'opp_test - OMNeT++/OMNEST Regression Test Tool, (c) 2002-2005 Andras Varga
See the license for distribution terms and warranty disclaimer.

Syntax: opp_test [-g|-r] [-v] [-d] [-w <dir>] <testcase-file> ...
  -g         generate (export) source files from test case files
  -r         run test (expects pre-built test executable)
  -v         verbose
  -d         very verbose (debug)
  -w <dir>   work directory (defaults to `./work\')
  -s <prog>  shell to use to run test program (not used on windows)
  -p <prog>  name of test program (defaults to name of work directory)
  -a <args>  extra command-line arguments for the test program. You may need
             to use quotes: opp_test -a "-f extrasettings.ini"

Usage in nutshell:
   1. create *.test files
   2. run opp_test with -g option to generate the source files from *.test
   3. create a makefile (opp_makemake) and build the test program
   4. run opp_test with -r option to execute the tests

All files will be created in the work directory.

Supported .test file entry types: (legend: 1=may occur once, v=value expected,
b=has body, f=value is filename)
';

# .test file possible entries. legend: 1=once, v=has value, b=has body, f=value is filename
%Entries = (
    'description'        => '1b',

    'activity'           => '1b',
    'includes'           => '1b',
    'global'             => '1b',
    'module'             => '1vb',
    'module_a'           => '1vb',
    'module_b'           => '1vb',

    'file'               => 'vbf',
    'inifile'            => '1vbf',
    'network'            => '1v',

    'subst'              => 'v',

    'contains'           => 'vbf',
    'not-contains'       => 'vbf',
    'contains-regex'     => 'vbf',
    'not-contains-regex' => 'vbf',

    'file-exists'        => 'vf',
    'file-not-exists'    => 'vf',

    'env'                => 'v',
    'testprog'           => '1v',
    'extraargs'          => '1v',
    'exitcode'           => '1v',
    'ignore-exitcode'    => '1v',

    'postprocess-script' => 'vbf'
);

#
#  Parse the command line for options and files.
#
@filenames = ();
$mode='';
$workdir = 'work';
$shell='/bin/sh';
$testprogram='';
$extraargs='';
$verbose=0;
$debug=0;

$arg0 = "opp_test";

if ($#ARGV == -1)
{
    print $Usage;
    foreach my $i (sort keys(%Entries)) {
        print "   \%$i:\t($Entries{$i})\n";
    }
    exit;
}

while (@ARGV)
{
    $arg = shift @ARGV;

    if ($arg eq "-v") {
        $verbose=1;
    }
    elsif ($arg eq "-d") {
        $debug=1;
    }
    elsif ($arg eq "-w") {
        $workdir = shift @ARGV;
    }
    elsif ($arg eq "-s") {
        $shell = shift @ARGV;
    }
    elsif ($arg eq "-p") {
        $testprogram = shift @ARGV;
    }
    elsif ($arg eq "-a") {
        $extraargs = shift @ARGV;
    }
    elsif ($arg eq "-g") {
        $mode = 'gen';
    }
    elsif ($arg eq "--generate-files") {
        $mode = 'gen';
    }
    elsif ($arg eq "-r") {
        $mode = 'run';
    }
    elsif ($arg eq "--run") {
        $mode = 'run';
    }
    elsif ($arg eq "-c") {
        $mode = 'check';
    }
    elsif ($arg eq "--check") {
        $mode = 'check';
    }
    elsif ($arg =~ /^-/) {
        print STDERR "$arg0: error: unknown option $arg\n";
        exit(1);
    }
    else {
        # glob() is called for the sake of Windows
        push(@filenames,glob($arg));
    }
}

if ($mode eq '')
{
    print STDERR "$arg0: error: mode argument missing (-g, -r)\n"; # or -c
    exit(1);
}

# are we on Windows?
$isMINGW = defined $ENV{MSYSTEM} && $ENV{MSYSTEM} =~ /mingw/i;
$isWindows = ($ENV{'OS'} =~ /windows/i) ? 1 : 0;

if ($isWindows && $workdir ne 'work') {
    print STDERR "$arg0: error: on Windows, work directory MUST be the `work' subdir\n";
    exit(1);
}

# test existence of work directory
if (! -d $workdir) {
    print STDERR "$arg0: error: work directory `$workdir' does not exist\n";
    exit(1);
}

# produce name of test program (only used for tests not containing '%testprog')
if ($testprogram eq '') {
    $workdir =~ /([^\/\\]*)$/;
    $tmp = $1;
    if ($isWindows) {
        $testprogram = $tmp . ".exe";
    } else {
        $testprogram = "./" . $tmp;
    }
}

# save environment variables (tests may overwrite them)
foreach my $envvar (keys(%ENV)) {
    $savedENV{$envvar} = $ENV{$envvar};
}

#
# generate test files
#
if ($mode eq 'gen')
{
    print "$arg0: extracting files from *.test files into $workdir...\n";

    define_templates();

    foreach $testfilename (@filenames)
    {
        testcase_generatesources($testfilename);
    }
}

#
# run tests
#
if ($mode eq 'run' || $mode eq 'check')
{
    print "$arg0: running tests using $testprogram...\n" if ($mode eq 'run');
    print "$arg0: checking existing output files...\n" if ($mode eq 'check');

    $num_pass = 0;
    $num_fail = 0;
    $num_unresolved = 0;

    @unresolved_tests = ();
    @failed_tests = ();

    foreach $testfilename (@filenames)
    {
        testcase_run($testfilename);
    }

    print "========================================\n";
    print "PASS: $num_pass   FAIL: $num_fail   UNRESOLVED: $num_unresolved\n";

    if ($num_fail>0 && $verbose) {
        print "FAILED tests: ".join(' ', @failed_tests)."\n";
    }
    if ($num_unresolved>0 && $verbose) {
        print "UNRESOLVED tests: ".join(' ', @unresolved_tests)."\n";
    }
}

sub parse_testfile
{
    my $testfilename = shift;

    undef %bodies;
    undef %values;
    undef %count;

    print "  parsing $testfilename\n" if ($debug);

    # assign a test name (filename without extension, special chars removed)
    $testfilename =~ /([^\/\\]*)$/;
    $testname = $1;
    $testname =~ s/\.[^.]*$//;
    $testname =~ s/[^A-Za-z0-9_]/_/g;
    print "  testname for `$testfilename' is $testname\n" if ($debug);

    # read test file
    if (!open(IN,$testfilename)) {
        print STDERR "$arg0: error: cannot open test file `$testfilename'\n"; exit(1);
    }

    $body = '';
    $key_index = '';
    while (<IN>)
    {
        s/[\r\n]*$//;
        if (/^%#/) {
            # ignore
        } elsif (/^%/) {
            $bodies{$key_index} = $body;
            $body = '';

            /^%([^:]*):?(.*?)$/;
            $key = $1;
            $value =$2;
            $key =~ s/^\s*(.*?)\s*$/$1/;
            $value =~ s/^\s*(.*?)\s*$/$1/;

            $count{$key}++;
            $key_index = $key.'('.$count{$key}.')';
            $values{$key_index} = $value;
        } else {
            $body .= $_."\n";
        }
    }
    $bodies{$key_index} = $body;
    close(IN);

    # check entries
    foreach $key_index (keys(%values))
    {
        $key_index =~ /(.*)\((.*)\)/;
        $key = $1;
        $index = $2;
        $desc = $Entries{$key};
        if ($desc eq '') {
            print STDERR "$arg0: error in test file `$testfilename': invalid entry `%$key'\n"; exit(1);
        }
        if ($desc =~ /1/ && $index>1) {
            print STDERR "$arg0: error in test file `$testfilename': entry `%$key' should occur only once.\n"; exit(1);
        }
        if ($desc =~ /v/ && $values{$key_index} =~ /^\s*$/) {
            print STDERR "$arg0: error in test file `$testfilename': entry `%$key' expects value after ':'\n"; exit(1);
        }
        if (!$desc =~ /v/ && !$values{$key_index} =~ /\s*/) {
            print STDERR "$arg0: error in test file `$testfilename': entry `%$key' expects nothing after ':'\n"; exit(1);
        }
        if (!$desc =~ /b/ && !$bodies{$key_index} =~ /\s*/) {
            print STDERR "$arg0: error in test file `$testfilename': entry `%$key' expects no body\n"; exit(1);
        }
    }

    # additional manual tests
    if (defined($bodies{'activity(1)'}) && (defined($bodies{'module(1)'}) ||
        defined($bodies{'module_a(1)'}) || defined($bodies{'module_b(1)'})))
    {
        print STDERR "$arg0: error in test file `$testfilename': %activity excludes %module... entries\n"; exit(1);
    }
    if (defined($bodies{'module(1)'}) &&
        (defined($bodies{'module_a(1)'}) || defined($bodies{'module_b(1)'})))
    {
        print STDERR "$arg0: error in test file `$testfilename': %module excludes %module_[a|b] entries\n"; exit(1);
    }
    if (defined($bodies{'module_a(1)'}) && !defined($bodies{'module_b(1)'}))
    {
        print STDERR "$arg0: error in test file `$testfilename': %module_a without %module_b\n"; exit(1);
    }
    if (defined($bodies{'module_b(1)'}) && !defined($bodies{'module_a(1)'}))
    {
        print STDERR "$arg0: error in test file `$testfilename': %module_b without %module_a\n"; exit(1);
    }

    # substitute TESTNAME and other macros, kill comments
    foreach $key (keys(%values))
    {
        $bodies{$key} =~ s/^%#.*?$//mg;

        $values{$key} =~ s/\@TESTNAME\@/$testname/g;
        $bodies{$key} =~ s/\@TESTNAME\@/$testname/g;
    }
}

sub testcase_generatesources
{
    my $testfilename = shift;

    parse_testfile($testfilename);

    print "  generating files for `$testfilename':\n" if ($debug);

    # generate "package.ned"
    $ned = $PackageNEDTemplate;
    $ned =~ s/\@TESTNAME\@/$testname/g;
    $nedfname = $workdir."/".$testname."/package.ned";
    writefile($nedfname, $ned);

    # let the user specify the network explicitly
    $networkname = $values{'network(1)'} ? $values{'network(1)'} : "Test";

    # 'activity' template
    if (defined($bodies{'activity(1)'}))
    {
        $module = $networkname;
        $activity = $bodies{'activity(1)'};
        $includescode = $bodies{'includes(1)'};
        $globalcode = $bodies{'global(1)'};

        # generate NED
        $ned = $ModuleNEDTemplate;
        $ned =~ s/\@TESTNAME\@/$testname/g;
        $ned =~ s/\@MODULE\@/$module/g;
        $nedfname = $workdir."/".$testname."/test.ned";
        writefile($nedfname, $ned);

        # generate C++
        $cpp = $ActivityCPPTemplate;
        $cpp =~ s/\@TESTNAME\@/$testname/g;
        $cpp =~ s/\@MODULE\@/$module/g;
        $cpp =~ s/\@INCLUDES\@/$includescode/g;
        $cpp =~ s/\@GLOBAL\@/$globalcode/g;
        $cpp =~ s/\@ACTIVITY\@/$activity/g;
        $cppfname = $workdir."/".$testname."/test.cc";
        writefile($cppfname, $cpp);
    }

    # 'module' template
    if (defined($bodies{'module(1)'}))
    {
        $module = $values{'module(1)'};
        $module_src = $bodies{'module(1)'};
        $networkname = $module;
        $includescode = $bodies{'includes(1)'};
        $globalcode = $bodies{'global(1)'};

        # generate NED
        $ned = $ModuleNEDTemplate;
        $ned =~ s/\@TESTNAME\@/$testname/g;
        $ned =~ s/\@MODULE\@/$module/g;
        $nedfname = $workdir."/".$testname."/test.ned";
        writefile($nedfname, $ned);

        # generate C++
        $cpp = $ModuleCPPTemplate;
        $cpp =~ s/\@TESTNAME\@/$testname/g;
        $cpp =~ s/\@INCLUDES\@/$includescode/g;
        $cpp =~ s/\@MODULE\@/$module/g;
        $cpp =~ s/\@MODULE_SRC\@/$module_src/g;
        $cppfname = $workdir."/".$testname."/test.cc";
        writefile($cppfname, $cpp);
    }

    # 'module_a' + 'module_b' template
    if (defined($bodies{'module_a(1)'}))
    {
        $module_a = $values{'module_a(1)'};
        $module_b = $values{'module_b(1)'};
        $module_a_src = $bodies{'module_a(1)'};
        $module_b_src = $bodies{'module_b(1)'};
        $includescode = $bodies{'includes(1)'};
        $globalcode = $bodies{'global(1)'};

        # generate NED
        $ned = $ModuleABNEDTemplate;
        $ned =~ s/\@TESTNAME\@/$testname/g;
        $ned =~ s/\@NETWORKNAME\@/$networkname/g;
        $ned =~ s/\@MODULE_A\@/$module_a/g;
        $ned =~ s/\@MODULE_B\@/$module_b/g;
        $nedfname = $workdir."/".$testname."/test.ned";
        writefile($nedfname, $ned);

        # generate C++
        $cpp = $ModuleABCPPTemplate;
        $cpp =~ s/\@TESTNAME\@/$testname/g;
        $cpp =~ s/\@INCLUDES\@/$includescode/g;
        $cpp =~ s/\@MODULE_A\@/$module_a/g;
        $cpp =~ s/\@MODULE_B\@/$module_b/g;
        $cpp =~ s/\@MODULE_A_SRC\@/$module_a_src/g;
        $cpp =~ s/\@MODULE_B_SRC\@/$module_b_src/g;
        $cppfname = $workdir."/".$testname."/test.cc";
        writefile($cppfname, $cpp);
    }

    # ini file
    $inifname = $values{'inifile(1)'};
    if ($inifname eq '') {
        $inifname = "test.ini";
    }
    $inifname = $workdir."/".$testname."/".$inifname;

    $inifile = $bodies{'inifile(1)'};
    if ($inifile =~ /^\s*$/s)
    {
        $inifile = $INITemplate;
        $inifile =~ s/\@TESTNAME\@/$testname/g;
        $inifile =~ s/\@NETWORKNAME\@/$networkname/g;
    }
    writefile($inifname, $inifile);

    # source files (export them after the templated files,
    # so that user can overwrite them if needed)
    foreach $key (keys(%values))
    {
        if ($key =~ /^file\([0-9]+\)/)
        {
            # write out file
            my $fname = $workdir."/".$testname."/".$values{$key};
            writefile($fname, $bodies{$key});
        }
    }

    # export post-process scripts
    foreach $key (keys(%values))
    {
        if ($key =~ /^postprocess-script\(/)
        {
            my $fname = $workdir."/".$testname."/".$values{$key};
            my $txt = $bodies{$key}; 
            writefile($fname, $txt);
            chmod 0755, $fname;
        }
    }
}

sub testcase_run()
{
    my $testfilename = shift;

    parse_testfile($testfilename);

    $outfname = "test.out";
    $errfname = "test.err";

    if ($mode eq 'run')
    {
        # delete temp files before running the test case
        foreach $key (keys(%values))
        {
            if ($key =~ /^contains/)  # any form of "contains-..."
            {
                # read file
                if ($values{$key} eq 'stdout') {
                    $infname = $outfname;
                }
                elsif ($values{$key} eq 'stderr') {
                    $infname = $errfname;
                }
                else {
                    $infname = $testname."/".$values{$key};
                }
                my $isgenerated = !($infname =~ /\.(cc|h|msg|ned|ini)$/);
                if ($isgenerated && -f $workdir."/".$infname) {
                    print "  deleting old copy of file `$infname'\n" if ($debug);
                    unlink $workdir."/".$infname;
                }
            }
        }
    }

    # ini file
    $inifname = $values{'inifile(1)'};
    if ($inifname eq '') {
        $inifname = "test.ini";
    }

    # restore original env vars
    foreach my $envvar (keys(%ENV)) {delete $ENV{$envvar};}
    foreach my $envvar (keys(%savedENV)) {$ENV{$envvar} = $savedENV{$envvar};}

    # set environment variables
    foreach $key (keys(%values))
    {
        if ($key =~ /^env\b/)
        {
            my $tmp = $values{$key};
            $tmp =~ /(.*?)=(.*)/;
            my $envvar = $1;
            my $value = $2;
            $ENV{$envvar} = $value;
            print "  setting environment variable `$envvar' = `$value'\n" if ($debug);
        }
    }

    # run the program
    if ($mode eq 'run') {
        my $myargs = $values{'extraargs(1)'};
        if ($values{'testprog(1)'} ne '') {
            $exitcode = exec_program($values{'testprog(1)'}." $myargs $extraargs", "$workdir/$testname", $outfname, $errfname);
        }
        else {
            if (! -f "$workdir/$testprogram") {
                print STDERR "$arg0: error: test program '$workdir/$testprogram' not found\n"; exit(1);
            }
            if (!$isWindows && ! -x "$workdir/$testprogram") {
                print STDERR "$arg0: error: test program '$workdir/$testprogram' is not executable\n"; exit(1);
            }
            $sep = $isWindows ? "\\" : "/";
            $exitcode = exec_program("..$sep$testprogram -u Cmdenv $myargs $extraargs -f $inifname", "$workdir/$testname", $outfname, $errfname);
        }
        if ($exitcode != 0) {
            if ($exitcode == -1) {
                unresolved($testfilename, "could not execute test program");
                return;
            } else {
                if ($values{'ignore-exitcode(1)'}) {
                    print "  ignoring exitcode\n" if ($debug);
                } elsif ($values{'exitcode(1)'} =~ /\b$exitcode\b/) {
                    print "  exitcode ok ($exitcode)\n" if ($debug);
                } elsif ($values{'exitcode(1)'} ne '') {
                    fail($testfilename, "test program returned exit code $exitcode instead of $values{'exitcode(1)'}");
                    print_tail("stdout", $workdir."/".$testname."/".$outfname) if ($verbose);
                    print_tail("stderr", $workdir."/".$testname."/".$errfname) if ($verbose);
                    return;
                } else {
                    fail($testfilename, "test program returned nonzero exit code: $exitcode");
                    print_tail("stdout", $workdir."/".$testname."/".$outfname) if ($verbose);
                    print_tail("stderr", $workdir."/".$testname."/".$errfname) if ($verbose);
                    return;
                }
            }
        }
    }

    # if stdout contains "#UNRESOLVED" or "#UNRESOLVED: some explanation", count this test as unresolved
    open(IN, $workdir."/".$testname."/".$outfname);
    while (<IN>) {
        if (/^#UNRESOLVED:? *(.*)/) {
            unresolved($testfilename, "test program says UNRESOLVED: $1");
            close(IN);
            return;
       }
    }
    close(IN);

    # execute post-process scripts
    if ($mode eq 'run')
    {
        foreach $key (keys(%values))
        {
            if ($key =~ /^postprocess-script\(/)
            {
                # execute file
                # TODO get it to work on windows
                my $exitcode = exec_program("./$values{$key}", "$workdir/$testname", $values{$key}.".out", $values{$key}.".err");
                if ($exitcode != 0) {
                    unresolved($testfilename, "post-process script $values{$key} returned nonzero exit code");
                    return;
                }
            }
        }
    }

    # check output files
    foreach $key (keys(%values))
    {
        if ($key =~ /contains/)  # any form of "...contains..."
        {
            # read file
            if ($values{$key} eq 'stdout') {
                $infname = $outfname;
            }
            elsif ($values{$key} eq 'stderr') {
                $infname = $errfname;
            }
            else {
                $infname = $values{$key};
            }

            print "  checking $infname\n" if ($debug);

            if (!open(IN,$workdir."/".$testname."/".$infname)) {
                unresolved($testfilename, "cannot read test case output file `$infname'");
                return;
            }
            $txt = '';
            while (<IN>)
            {
                s/ *[\r\n]*$//;
                $txt.= $_."\n";
            }
            close IN;

            # do substitutions on it
            foreach my $key2 (keys(%values)) {
                if ($key2 =~ /^subst/) {
                    my $rule = $values{$key2};  # something like "/foo/bar/"
                    my $sep = substr($rule, 0, 1);  # typically "/"
                    if (!($rule =~ /^$sep(.*?)$sep(.*?)$sep(.*)$/)) {
                        unresolved($testfilename, "wrong subst rule: syntax is /search-regex/replace-string/flags");
                        return;
                    }
                    my $searchstring = $1;
                    my $replacement = $2;
                    my $flags = $3;
                    if ($flags =~ /$sep/) {
                        unresolved($testfilename, "wrong subst rule: too many occurrences of separator character '$sep', choose another separator");
                        return;
                    }
                    if (!($flags =~ /^[ism]*$/)) {
                        unresolved($testfilename, "wrong subst rule: invalid flags '$flags': only 'i', 's' and 'm' supported ('g' is implicit)");
                        return;
                    }

                    # do it.
                    #
                    # Note: this is wrong (does not recognize $1 or \1 in the replacement string): $txt =~ s/(?$flags)$searchstring/$replacement/g;
                    # XXX: the following solution does not like curly braces in the search or replacement strings...
                    # Note: g cannot be written as (?g)
                    if (!(defined eval("\$txt =~ s{(?$flags)$searchstring}{$replacement}g"))) {
                        unresolved($testfilename, "%subst: wrong find or replace pattern");
                        return;
                    }
                }
            }

            # get pattern
            $pattern = $bodies{$key};
            $pattern =~ s/^\s*(.*?)\s*$/$1/s; # trim pattern

            writefile($workdir."/".$testname."/test-$key.txt", $pattern);

            # check contains or not-contains
            if ($key =~ /^contains-regex\(/) {
                if (!($txt =~ /$pattern/s)) {
                   fail($testfilename, "$values{$key} fails \%$key rule");
                   if (length($txt)<=8192) {
                      print "expected pattern:\n>>>>$pattern<<<<\nactual output:\n>>>>$txt<<<<\n" if ($verbose);
                   } else {
                      print "expected pattern:\n>>>>$pattern<<<<\nactual output too big to dump (>8K), see file in work directory\n" if ($verbose);
                   }
                   return;
                }
            }
            if ($key =~ /^not-contains-regex\(/) {
                if ($txt =~ /$pattern/s) {
                   fail($testfilename, "$values{$key} fails \%$key rule");
                   if (length($txt)<=8192) {
                      print "expected pattern:\n>>>>$pattern<<<<\nactual output:\n>>>>$txt<<<<\n" if ($verbose);
                   } else {
                      print "expected pattern:\n>>>>$pattern<<<<\nactual output too big to dump (>8K), see file in work directory\n" if ($verbose);
                   }
                   return;
                }
            }
            if ($key =~ /^contains\(/) {
                if (!($txt =~ /\Q$pattern\E/s)) {
                   fail($testfilename, "$values{$key} fails \%$key rule");
                   if (length($txt)<=8192) {
                      print "expected substring:\n>>>>$pattern<<<<\nactual output:\n>>>>$txt<<<<\n" if ($verbose);
                   } else {
                      print "expected substring:\n>>>>$pattern<<<<\nactual output too big to dump (>8K), see file in work directory\n" if ($verbose);
                   }
                   return;
                }
            }
            if ($key =~ /^not-contains\(/) {
                if ($txt =~ /\Q$pattern\E/s) {
                   fail($testfilename, "$values{$key} fails \%$key rule");
                   if (length($txt)<=8192) {
                      print "expected substring:\n>>>>$pattern<<<<\nactual output:\n>>>>$txt<<<<\n" if ($verbose);
                   } else {
                      print "expected substring:\n>>>>$pattern<<<<\nactual output too big to dump (>8K), see file in work directory\n" if ($verbose);
                   }
                   return;
                }
            }
        }
        elsif ($key =~ /file-exists/) {
            if (!(-e $workdir."/".$testname."/".$values{$key})) {
                fail($testfilename, "$values{$key} fails \%$key rule");
                return;
            }
        }
        elsif ($key =~ /file-not-exists/) {
            if (-e $workdir."/".$testname."/".$values{$key}) {
                fail($testfilename, "$values{$key} fails \%$key rule");
                return;
            }
        }
    }
    pass($testfilename);
}

sub print_tail()
{
    my $label = shift;
    my $fname = shift;

    if (!open(IN,$fname)) {
        print "cannot open `$fname'\n";
        return;
    }
    seek(IN,-500,2);
    $istail=0;
    if (tell(IN)>0) {
         $istail=1;
         <IN>;  # skip incomplete line
    }
    $txt = '';
    while (<IN>)
    {
        $txt .= $_;
    }
    close IN;

    if ($txt ne '') {
        print ($istail ? "tail of $label:\n" : "$label:\n");
        print ">>>>$txt<<<<\n";
    }
}

sub unresolved()
{
    my $testname = shift;
    my $reason = shift;
    $num_unresolved++;
    push (@unresolved_tests, $testname);
    $result{$testname} = 'UNRESOLVED';
    $reason{$testname} = $reason;
    print "*** $testname: UNRESOLVED ($reason)\n";
}

sub fail()
{
    my $testname = shift;
    my $reason = shift;
    $num_fail++;
    push (@failed_tests, $testname);
    $result{$testname} = 'FAIL';
    $reason{$testname} = $reason;
    print "*** $testname: FAIL ($reason)\n";
}

sub pass()
{
    my $testname = shift;
    $num_pass++;
    $result{$testname} = 'PASS';
    $reason{$testname} = '';
    print "*** $testname: PASS\n";
}

sub writefile()
{
    my $fname = shift;
    my $content = shift;

    # write file but preserve file date if it already existed with identical contents
    # (to speed up make process)

    my $skipwrite = 0;
    if (-r $fname) {
        if (!open(IN,$fname)) {
            print STDERR "$arg0: error: cannot read file `$fname'\n";
            exit(1);
        }
        my $oldcontent = '';
        while (<IN>) {
            chomp;
            s/\r$//; # cygwin/mingw perl does not do CR/LF translation
            $oldcontent.= $_."\n";
        }
        close(IN);

        if ($content eq $oldcontent) {
            $skipwrite = 1;
        }
    }

    if ($skipwrite) {
        print "  file `$fname' already exists with identical content\n" if ($debug);
    } else {
        print "  writing `$fname'\n" if ($debug);
        mkpath(dirname($fname));
        if (!open(OUT,">$fname")) {
            print STDERR "$arg0: error: cannot write file `$fname'\n";
            exit(1);
        }
        print OUT $content;
        close OUT;
    }
}


# args: command, work-directory, stdout-file, stderr-file
# return: exit code, or -1 if program crashed
sub exec_program()
{
    my $cmd = shift;
    my $dir = shift;
    my $outfile = shift;
    my $errfile = shift;

    if ($isWindows)
    {
        if ($workdir ne 'work') {die 'on windows, workdir MUST be ./work!';}

        print "  chdir to \"$dir\"\n" if ($debug);
        if (!chdir($dir))
        {
            print "  cannot chdir to \"$dir\"\n" if ($debug);
            return -1;
        }
        print "  running \"$cmd >$outfile 2>$errfile\"\n" if ($debug);
        # The following line mysteriously fails to redirect on some Windows configuration.
        # This can be observed together with cvs reporting "editor session fails" -- root cause is common?
        #$status = system ("$cmd >$outfile 2>$errfile");
        $shell = $ENV{'COMSPEC'};
        if ($shell eq "") {
            print STDERR "$arg0: WARNING: no %COMSPEC% environment variable, using cmd.exe\n";
            $shell = "cmd.exe";
        }
        # On the next line, cmd.exe may fail to pass back program exit code.
        # When this happens, use the above (commented out) "system" line.
        if ($isMINGW) {
            $status = system($shell, "/c","$cmd >$outfile 2>$errfile");
        } else {
            $status = system($shell, split(" ", "/c $cmd >$outfile 2>$errfile"));
        }
        print "  returned status = $status\n" if ($debug);
        print "  restoring dir \"$savedir\"\n" if ($debug);
        if (!chdir("../.."))
        {
            print "  cannot chdir back\n" if ($debug);
            return -1;
        }
        if ($status == 0)
        {
            return 0;
        }
        elsif (256*int($status/256) != $status)
        {
            # this will never happen on Windows: if program doesn't exist, 256 is returned...
            return -1;
        }
        else
        {
            return $status/256;
        }

    }
    else
    {
        print "  running \"$shell -c 'cd $dir && $cmd' >$dir/$outfile 2>$dir/$errfile\"\n" if ($debug);
        $status = system ("$shell -c 'cd $dir && $cmd' >$dir/$outfile 2>$dir/$errfile");
        print "  returned status = $status\n" if ($debug);
        if ($status == 0)
        {
            return 0;
        }
        elsif (256*int($status/256) != $status)
        {
            return -1;
        }
        else
        {
            return $status/256;
        }
    }
}


sub define_templates()
{
    $PackageNEDTemplate = '
@namespace(@TESTNAME@);
';

    $ModuleNEDTemplate = '
simple @MODULE@
{
    @isNetwork(true);
}
';

    $ModuleABNEDTemplate = '
simple @MODULE_A@
{
    gates:
        input in;
        output out;
}

simple @MODULE_B@
{
    gates:
        input in;
        output out;
}

network @NETWORKNAME@
{
    submodules:
        the@MODULE_A@ : @MODULE_A@;
        the@MODULE_B@ : @MODULE_B@;
    connections:
        the@MODULE_A@.out --> the@MODULE_B@.in;
        the@MODULE_A@.in  <-- the@MODULE_B@.out;
}
';

    $ActivityCPPTemplate = '
#include <omnetpp.h>

@INCLUDES@

namespace @TESTNAME@ {

@GLOBAL@

class @MODULE@ : public cSimpleModule
{
    public:
        @MODULE@() : cSimpleModule(16384) {}
        virtual void activity();
};

Define_Module(@MODULE@);

void @MODULE@::activity()
{
@ACTIVITY@
}

}; //namespace
';

    $ModuleCPPTemplate = '
#include <omnetpp.h>

@INCLUDES@

namespace @TESTNAME@ {

@MODULE_SRC@

}; //namespace
';

    $ModuleABCPPTemplate = '
#include <omnetpp.h>

@INCLUDES@

namespace @TESTNAME@ {

@MODULE_A_SRC@

@MODULE_B_SRC@

}; //namespace
';

    $INITemplate = '
[General]
network = @NETWORKNAME@
cmdenv-express-mode = false
output-vector-file = test.vec
output-scalar-file = test.sca
';
}

