Statistics
| Branch: | Revision:

root / src / utils / opp_test @ master

History | View | Annotate | Download (29 KB)

1 01873262 Georg Kunz
#!/usr/bin/env perl
2
#
3
# opp_test: regression testing tool for OMNeT++/OMNEST
4
#
5
use File::Path;
6
use File::Basename;
7
8
# Note: use of perl modules (e.g. cwd.pm) is avoided, because we don't want
9
# to install a full-blown perl on windows, only a perl.exe
10
sub cwd {
11
   my $d=`pwd` || die "error running `pwd' program: cannot determine name of current directory, exiting";
12
   chomp($d);
13
   $d =~ s/\r$//; # cygwin/mingw perl does not do CR/LF translation
14
   $d;
15
}
16
17
#
18
# If no args, print usage
19
#
20
$Usage = 'opp_test - OMNeT++/OMNEST Regression Test Tool, (c) 2002-2005 Andras Varga
21
See the license for distribution terms and warranty disclaimer.
22
23
Syntax: opp_test [-g|-r] [-v] [-d] [-w <dir>] <testcase-file> ...
24
  -g         generate (export) source files from test case files
25
  -r         run test (expects pre-built test executable)
26
  -v         verbose
27
  -d         very verbose (debug)
28
  -w <dir>   work directory (defaults to `./work\')
29
  -s <prog>  shell to use to run test program (not used on windows)
30
  -p <prog>  name of test program (defaults to name of work directory)
31
  -a <args>  extra command-line arguments for the test program. You may need
32
             to use quotes: opp_test -a "-f extrasettings.ini"
33
34
Usage in nutshell:
35
   1. create *.test files
36
   2. run opp_test with -g option to generate the source files from *.test
37
   3. create a makefile (opp_makemake) and build the test program
38
   4. run opp_test with -r option to execute the tests
39
40
All files will be created in the work directory.
41
42
Supported .test file entry types: (legend: 1=may occur once, v=value expected,
43
b=has body, f=value is filename)
44
';
45
46
# .test file possible entries. legend: 1=once, v=has value, b=has body, f=value is filename
47
%Entries = (
48
    'description'        => '1b',
49
50
    'activity'           => '1b',
51
    'includes'           => '1b',
52
    'global'             => '1b',
53
    'module'             => '1vb',
54
    'module_a'           => '1vb',
55
    'module_b'           => '1vb',
56
57
    'file'               => 'vbf',
58
    'inifile'            => 'vbf',
59
    'network'            => '1v',
60
61
    'subst'              => 'v',
62
63
    'contains'           => 'vbf',
64
    'not-contains'       => 'vbf',
65
    'contains-regex'     => 'vbf',
66
    'not-contains-regex' => 'vbf',
67
68
    'file-exists'        => 'vf',
69
    'file-not-exists'    => 'vf',
70
71
    'env'                => 'v',
72
    'testprog'           => '1v',
73
    'extraargs'          => '1v',
74
    'exitcode'           => '1v',
75
    'ignore-exitcode'    => '1v'
76
);
77
78
#
79
#  Parse the command line for options and files.
80
#
81
@filenames = ();
82
$mode='';
83
$workdir = 'work';
84
$shell='/bin/sh';
85
$testprogram='';
86
$extraargs='';
87
$verbose=0;
88
$debug=0;
89
90
$arg0 = "opp_test";
91
92
if ($#ARGV == -1)
93
{
94
    print $Usage;
95
    foreach my $i (sort keys(%Entries)) {
96
        print "   \%$i:\t($Entries{$i})\n";
97
    }
98
    exit;
99
}
100
101
while (@ARGV)
102
{
103
    $arg = shift @ARGV;
104
105
    if ($arg eq "-v") {
106
        $verbose=1;
107
    }
108
    elsif ($arg eq "-d") {
109
        $debug=1;
110
    }
111
    elsif ($arg eq "-w") {
112
        $workdir = shift @ARGV;
113
    }
114
    elsif ($arg eq "-s") {
115
        $shell = shift @ARGV;
116
    }
117
    elsif ($arg eq "-p") {
118
        $testprogram = shift @ARGV;
119
    }
120
    elsif ($arg eq "-a") {
121
        $extraargs = shift @ARGV;
122
    }
123
    elsif ($arg eq "-g") {
124
        $mode = 'gen';
125
    }
126
    elsif ($arg eq "--generate-files") {
127
        $mode = 'gen';
128
    }
129
    elsif ($arg eq "-r") {
130
        $mode = 'run';
131
    }
132
    elsif ($arg eq "--run") {
133
        $mode = 'run';
134
    }
135
    elsif ($arg eq "-c") {
136
        $mode = 'check';
137
    }
138
    elsif ($arg eq "--check") {
139
        $mode = 'check';
140
    }
141
    elsif ($arg =~ /^-/) {
142
        print STDERR "$arg0: error: unknown option $arg\n";
143
        exit(1);
144
    }
145
    else {
146
        # glob() is called for the sake of Windows
147
        push(@filenames,glob($arg));
148
    }
149
}
150
151
if ($mode eq '')
152
{
153
    print STDERR "$arg0: error: mode argument missing (-g, -r)\n"; # or -c
154
    exit(1);
155
}
156
157
# are we on Windows?
158
$isMINGW = defined $ENV{MSYSTEM} && $ENV{MSYSTEM} =~ /mingw/i;
159
$isWindows = ($ENV{'OS'} =~ /windows/i) ? 1 : 0;
160
161
if ($isWindows && $workdir ne 'work') {
162
    print STDERR "$arg0: error: on Windows, work directory MUST be the `work' subdir\n";
163
    exit(1);
164
}
165
166
# test existence of work directory
167
if (! -d $workdir) {
168
    print STDERR "$arg0: error: work directory `$workdir' does not exist\n";
169
    exit(1);
170
}
171
172
# produce name of test program (only used for tests not containing '%testprog')
173
if ($testprogram eq '') {
174
    $workdir =~ /([^\/\\]*)$/;
175
    $tmp = $1;
176
    if ($isWindows) {
177
        $testprogram = $tmp . ".exe";
178
    } else {
179
        $testprogram = "./" . $tmp;
180
    }
181
}
182
183
# save environment variables (tests may overwrite them)
184
foreach my $envvar (keys(%ENV)) {
185
    $savedENV{$envvar} = $ENV{$envvar};
186
}
187
188
#
189
# generate test files
190
#
191
if ($mode eq 'gen')
192
{
193
    print "$arg0: extracting files from *.test files into $workdir...\n";
194
195
    define_templates();
196
197
    foreach $testfilename (@filenames)
198
    {
199
        testcase_generatesources($testfilename);
200
    }
201
}
202
203
#
204
# run tests
205
#
206
if ($mode eq 'run' || $mode eq 'check')
207
{
208
    print "$arg0: running tests using $testprogram...\n" if ($mode eq 'run');
209
    print "$arg0: checking existing output files...\n" if ($mode eq 'check');
210
211
    $num_pass = 0;
212
    $num_fail = 0;
213
    $num_unresolved = 0;
214
215
    @unresolved_tests = ();
216
    @failed_tests = ();
217
218
    foreach $testfilename (@filenames)
219
    {
220
        testcase_run($testfilename);
221
    }
222
223
    print "========================================\n";
224
    print "PASS: $num_pass   FAIL: $num_fail   UNRESOLVED: $num_unresolved\n";
225
226
    if ($num_fail>0 && $verbose) {
227
        print "FAILED tests: ".join(' ', @failed_tests)."\n";
228
    }
229
    if ($num_unresolved>0 && $verbose) {
230
        print "UNRESOLVED tests: ".join(' ', @unresolved_tests)."\n";
231
    }
232
}
233
234
sub parse_testfile
235
{
236
    my $testfilename = shift;
237
238
    undef %bodies;
239
    undef %values;
240
    undef %count;
241
242
    print "  parsing $testfilename\n" if ($debug);
243
244
    # assign a test name (filename without extension, special chars removed)
245
    $testfilename =~ /([^\/\\]*)$/;
246
    $testname = $1;
247
    $testname =~ s/\.[^.]*$//;
248
    $testname =~ s/[^A-Za-z0-9_]/_/g;
249
    print "  testname for `$testfilename' is $testname\n" if ($debug);
250
251
    # read test file
252
    if (!open(IN,$testfilename)) {
253
        print STDERR "$arg0: error: cannot open test file `$testfilename'\n"; exit(1);
254
    }
255
256
    $body = '';
257
    $key_index = '';
258
    while (<IN>)
259
    {
260
        s/[\r\n]*$//;
261
        if (/^%#/) {
262
            # ignore
263
        } elsif (/^%/) {
264
            $bodies{$key_index} = $body;
265
            $body = '';
266
267
            /^%([^:]*):?(.*?)$/;
268
            $key = $1;
269
            $value =$2;
270
            $key =~ s/^\s*(.*?)\s*$/$1/;
271
            $value =~ s/^\s*(.*?)\s*$/$1/;
272
273
            $count{$key}++;
274
            $key_index = $key.'('.$count{$key}.')';
275
            $values{$key_index} = $value;
276
        } else {
277
            $body .= $_."\n";
278
        }
279
    }
280
    $bodies{$key_index} = $body;
281
    close(IN);
282
283
    # check entries
284
    foreach $key_index (keys(%values))
285
    {
286
        $key_index =~ /(.*)\((.*)\)/;
287
        $key = $1;
288
        $index = $2;
289
        $desc = $Entries{$key};
290
        if ($desc eq '') {
291
            print STDERR "$arg0: error in test file `$testfilename': invalid entry `%$key'\n"; exit(1);
292
        }
293
        if ($desc =~ /1/ && $index>1) {
294
            print STDERR "$arg0: error in test file `$testfilename': entry `%$key' should occur only once.\n"; exit(1);
295
        }
296
        if ($desc =~ /v/ && $values{$key_index} =~ /^\s*$/) {
297
            print STDERR "$arg0: error in test file `$testfilename': entry `%$key' expects value after ':'\n"; exit(1);
298
        }
299
        if (!$desc =~ /v/ && !$values{$key_index} =~ /\s*/) {
300
            print STDERR "$arg0: error in test file `$testfilename': entry `%$key' expects nothing after ':'\n"; exit(1);
301
        }
302
        if (!$desc =~ /b/ && !$bodies{$key_index} =~ /\s*/) {
303
            print STDERR "$arg0: error in test file `$testfilename': entry `%$key' expects no body\n"; exit(1);
304
        }
305
    }
306
307
    # additional manual tests
308
    if (defined($bodies{'activity(1)'}) && (defined($bodies{'module(1)'}) ||
309
        defined($bodies{'module_a(1)'}) || defined($bodies{'module_b(1)'})))
310
    {
311
        print STDERR "$arg0: error in test file `$testfilename': %activity excludes %module... entries\n"; exit(1);
312
    }
313
    if (defined($bodies{'module(1)'}) &&
314
        (defined($bodies{'module_a(1)'}) || defined($bodies{'module_b(1)'})))
315
    {
316
        print STDERR "$arg0: error in test file `$testfilename': %module excludes %module_[a|b] entries\n"; exit(1);
317
    }
318
    if (defined($bodies{'module_a(1)'}) && !defined($bodies{'module_b(1)'}))
319
    {
320
        print STDERR "$arg0: error in test file `$testfilename': %module_a without %module_b\n"; exit(1);
321
    }
322
    if (defined($bodies{'module_b(1)'}) && !defined($bodies{'module_a(1)'}))
323
    {
324
        print STDERR "$arg0: error in test file `$testfilename': %module_b without %module_a\n"; exit(1);
325
    }
326
327
    # substitute TESTNAME and other macros, kill comments
328
    foreach $key (keys(%values))
329
    {
330
        $bodies{$key} =~ s/^%#.*?$//mg;
331
332
        $values{$key} =~ s/\@TESTNAME\@/$testname/g;
333
        $bodies{$key} =~ s/\@TESTNAME\@/$testname/g;
334
    }
335
}
336
337
sub testcase_generatesources
338
{
339
    my $testfilename = shift;
340
341
    parse_testfile($testfilename);
342
343
    print "  generating files for `$testfilename':\n" if ($debug);
344
345
    # generate "package.ned"
346
    $ned = $PackageNEDTemplate;
347
    $ned =~ s/\@TESTNAME\@/$testname/g;
348
    $nedfname = $workdir."/".$testname."/package.ned";
349
    writefile($nedfname, $ned);
350
351
    # let the user specify the network explicitly
352
    $networkname = $values{'network(1)'} ? $values{'network(1)'} : "Test";
353
354
    # 'activity' template
355
    if (defined($bodies{'activity(1)'}))
356
    {
357
        $module = $networkname;
358
        $activity = $bodies{'activity(1)'};
359
        $includescode = $bodies{'includes(1)'};
360
        $globalcode = $bodies{'global(1)'};
361
362
        # generate NED
363
        $ned = $ModuleNEDTemplate;
364
        $ned =~ s/\@TESTNAME\@/$testname/g;
365
        $ned =~ s/\@MODULE\@/$module/g;
366
        $nedfname = $workdir."/".$testname."/test.ned";
367
        writefile($nedfname, $ned);
368
369
        # generate C++
370
        $cpp = $ActivityCPPTemplate;
371
        $cpp =~ s/\@TESTNAME\@/$testname/g;
372
        $cpp =~ s/\@MODULE\@/$module/g;
373
        $cpp =~ s/\@INCLUDES\@/$includescode/g;
374
        $cpp =~ s/\@GLOBAL\@/$globalcode/g;
375
        $cpp =~ s/\@ACTIVITY\@/$activity/g;
376
        $cppfname = $workdir."/".$testname."/test.cc";
377
        writefile($cppfname, $cpp);
378
    }
379
380
    # 'module' template
381
    if (defined($bodies{'module(1)'}))
382
    {
383
        $module = $values{'module(1)'};
384
        $module_src = $bodies{'module(1)'};
385
        $networkname = $module;
386
        $includescode = $bodies{'includes(1)'};
387
        $globalcode = $bodies{'global(1)'};
388
389
        # generate NED
390
        $ned = $ModuleNEDTemplate;
391
        $ned =~ s/\@TESTNAME\@/$testname/g;
392
        $ned =~ s/\@MODULE\@/$module/g;
393
        $nedfname = $workdir."/".$testname."/test.ned";
394
        writefile($nedfname, $ned);
395
396
        # generate C++
397
        $cpp = $ModuleCPPTemplate;
398
        $cpp =~ s/\@TESTNAME\@/$testname/g;
399
        $cpp =~ s/\@INCLUDES\@/$includescode/g;
400
        $cpp =~ s/\@MODULE\@/$module/g;
401
        $cpp =~ s/\@MODULE_SRC\@/$module_src/g;
402
        $cppfname = $workdir."/".$testname."/test.cc";
403
        writefile($cppfname, $cpp);
404
    }
405
406
    # 'module_a' + 'module_b' template
407
    if (defined($bodies{'module_a(1)'}))
408
    {
409
        $module_a = $values{'module_a(1)'};
410
        $module_b = $values{'module_b(1)'};
411
        $module_a_src = $bodies{'module_a(1)'};
412
        $module_b_src = $bodies{'module_b(1)'};
413
        $includescode = $bodies{'includes(1)'};
414
        $globalcode = $bodies{'global(1)'};
415
416
        # generate NED
417
        $ned = $ModuleABNEDTemplate;
418
        $ned =~ s/\@TESTNAME\@/$testname/g;
419
        $ned =~ s/\@NETWORKNAME\@/$networkname/g;
420
        $ned =~ s/\@MODULE_A\@/$module_a/g;
421
        $ned =~ s/\@MODULE_B\@/$module_b/g;
422
        $nedfname = $workdir."/".$testname."/test.ned";
423
        writefile($nedfname, $ned);
424
425
        # generate C++
426
        $cpp = $ModuleABCPPTemplate;
427
        $cpp =~ s/\@TESTNAME\@/$testname/g;
428
        $cpp =~ s/\@INCLUDES\@/$includescode/g;
429
        $cpp =~ s/\@MODULE_A\@/$module_a/g;
430
        $cpp =~ s/\@MODULE_B\@/$module_b/g;
431
        $cpp =~ s/\@MODULE_A_SRC\@/$module_a_src/g;
432
        $cpp =~ s/\@MODULE_B_SRC\@/$module_b_src/g;
433
        $cppfname = $workdir."/".$testname."/test.cc";
434
        writefile($cppfname, $cpp);
435
    }
436
437
    # ini file
438
    my @inifilekeys = ();
439
    foreach my $key (keys(%values)) {
440
        if ($key =~ /^inifile\([0-9]+\)/) {
441
            push(@inifilekeys,$key);
442
        }
443
    }
444
    if (!@inifilekeys) {
445
        # pretend there is an "%inifile: test.ini" line in the file
446
        my $key = "inifile0";
447
        push(@inifilekeys,$key);
448
        $values{$key} = "test.ini";
449
        $bodies{$key} = ""; # default content
450
    }
451
452
    foreach my $key (@inifilekeys)
453
    {
454
        my $inifname = $workdir."/".$testname."/".$values{$key};
455
        my $inifile = $bodies{$key};
456
        if ($inifile =~ /^\s*$/s) {
457
            $inifile = $INITemplate;
458
        }
459
        $inifile =~ s/\@TESTNAME\@/$testname/g;
460
        $inifile =~ s/\@NETWORKNAME\@/$networkname/g;
461
        writefile($inifname, $inifile);
462
    }
463
464
    # source files (export them after the templated files,
465
    # so that user can overwrite them if needed)
466
    foreach $key (keys(%values))
467
    {
468
        if ($key =~ /^file\([0-9]+\)/)
469
        {
470
            # write out file
471
            my $fname = $workdir."/".$testname."/".$values{$key};
472
            writefile($fname, $bodies{$key});
473
        }
474
    }
475
476
}
477
478
sub testcase_run()
479
{
480
    my $testfilename = shift;
481
482
    parse_testfile($testfilename);
483
484
    $outfname = "test.out";
485
    $errfname = "test.err";
486
487
    if ($mode eq 'run')
488
    {
489
        # delete temp files before running the test case
490
        foreach $key (keys(%values))
491
        {
492
            if ($key =~ /^contains/)  # any form of "contains-..."
493
            {
494
                # read file
495
                if ($values{$key} eq 'stdout') {
496
                    $infname = $outfname;
497
                }
498
                elsif ($values{$key} eq 'stderr') {
499
                    $infname = $errfname;
500
                }
501
                else {
502
                    $infname = $testname."/".$values{$key};
503
                }
504
                my $isgenerated = !($infname =~ /\.(cc|h|msg|ned|ini)$/);
505
                if ($isgenerated && -f $workdir."/".$infname) {
506
                    print "  deleting old copy of file `$infname'\n" if ($debug);
507
                    unlink $workdir."/".$infname;
508
                }
509
            }
510
        }
511
    }
512
513
    # restore original env vars
514
    foreach my $envvar (keys(%ENV)) {delete $ENV{$envvar};}
515
    foreach my $envvar (keys(%savedENV)) {$ENV{$envvar} = $savedENV{$envvar};}
516
517
    # set environment variables
518
    foreach $key (keys(%values))
519
    {
520
        if ($key =~ /^env\b/)
521
        {
522
            my $tmp = $values{$key};
523
            $tmp =~ /(.*?)=(.*)/;
524
            my $envvar = $1;
525
            my $value = $2;
526
            $ENV{$envvar} = $value;
527
            print "  setting environment variable `$envvar' = `$value'\n" if ($debug);
528
        }
529
    }
530
531
    # run the program
532
    if ($mode eq 'run') {
533
        my $myargs = $values{'extraargs(1)'};
534
535
        $inifilenames = '';
536
        foreach $key (sort(keys(%values)))
537
        {
538
            if ($key =~ /^inifile\([0-9]+\)/) {
539
                $inifilenames = $inifilenames." ".$values{$key};
540
            }
541
        }
542
        if ($inifilenames eq '') {
543
            $inifilenames = "test.ini";
544
        }
545
546
        if ($values{'testprog(1)'} ne '') {
547
            $exitcode = exec_program($values{'testprog(1)'}." $myargs $extraargs", "$workdir/$testname", $outfname, $errfname);
548
        }
549
        else {
550
            if (! -f "$workdir/$testprogram") {
551
                print STDERR "$arg0: error: test program '$workdir/$testprogram' not found\n"; exit(1);
552
            }
553
            if (!$isWindows && ! -x "$workdir/$testprogram") {
554
                print STDERR "$arg0: error: test program '$workdir/$testprogram' is not executable\n"; exit(1);
555
            }
556
            $sep = $isWindows ? "\\" : "/";
557
            $exitcode = exec_program("..$sep$testprogram -u Cmdenv $myargs $extraargs $inifilenames", "$workdir/$testname", $outfname, $errfname);
558
        }
559
        if ($exitcode != 0) {
560
            if ($exitcode == -1) {
561
                unresolved($testfilename, "could not execute test program");
562
                return;
563
            } else {
564
                if ($values{'ignore-exitcode(1)'}) {
565
                    print "  ignoring exitcode\n" if ($debug);
566
                } elsif ($values{'exitcode(1)'} =~ /\b$exitcode\b/) {
567
                    print "  exitcode ok ($exitcode)\n" if ($debug);
568
                } elsif ($values{'exitcode(1)'} ne '') {
569
                    fail($testfilename, "test program returned exit code $exitcode instead of $values{'exitcode(1)'}");
570
                    print_tail("stdout", $workdir."/".$testname."/".$outfname) if ($verbose);
571
                    print_tail("stderr", $workdir."/".$testname."/".$errfname) if ($verbose);
572
                    return;
573
                } else {
574
                    fail($testfilename, "test program returned nonzero exit code: $exitcode");
575
                    print_tail("stdout", $workdir."/".$testname."/".$outfname) if ($verbose);
576
                    print_tail("stderr", $workdir."/".$testname."/".$errfname) if ($verbose);
577
                    return;
578
                }
579
            }
580
        }
581
    }
582
583
    # if stdout contains "#UNRESOLVED" or "#UNRESOLVED: some explanation", count this test as unresolved
584
    open(IN, $workdir."/".$testname."/".$outfname);
585
    while (<IN>) {
586
        if (/^#UNRESOLVED:? *(.*)/) {
587
            unresolved($testfilename, "test program says UNRESOLVED: $1");
588
            close(IN);
589
            return;
590
       }
591
    }
592
    close(IN);
593
594
    # check output files
595
    foreach $key (keys(%values))
596
    {
597
        if ($key =~ /contains/)  # any form of "...contains..."
598
        {
599
            # read file
600
            if ($values{$key} eq 'stdout') {
601
                $infname = $outfname;
602
            }
603
            elsif ($values{$key} eq 'stderr') {
604
                $infname = $errfname;
605
            }
606
            else {
607
                $infname = $values{$key};
608
            }
609
610
            print "  checking $infname\n" if ($debug);
611
612
            if (!open(IN,$workdir."/".$testname."/".$infname)) {
613
                unresolved($testfilename, "cannot read test case output file `$infname'");
614
                return;
615
            }
616
            $txt = '';
617
            while (<IN>)
618
            {
619
                s/ *[\r\n]*$//;
620
                $txt.= $_."\n";
621
            }
622
            close IN;
623
624
            # do substitutions on it
625
            foreach my $key2 (keys(%values)) {
626
                if ($key2 =~ /^subst/) {
627
                    my $rule = $values{$key2};  # something like "/foo/bar/"
628
                    my $sep = substr($rule, 0, 1);  # typically "/"
629
                    if (!($rule =~ /^$sep(.*?)$sep(.*?)$sep(.*)$/)) {
630
                        unresolved($testfilename, "wrong subst rule: syntax is /search-regex/replace-string/flags");
631
                        return;
632
                    }
633
                    my $searchstring = $1;
634
                    my $replacement = $2;
635
                    my $flags = $3;
636
                    if ($flags =~ /$sep/) {
637
                        unresolved($testfilename, "wrong subst rule: too many occurrences of separator character '$sep', choose another separator");
638
                        return;
639
                    }
640
                    if (!($flags =~ /^[ism]*$/)) {
641
                        unresolved($testfilename, "wrong subst rule: invalid flags '$flags': only 'i', 's' and 'm' supported ('g' is implicit)");
642
                        return;
643
                    }
644
645
                    # do it.
646
                    #
647
                    # Note: this is wrong (does not recognize $1 or \1 in the replacement string): $txt =~ s/(?$flags)$searchstring/$replacement/g;
648
                    # XXX: the following solution does not like curly braces in the search or replacement strings...
649
                    # Note: g cannot be written as (?g)
650
                    if (!(defined eval("\$txt =~ s{(?$flags)$searchstring}{$replacement}g"))) {
651
                        unresolved($testfilename, "%subst: wrong find or replace pattern");
652
                        return;
653
                    }
654
                }
655
            }
656
657
            # get pattern
658
            $pattern = $bodies{$key};
659
            $pattern =~ s/^\s*(.*?)\s*$/$1/s; # trim pattern
660
661
            writefile($workdir."/".$testname."/test-$key.txt", $pattern);
662
663
            # check contains or not-contains
664
            if ($key =~ /^contains-regex\(/) {
665
                if (!($txt =~ /$pattern/s)) {
666
                   fail($testfilename, "$values{$key} fails \%$key rule");
667
                   if (length($txt)<=8192) {
668
                      print "expected pattern:\n>>>>$pattern<<<<\nactual output:\n>>>>$txt<<<<\n" if ($verbose);
669
                   } else {
670
                      print "expected pattern:\n>>>>$pattern<<<<\nactual output too big to dump (>8K), see file in work directory\n" if ($verbose);
671
                   }
672
                   return;
673
                }
674
            }
675
            if ($key =~ /^not-contains-regex\(/) {
676
                if ($txt =~ /$pattern/s) {
677
                   fail($testfilename, "$values{$key} fails \%$key rule");
678
                   if (length($txt)<=8192) {
679
                      print "expected pattern:\n>>>>$pattern<<<<\nactual output:\n>>>>$txt<<<<\n" if ($verbose);
680
                   } else {
681
                      print "expected pattern:\n>>>>$pattern<<<<\nactual output too big to dump (>8K), see file in work directory\n" if ($verbose);
682
                   }
683
                   return;
684
                }
685
            }
686
            if ($key =~ /^contains\(/) {
687
                if (!($txt =~ /\Q$pattern\E/s)) {
688
                   fail($testfilename, "$values{$key} fails \%$key rule");
689
                   if (length($txt)<=8192) {
690
                      print "expected substring:\n>>>>$pattern<<<<\nactual output:\n>>>>$txt<<<<\n" if ($verbose);
691
                   } else {
692
                      print "expected substring:\n>>>>$pattern<<<<\nactual output too big to dump (>8K), see file in work directory\n" if ($verbose);
693
                   }
694
                   return;
695
                }
696
            }
697
            if ($key =~ /^not-contains\(/) {
698
                if ($txt =~ /\Q$pattern\E/s) {
699
                   fail($testfilename, "$values{$key} fails \%$key rule");
700
                   if (length($txt)<=8192) {
701
                      print "expected substring:\n>>>>$pattern<<<<\nactual output:\n>>>>$txt<<<<\n" if ($verbose);
702
                   } else {
703
                      print "expected substring:\n>>>>$pattern<<<<\nactual output too big to dump (>8K), see file in work directory\n" if ($verbose);
704
                   }
705
                   return;
706
                }
707
            }
708
        }
709
        elsif ($key =~ /file-exists/) {
710
            if (!(-e $workdir."/".$testname."/".$values{$key})) {
711
                fail($testfilename, "$values{$key} fails \%$key rule");
712
                return;
713
            }
714
        }
715
        elsif ($key =~ /file-not-exists/) {
716
            if (-e $workdir."/".$testname."/".$values{$key}) {
717
                fail($testfilename, "$values{$key} fails \%$key rule");
718
                return;
719
            }
720
        }
721
    }
722
    pass($testfilename);
723
}
724
725
sub print_tail()
726
{
727
    my $label = shift;
728
    my $fname = shift;
729
730
    if (!open(IN,$fname)) {
731
        print "cannot open `$fname'\n";
732
        return;
733
    }
734
    seek(IN,-500,2);
735
    $istail=0;
736
    if (tell(IN)>0) {
737
         $istail=1;
738
         <IN>;  # skip incomplete line
739
    }
740
    $txt = '';
741
    while (<IN>)
742
    {
743
        $txt .= $_;
744
    }
745
    close IN;
746
747
    if ($txt ne '') {
748
        print ($istail ? "tail of $label:\n" : "$label:\n");
749
        print ">>>>$txt<<<<\n";
750
    }
751
}
752
753
sub unresolved()
754
{
755
    my $testname = shift;
756
    my $reason = shift;
757
    $num_unresolved++;
758
    push (@unresolved_tests, $testname);
759
    $result{$testname} = 'UNRESOLVED';
760
    $reason{$testname} = $reason;
761
    print "*** $testname: UNRESOLVED ($reason)\n";
762
}
763
764
sub fail()
765
{
766
    my $testname = shift;
767
    my $reason = shift;
768
    $num_fail++;
769
    push (@failed_tests, $testname);
770
    $result{$testname} = 'FAIL';
771
    $reason{$testname} = $reason;
772
    print "*** $testname: FAIL ($reason)\n";
773
}
774
775
sub pass()
776
{
777
    my $testname = shift;
778
    $num_pass++;
779
    $result{$testname} = 'PASS';
780
    $reason{$testname} = '';
781
    print "*** $testname: PASS\n";
782
}
783
784
sub writefile()
785
{
786
    my $fname = shift;
787
    my $content = shift;
788
789
    # write file but preserve file date if it already existed with identical contents
790
    # (to speed up make process)
791
792
    my $skipwrite = 0;
793
    if (-r $fname) {
794
        if (!open(IN,$fname)) {
795
            print STDERR "$arg0: error: cannot read file `$fname'\n";
796
            exit(1);
797
        }
798
        my $oldcontent = '';
799
        while (<IN>) {
800
            chomp;
801
            s/\r$//; # cygwin/mingw perl does not do CR/LF translation
802
            $oldcontent.= $_."\n";
803
        }
804
        close(IN);
805
806
        if ($content eq $oldcontent) {
807
            $skipwrite = 1;
808
        }
809
    }
810
811
    if ($skipwrite) {
812
        print "  file `$fname' already exists with identical content\n" if ($debug);
813
    } else {
814
        print "  writing `$fname'\n" if ($debug);
815
        mkpath(dirname($fname));
816
        if (!open(OUT,">$fname")) {
817
            print STDERR "$arg0: error: cannot write file `$fname'\n";
818
            exit(1);
819
        }
820
        print OUT $content;
821
        close OUT;
822
    }
823
}
824
825
826
# args: command, work-directory, stdout-file, stderr-file
827
# return: exit code, or -1 if program crashed
828
sub exec_program()
829
{
830
    my $cmd = shift;
831
    my $dir = shift;
832
    my $outfile = shift;
833
    my $errfile = shift;
834
835
    if ($isWindows)
836
    {
837
        if ($workdir ne 'work') {die 'on windows, workdir MUST be ./work!';}
838
839
        print "  chdir to \"$dir\"\n" if ($debug);
840
        if (!chdir($dir))
841
        {
842
            print "  cannot chdir to \"$dir\"\n" if ($debug);
843
            return -1;
844
        }
845
        print "  running \"$cmd >$outfile 2>$errfile\"\n" if ($debug);
846
        # The following line mysteriously fails to redirect on some Windows configuration.
847
        # This can be observed together with cvs reporting "editor session fails" -- root cause is common?
848
        #$status = system ("$cmd >$outfile 2>$errfile");
849
        $shell = $ENV{'COMSPEC'};
850
        if ($shell eq "") {
851
            print STDERR "$arg0: WARNING: no %COMSPEC% environment variable, using cmd.exe\n";
852
            $shell = "cmd.exe";
853
        }
854
        # On the next line, cmd.exe may fail to pass back program exit code.
855
        # When this happens, use the above (commented out) "system" line.
856
        if ($isMINGW) {
857
            $status = system($shell, "/c","$cmd >$outfile 2>$errfile");
858
        } else {
859
            $status = system($shell, split(" ", "/c $cmd >$outfile 2>$errfile"));
860
        }
861
        print "  returned status = $status\n" if ($debug);
862
        print "  restoring dir \"$savedir\"\n" if ($debug);
863
        if (!chdir("../.."))
864
        {
865
            print "  cannot chdir back\n" if ($debug);
866
            return -1;
867
        }
868
        if ($status == 0)
869
        {
870
            return 0;
871
        }
872
        elsif (256*int($status/256) != $status)
873
        {
874
            # this will never happen on Windows: if program doesn't exist, 256 is returned...
875
            return -1;
876
        }
877
        else
878
        {
879
            return $status/256;
880
        }
881
882
    }
883
    else
884
    {
885
        print "  running \"$shell -c 'cd $dir && $cmd' >$dir/$outfile 2>$dir/$errfile\"\n" if ($debug);
886
        $status = system ("$shell -c 'cd $dir && $cmd' >$dir/$outfile 2>$dir/$errfile");
887
        print "  returned status = $status\n" if ($debug);
888
        if ($status == 0)
889
        {
890
            return 0;
891
        }
892
        elsif (256*int($status/256) != $status)
893
        {
894
            return -1;
895
        }
896
        else
897
        {
898
            return $status/256;
899
        }
900
    }
901
}
902
903
904
sub define_templates()
905
{
906
    $PackageNEDTemplate = '
907
@namespace(@TESTNAME@);
908
';
909
910
    $ModuleNEDTemplate = '
911
simple @MODULE@
912
{
913
    @isNetwork(true);
914
}
915
';
916
917
    $ModuleABNEDTemplate = '
918
simple @MODULE_A@
919
{
920
    gates:
921
        input in;
922
        output out;
923
}
924
925
simple @MODULE_B@
926
{
927
    gates:
928
        input in;
929
        output out;
930
}
931
932
network @NETWORKNAME@
933
{
934
    submodules:
935
        the@MODULE_A@ : @MODULE_A@;
936
        the@MODULE_B@ : @MODULE_B@;
937
    connections:
938
        the@MODULE_A@.out --> the@MODULE_B@.in;
939
        the@MODULE_A@.in  <-- the@MODULE_B@.out;
940
}
941
';
942
943
    $ActivityCPPTemplate = '
944
#include <omnetpp.h>
945
946
@INCLUDES@
947
948
namespace @TESTNAME@ {
949
950
@GLOBAL@
951
952
class @MODULE@ : public cSimpleModule
953
{
954
    public:
955
        @MODULE@() : cSimpleModule(16384) {}
956
        virtual void activity();
957
};
958
959
Define_Module(@MODULE@);
960
961
void @MODULE@::activity()
962
{
963
@ACTIVITY@
964
}
965
966
}; //namespace
967
';
968
969
    $ModuleCPPTemplate = '
970
#include <omnetpp.h>
971
972
@INCLUDES@
973
974
namespace @TESTNAME@ {
975
976
@MODULE_SRC@
977
978
}; //namespace
979
';
980
981
    $ModuleABCPPTemplate = '
982
#include <omnetpp.h>
983
984
@INCLUDES@
985
986
namespace @TESTNAME@ {
987
988
@MODULE_A_SRC@
989
990
@MODULE_B_SRC@
991
992
}; //namespace
993
';
994
995
    $INITemplate = '
996
[General]
997
network = @NETWORKNAME@
998
cmdenv-express-mode = false
999
output-vector-file = test.vec
1000
output-scalar-file = test.sca
1001
';
1002
}