Commit | Line | Data |
---|---|---|
970ed795 EL |
1 | #!/usr/bin/perl -w |
2 | ############################################################################### | |
d44e3c4f | 3 | # Copyright (c) 2000-2016 Ericsson Telecom AB |
970ed795 EL |
4 | # All rights reserved. This program and the accompanying materials |
5 | # are made available under the terms of the Eclipse Public License v1.0 | |
6 | # which accompanies this distribution, and is available at | |
7 | # http://www.eclipse.org/legal/epl-v10.html | |
d44e3c4f | 8 | # |
9 | # Contributors: | |
10 | # Balasko, Jeno | |
11 | # Beres, Szabolcs | |
12 | # Delic, Adam | |
13 | # Kovacs, Ferenc | |
14 | # Lovassy, Arpad | |
15 | # Raduly, Csaba | |
16 | # Szabados, Kristof | |
17 | # Szabo, Janos Zoltan – initial implementation | |
18 | # Szalai, Endre | |
19 | # | |
970ed795 EL |
20 | ############################################################################### |
21 | ## | |
22 | ## File : SAtester.pl | |
23 | ## Description: Tester utility for Semantic Analyser, TITAN | |
24 | ## Written by : Endre Szalai (Endre.Szalai@ericsson.com) | |
25 | ## | |
26 | ||
27 | ## TODO: exit status always 0, investigate why; workaround: catch the notify | |
28 | ## printout from the compiler | |
29 | ||
30 | require 5.6.1; | |
31 | ||
32 | use strict; | |
33 | use Getopt::Long; | |
34 | ||
35 | ############################################################################### | |
36 | ### Global Variables | |
37 | ############################################################################### | |
38 | # Whether to stop on test case failures (1) or not (0) | |
39 | my $sa_halt_on_errors = ''; | |
40 | # Whether to list available test cases or not | |
41 | my $sa_list_TCs = 0; | |
42 | # Whether to show info or not | |
43 | my $sa_info = 0; | |
44 | # Whether to use matching in test case selection | |
45 | my $sa_tc_select = ''; | |
46 | # Name of the logfile | |
47 | my $sa_logFile = ''; | |
48 | my $sa_LOG; | |
49 | # Elapsed time in this session | |
50 | my $sessionTime; | |
51 | # Whether to show command line info or not | |
52 | my $sa_printHelp_cmd = 0; | |
53 | # Whether to show detailed info or not | |
54 | my $sa_printHelp_doc = 0; | |
55 | # Use function-test runtime or not | |
56 | my $sa_titanRuntime2 = 0; | |
57 | # Enable coverage or not | |
58 | my $sa_coverageEnabled = 0; | |
59 | # Files existed before a test case execution | |
60 | my %sa_existedFiles; | |
61 | # Store input TD files from which TCs are collected | |
62 | my @sa_scriptFiles; | |
63 | # Store information about the TCs to execute | |
64 | my @sa_tcList2Execute; | |
65 | # Store test case data | |
66 | my @sa_TCInfo; | |
67 | # Timeout for system calls in seconds | |
68 | my $sa_timeout = 30; | |
69 | # Max time to wait for a license, in multiple of 10 minutes | |
70 | my $max_cycles = 6; | |
71 | # Execution statistics | |
72 | # Number of TCs: PASSED, FAILED, ERROR verdicts, | |
73 | # abnormally terminated, memory leaked | |
74 | my @sa_executionStatistics = (0, 0, 0, 0, 0); | |
75 | # Command to invoke the titan compiler | |
76 | my $sa_compilerCmd; | |
77 | # Command to invoke the titan Makefile generator | |
78 | my $sa_mfgenCmd; | |
79 | # Command to invoke the runtime execution | |
80 | my $sa_runtimeCmd; | |
81 | # commonly used regexps | |
82 | my $sa_re_TCheader = "\\n\\s*<\\s*TC\\s*-\\s*(.+?)\\s*>\\s*\\n"; | |
83 | my $sa_re_MODULEheader = "\\n\\s*<\\s*MODULE\\s+(\\S+)\\s+(\\S+)\\s+(\\S+)\\s*>"; | |
84 | my $sa_re_MODULEbody = "${sa_re_MODULEheader}\\s*(.+?)\\n\\s*<\\s*END_MODULE\\s*>"; | |
85 | my $sa_re_RESULTheader = "\\n\\s*<\\s*RESULT\\s*(IF_PASS|IF_FAIL)?\\s*(LTRT|FTRT)?\\s*(POSITIVE|NEGATIVE)?\\s*(?:COUNT\\s+(\\d+))?.*?>"; | |
86 | my $sa_re_RESULTbody = "${sa_re_RESULTheader}\\s*(.*?)\\s*\\n\\s*<\\s*END_RESULT\\s*>"; | |
87 | my $sa_re_EXPECTEDbody = "\\s*<\\s*VERDICT_LEAF\\s+(PASS|FAIL)\\s*>\\s*"; | |
88 | my $sa_re_MemoryLeak = "(?:unallocated\\s+blocks\\s*:\\s*)|(?:Memory\\s+leakage\\s+detected)"; | |
89 | # separator for printouts | |
90 | my $sa_separator = "===============================================================\n"; | |
91 | ||
92 | ||
93 | # Detailed info about the usage | |
94 | my $sa_detailedInfo = ' | |
95 | Purpose | |
96 | ------- | |
97 | The tester program was written especially for testing the semantic analyser | |
98 | functionality in TITAN. A generic test flow looks like: | |
99 | - generate input sources (TTCN-3 and/or ASN.1) | |
100 | - compile them with the TITAN compiler | |
101 | - check that the error messages are as expected (negative testing) | |
102 | - check that the modules are compiled both with TITAN and gcc | |
103 | (positive testing) | |
104 | Test cases and all information needed to execute them are stored in one file, in | |
105 | the Test Description files (*.script) in EDML format. The tester program uses | |
106 | this file to execute the test according to the flow described above in a fully | |
107 | automatic way.. | |
108 | Unlike in a simple test method, where a test may be passed or failed, in | |
109 | regression test it might be important, why a test case is failed (e.g. due to a | |
110 | not yet implemented feature). Therefore, each test case may have two separate | |
111 | expected behaviour (called leaves later on). The first is the case when the test | |
112 | purpose is expected to work in a specific way (IF_PASS leaf). The other, when | |
113 | the test case is expected to fail, but why it fails is also interesting (IF_FAIL | |
114 | leaf). Each test case may have both leaves and a specific selector points out | |
115 | which leaf is expected to occur. This also means, that a test case passes, if | |
116 | the selected leaf is passed (which may be the IF_FAIL leaf). Therefore, the | |
117 | tester needs to check test cases that are failed, as only in those cases the | |
118 | current result is not as expected. | |
119 | ||
120 | Features | |
121 | -------- | |
122 | The tester program has the following features: | |
123 | 1. Support for one-by-one and batched execution of test cases. | |
124 | 2. Support for unlimited number of input modules: ASN.1, | |
125 | TTCN-3 and runtime config files for TITAN. | |
126 | 3. Support for compilation of the modules using TITAN and | |
127 | GCC. It also supports single mode execution of the test suite. | |
128 | Makefile and test port files generation is automatic. | |
129 | 5. Automatic cleanup after each test case. | |
130 | 6. Flexible pattern matching for the test case printout using | |
131 | Perl regexps combined with different matching logic. | |
132 | 7. Support for regression testing process. | |
133 | ||
134 | Reference | |
135 | --------- | |
136 | For a list of command line options, execute the tester program with | |
137 | SAtester.pl -help | |
138 | ||
139 | A test case structure in the EDML files looks like: | |
140 | test case block: | |
141 | <TC - test case name> | |
142 | compile block: | |
143 | [<COMPILE|COMPILEGCC|EXECUTE|EXECUTE_PARALLEL>] (default is COMPILE) | |
144 | leaf selector block: | |
145 | <VERDICT_LEAF (PASS|FAIL)> | |
146 | module block(s): | |
147 | <MODULE TTCN|ASN|CFG modulename filename> | |
148 | ... text from here is written to the filename specified above ... | |
149 | <END_MODULE> | |
150 | ... several module sections may follow ... | |
151 | result block(s): | |
152 | <RESULT IF_PASS|IF_FAIL [POSITIVE|NEGATIVE|COUNT number]> (default is POSITIVE) | |
153 | ... pattern in Perl regexp format ... | |
154 | <END_RESULT> | |
155 | ... several result sections may follow ... | |
156 | ||
157 | <END_TC> | |
158 | ||
159 | Each block header/footer must be single-line, i.e. newline is not allowed. | |
160 | ||
161 | The compile block instructs the SAtester to: | |
162 | COMPILE compile the modules using TITAN only | |
163 | COMPILEGCC compile the modules using TITAN and GCC afterwards | |
164 | (the Makefile is automatically generated) | |
165 | EXECUTE after compilation, execute the executable test suite | |
166 | the first runtime configuration file is passed to TITAN | |
167 | (single mode execution) | |
168 | EXECUTE_PARALLEL after compilation, execute the executable test suite | |
169 | (parallel mode execution) | |
170 | If any of the actions fail, the test case result will be "ERROR". This block is | |
171 | optional, the default value is COMPILE. | |
172 | ||
173 | The leaf selector block helps the regression testing process, where not only the | |
174 | verdict itself, but the expected verdict is interesting. The value may be PASS | |
175 | or FAIL. The leaf selector selects which RESULT blocks to use when matching the | |
176 | printout from the compiler(s). | |
177 | ||
178 | A module block instructs the SAtester to produce a source module | |
179 | or a runtime configuration file: | |
180 | TTCN The module is treated as a TTCN-3 module | |
181 | ASN The module is treated as an ASN.1 module | |
182 | CFG The module is treated as a runtime configuration file | |
183 | modulename Name of the module | |
184 | filename Name of the file to be produced | |
185 | The text within this section is written as is to "filename". You may specify as | |
186 | many modules as you need. | |
187 | ||
188 | A result block instructs the SAtester how to check result as soon the actions in | |
189 | the compile block is finished successfully. | |
190 | Either: | |
191 | POSITIVE Indicates a positive pattern match (i.e. =~ syntax in Perl) | |
192 | with the supplied pattern is needed to continue | |
193 | NEGATIVE Indicates a negative pattern match (i.e. !~ syntax in Perl) | |
194 | with the supplied pattern is needed to continue | |
195 | Or: | |
196 | COUNT Indicates that instead of a direct pattern match, perform | |
197 | a counting of the supplied pattern. If the number of pattern- | |
198 | matches equals to the supplied number in COUNT section, the | |
199 | execution continues | |
200 | POSITIVE or NEGATIVE can be used for simple pattern match, i.e. whether the | |
201 | pattern is present or not. | |
202 | COUNT can be used to detect that a pattern how many times are present. | |
203 | Result blocks are evaluated in the order of their appearence. If any of the | |
204 | result block is failed, the verdict will be "FAILED" and execution continues | |
205 | with the next test case (if any). Entries in the result header are optional, the | |
206 | default value is "POSITIVE". | |
207 | ||
208 | Memory leak printouts are automatically detected. If one is found, the current | |
209 | verdict will be "FAIL". | |
210 | ||
211 | Example | |
212 | ------- | |
213 | //line comments are written for understanding only | |
214 | ||
215 | // Name of the test case | |
216 | <TC - TTCN-3::Subtypes, list of values: Anytype> | |
217 | // compile with TITAN only | |
218 | <COMPILE> | |
219 | // "anytype" is not supported, so use the FAIL-leaf | |
220 | // in result matching | |
221 | <VERDICT_LEAF FAIL> | |
222 | // Specify one module | |
223 | <MODULE TTCN ModuleA ModuleA.ttcn> | |
224 | module ModuleA { | |
225 | type anytype MyType ( 10, 11.0, Nonexi, false ); | |
226 | } | |
227 | <END_MODULE> | |
228 | // PASS-leaf of the result matching | |
229 | // used if VERDICT_LEAF is "PASS" | |
230 | // expecting exactly 1 "no imported or local definition nonexi" | |
231 | <RESULT IF_PASS COUNT 1> | |
232 | (?im)\berror\b.+?no.+?definition.+?nonexi | |
233 | <END_RESULT> | |
234 | // expecting exactly 1 "error", so no other error shall | |
235 | // occur than the previous error | |
236 | <RESULT IF_PASS COUNT 1> | |
237 | (?is)\berror\b | |
238 | <END_RESULT> | |
239 | // expecting a notification that no code is generated due | |
240 | // to the error | |
241 | <RESULT IF_PASS POSITIVE> | |
242 | (?im)\bnotify\b.+?\bcode\b.+?\bnot\b.+?\bgenerated\b | |
243 | <END_RESULT> | |
244 | // FAIL-leaf of the result matching | |
245 | // used if VERDICT_LEAF is "FAIL" | |
246 | // expecting exactly 1 "parse error" | |
247 | <RESULT IF_FAIL COUNT 1> | |
248 | (?im)parse.+?error | |
249 | <END_RESULT> | |
250 | // expecting exactly 1 "error", so no other error shall | |
251 | // occur than the parse error | |
252 | <RESULT IF_FAIL COUNT 1> | |
253 | (?is)\berror\b | |
254 | <END_RESULT> | |
255 | <END_TC> | |
256 | ||
257 | Information about Perl regular expressions can be found at: | |
258 | www.perl.com | |
259 | ||
260 | Guides | |
261 | ------ | |
262 | 1. Use the IF_FAIL leaf only, if the test case is expected to fail because of a | |
263 | missing functionality that will not be implemented in the current project. Using | |
264 | IF_FAIL leaves for limitations that are expected to disappear within a project | |
265 | is just an unnecessary overhead. | |
266 | ||
267 | 2. Whenever a TR is issued, this should be mentioned in the test case, within | |
268 | the source module where the error occured, e.g. | |
269 | <MODULE TTCN ModuleA ModuleA.ttcn> | |
270 | module ModuleA { | |
271 | // TR 623: length restriction of charstrings | |
272 | type record of charstring MyType7 length(0..666-Nonexi); | |
273 | } | |
274 | <END_MODULE> | |
275 | ||
276 | 3. Always expect a specific error message, but be a bit flexible in pattern | |
277 | matching. Always check that no other errors occured. E.g.: | |
278 | <RESULT IF_PASS COUNT 1> | |
279 | (?im)\berror\b.+?no.+?definition.+?nonexi | |
280 | <END_RESULT> | |
281 | <RESULT IF_PASS COUNT 1> | |
282 | (?is)\berror\b | |
283 | <END_RESULT> | |
284 | <RESULT IF_PASS POSITIVE> | |
285 | (?im)\bnotify\b.+?\bcode\b.+?\bnot\b.+?\bgenerated\b | |
286 | <END_RESULT> | |
287 | Note the non-case sensitive matching; that only 1 error is expected and that no | |
288 | code is expected to be generated. | |
289 | ||
290 | Known issues | |
291 | ------------ | |
292 | On cygwin, fork does not always work and Perl stops with an error like: | |
293 | 264 [main] perl 2216 fork_copy: linked dll data/bss pass 0 failed, | |
294 | 0x412000..0x412370, done 0, windows pid 1832, Win32 error 487 | |
295 | ||
296 | '; | |
297 | ||
298 | ||
299 | ||
300 | ||
301 | # easterEgg | |
302 | my $sa_egg = ' | |
303 | \\\\\\\\|//// | |
304 | \\\\ - - // | |
305 | #( @ @ )# | |
306 | \ o / | |
307 | \ * / | |
308 | ---------------------oOOo--oOOo------------------------- | |
309 | "Do or do not. There is no try." - Yoda | |
310 | ------------------------ooooO---Ooooo------------------- | |
311 | ( ) ( ) | |
312 | \ | | / | |
313 | (_| |_) | |
314 | -- This amazing code was created by McHalls -- | |
315 | ||
316 | '; | |
317 | ||
318 | ||
319 | ############################################################################### | |
320 | ## Subs | |
321 | ############################################################################### | |
322 | sub sa_commandLineInfo(); | |
323 | sub sa_log($); | |
324 | sub sa_processArgs($); | |
325 | sub sa_processCommandLine(); | |
326 | sub sa_readFile($); | |
327 | sub sa_writeFile($$); | |
328 | sub sa_collectTCs(); | |
329 | sub sa_isInList(\@$); | |
330 | sub sa_getTCInfo(\@$$); | |
331 | sub sa_parseTCs(); | |
332 | sub sa_writeModulesOfTC(\@); | |
333 | sub sa_deleteModulesOfTC(\@); | |
334 | sub sa_fetchExecutableName(); | |
335 | sub sa_executeCommand($); | |
336 | sub sa_compileTC(\@); | |
337 | sub sa_printResult($$); | |
338 | sub sa_checkTCResult(\@$); | |
339 | sub sa_executeTCs(); | |
340 | ||
341 | # Print command line information | |
342 | sub sa_commandLineInfo () { | |
343 | sa_log("\nPerl utility to execute test cases for Semantic Analyser\n"); | |
344 | sa_log("Contact: Endre Szalai (Endre.Szalai\@ericsson.com)\n"); | |
345 | sa_log("Usage: SA_tester.pl\n"); | |
346 | sa_log(" [-halt] [-list] [-help] [-doc] [-rt2] [-coverage]\n"); | |
347 | sa_log(" [-select <pattern>]\n"); | |
348 | sa_log(" [-timeout <timeout>]\n"); | |
349 | sa_log(" [<TDfile1.script>] ... [<TDfileN.script>]\n"); | |
350 | sa_log(" [\"<test case name1>\"] ... [\"<test case nameM>\"]\n"); | |
351 | sa_log(" [-log <logfilename>]\n"); | |
352 | sa_log("Where\n"); | |
353 | sa_log(" -halt halt on any errors\n"); | |
354 | sa_log(" -list list available test cases\n"); | |
355 | sa_log(" -help display command line parameters\n"); | |
356 | sa_log(" -doc display complete documentation\n"); | |
357 | sa_log(" -rt2 use function-test runtime\n"); | |
358 | sa_log(" -coverage enable coverage"); | |
359 | sa_log(" <pattern> select test cases if pattern is present in the\n"); | |
360 | sa_log(" name of the test case\n"); | |
361 | sa_log(" <timeout> maximum execution time of a system call\n"); | |
362 | sa_log(" in seconds (default is $sa_timeout)\n"); | |
363 | sa_log(" <logfilename> name of the logfile\n"); | |
364 | sa_log(" NOTE: do NOT use the .log file extension !\n"); | |
365 | sa_log(" <TDfile.script> name of the TD file(s) to collect test cases from\n"); | |
366 | sa_log(" <test case name> name of the test case(s) to execute\n"); | |
367 | sa_log("If no TDfile(s) are defined, all script files from the current\n"); | |
368 | sa_log("directory are considered.\n"); | |
369 | sa_log("If no test cases are defined, all test cases from the script files\n"); | |
370 | sa_log("are executed.\n\n"); | |
371 | } | |
372 | ||
373 | # Log entries | |
374 | sub sa_log($) { | |
375 | print $_[0]; | |
376 | if (defined($sa_LOG)) { print $sa_LOG $_[0]; } | |
377 | } | |
378 | ||
379 | # Process the command line | |
380 | sub sa_processArgs($) { | |
381 | if ($_[0] =~ /\.script$/m) { $sa_scriptFiles[scalar @sa_scriptFiles] = $_[0]; } | |
382 | else { $sa_tcList2Execute[scalar @sa_tcList2Execute] = $_[0]; } | |
383 | } | |
384 | sub sa_processCommandLine() { | |
385 | ||
386 | die unless (GetOptions('halt' => \$sa_halt_on_errors, | |
387 | 'list' => \$sa_list_TCs, | |
388 | 'credit' => \$sa_info, | |
389 | 'help' => \$sa_printHelp_cmd, | |
390 | 'doc' => \$sa_printHelp_doc, | |
391 | 'rt2' => \$sa_titanRuntime2, | |
392 | 'coverage' => \$sa_coverageEnabled, | |
393 | 'log=s' => \$sa_logFile, | |
394 | 'timeout=s' => \$sa_timeout, | |
395 | 'select=s' => \$sa_tc_select, | |
396 | 'maxcycle=s'=> \$max_cycles, | |
397 | "<>" => \&sa_processArgs)); | |
398 | if ($sa_info) {print $sa_egg; exit(1);} | |
399 | if ($sa_logFile ne '') { | |
400 | die "Never use '.log' extension as TITAN's cleanup may remove it, specify a different name\n" | |
401 | unless ($sa_logFile !~ /.*\.log$/is); | |
402 | open ($sa_LOG, ">$sa_logFile") or die "Cannot open log file: '$sa_logFile': $!\n";} | |
403 | if ($sa_printHelp_cmd) {sa_commandLineInfo(); exit(1);} | |
404 | if ($sa_printHelp_doc) {sa_log ($sa_detailedInfo); exit(1);} | |
405 | } | |
406 | ||
407 | # Read and return the content of a file | |
408 | sub sa_readFile($) { | |
409 | # $_[0] : name of the file | |
410 | my $Buffer; | |
411 | sa_log("Parsing file $_[0]...\n"); | |
412 | open (TMP, "$_[0]") or die "Cannot open script file: '$_[0]': $!\n"; | |
413 | read(TMP, $Buffer, -s "$_[0]"); | |
414 | close (TMP); | |
415 | # remove carriage returns | |
416 | # Unix/windows: \n \r combo | |
417 | if ($Buffer =~ /\n/s) {$Buffer =~ s/\r//g;} | |
418 | # Mac: only \r | |
419 | else {$Buffer =~ s/\r/\n/g;} | |
420 | return $Buffer; | |
421 | } | |
422 | ||
423 | # Write a file | |
424 | sub sa_writeFile($$) { | |
425 | # $_[0] : name of the file | |
426 | # $_[1] : content of the file | |
427 | sa_log("Flushing file $_[0]...\n"); | |
428 | open (TMP, ">$_[0]") or die "Cannot open file: '$_[0]': $!\n"; | |
429 | print(TMP $_[1]); | |
430 | close (TMP); | |
431 | } | |
432 | ||
433 | # Checks whether a TC is on the list | |
434 | sub sa_isInList(\@$) { | |
435 | my $poi = $_[0]; | |
436 | foreach my $val (@{$poi}) { | |
437 | if ($val eq $_[1]) {return 1;} | |
438 | } | |
439 | return 0; | |
440 | } | |
441 | # Collect test cases from command line and/or script files | |
442 | sub sa_collectTCs() { | |
443 | # No script files are defined, collect all script files from | |
444 | # current directory | |
445 | if (scalar @sa_scriptFiles == 0) { | |
446 | my @list = split (/\s/, `ls *.script`); | |
447 | foreach my $filename (@list) { $sa_scriptFiles[scalar @sa_scriptFiles] = $filename; } | |
448 | } | |
449 | # no test cases specified, collect from available script files | |
450 | if (scalar @sa_tcList2Execute == 0) { | |
451 | foreach my $filename (@sa_scriptFiles) { | |
452 | my $Buffer = sa_readFile($filename); | |
453 | while ($Buffer =~ s/^.*?${sa_re_TCheader}//s) { | |
454 | my $tcName = $1; | |
455 | if (sa_isInList(@sa_tcList2Execute,$tcName)) | |
456 | {sa_log( "WARNING: Test case name is not unique: '$tcName'\n");} | |
457 | # execute test case if match with pattern or no pattern available | |
458 | if ((not $sa_tc_select) or | |
459 | ($sa_tc_select and ($tcName =~ /$sa_tc_select/))) { | |
460 | $sa_tcList2Execute[scalar @sa_tcList2Execute] = $tcName; | |
461 | } | |
462 | } | |
463 | } | |
464 | } | |
465 | my $sa_nrOfTCs2Execute = scalar @sa_tcList2Execute; | |
466 | my $nrOfScriptFiles = scalar @sa_scriptFiles; | |
467 | sa_log( "$sa_nrOfTCs2Execute test cases from $nrOfScriptFiles script files to be executed\n"); | |
468 | my $tmp = ($sa_halt_on_errors) ? "halting on errors\n" : "ignoring errors\n"; | |
469 | sa_log( "Mode: $tmp"); | |
470 | } | |
471 | ||
472 | ||
473 | # Gather execution information according to: | |
474 | # [N] Nth test case | |
475 | # [0] test case name | |
476 | # [1] "COMPILE", "COMPILEGCC" or "EXECUTE" | |
477 | # [2][N] Nth module | |
478 | # [0] module type ("ASN", "TTCN" or "CFG") | |
479 | # [1] module name (if ASN or TTCN)/execution mode (if CFG) | |
480 | # [2] filename to use for the module | |
481 | # [3] content of the module | |
482 | # [3]{'PASS'|'FAIL'}[N] Nth result for expected result leaf PASS|FAIL | |
483 | # [0] result type ("POSITIVE" or "NEGATIVE") | |
484 | # [1] match expression | |
485 | # [2] number of coccurances (if "COUNT" used in RESULT) | |
486 | # [4] name of the source script file | |
487 | # [5] expected test case result leaf selector (PASS, FAIL) | |
488 | # [6] verdict of the TC | |
489 | # [7] flag whether memory leak is detected or not (defined/not defined) | |
490 | # [8] flag whether abnormal termination is detected or not (defined/not defined) | |
491 | sub sa_getTCInfo(\@$$) { | |
492 | my ($poi, $Buffer, $filename) = @_; | |
493 | my $tcidx = scalar @{$poi}; | |
494 | if ($Buffer =~ s/${sa_re_TCheader}//s) { $poi->[$tcidx][0] = $1; } | |
495 | else { die "ERROR: Cannot find test case name in current block\n"; } | |
496 | if ($Buffer =~ s/<\s*EXECUTE\s*>//m) { $poi->[$tcidx][1] = 'EXECUTE'; } | |
497 | elsif ($Buffer =~ s/<\s*EXECUTE_PARALLEL\s*>//m) { $poi->[$tcidx][1] = 'EXECUTE_PARALLEL'; } | |
498 | elsif ($Buffer =~ s/<\s*COMPILEGCC\s*>//m) { $poi->[$tcidx][1] = 'COMPILEGCC'; } | |
499 | else { $poi->[$tcidx][1] = 'COMPILE'; } | |
500 | if ($Buffer =~ /${sa_re_EXPECTEDbody}/m) { $poi->[$tcidx][5] = $1; } | |
501 | else { $poi->[$tcidx][5] = 'PASS'; } | |
502 | my $idx = 0; | |
503 | while ($Buffer =~ s/${sa_re_MODULEbody}//s) { | |
504 | $poi->[$tcidx][2][$idx][0] = $1; | |
505 | $poi->[$tcidx][2][$idx][1] = $2; | |
506 | $poi->[$tcidx][2][$idx][2] = $3; | |
507 | $poi->[$tcidx][2][$idx][3] = $4; | |
508 | $idx++; | |
509 | } | |
510 | while ($Buffer =~ s/${sa_re_RESULTbody}//s) { | |
511 | my $expectedVerdict; | |
512 | if (defined($1)) { | |
513 | $expectedVerdict = ($1 eq 'IF_FAIL') ? 'FAIL':'PASS'; | |
514 | } else { $expectedVerdict = 'PASS'; } | |
515 | my $idx = (defined($poi->[$tcidx][3]{$expectedVerdict})) | |
516 | ? scalar @{$poi->[$tcidx][3]{$expectedVerdict}} : 0; | |
517 | if (defined($2)) { | |
518 | # Skip matching strings intended for the load-test run-time when | |
519 | # "-rt2" is used. Vice versa. | |
520 | if ($2 eq 'LTRT' and $sa_titanRuntime2 | |
521 | or $2 eq 'FTRT' and not $sa_titanRuntime2) { next; } | |
522 | } | |
523 | if (defined($3)) { | |
524 | $poi->[$tcidx][3]{$expectedVerdict}[$idx][0] = ($3 ne '') ? $3 : 'POSITIVE';} | |
525 | else {$poi->[$tcidx][3]{$expectedVerdict}[$idx][0] = 'POSITIVE';} | |
526 | if (defined($4)) { $poi->[$tcidx][3]{$expectedVerdict}[$idx][2] = $4; } | |
527 | $poi->[$tcidx][3]{$expectedVerdict}[$idx][1] = $5; | |
528 | eval { '' =~ /$poi->[$tcidx][3]{$expectedVerdict}[$idx][1]/ }; | |
529 | if ($@) { | |
530 | sa_log("In file $filename, test case '$poi->[$tcidx][0]'\n"); | |
531 | sa_log " Syntax error in provided pattern:\n $poi->[$tcidx][3]{$expectedVerdict}[$idx][1]\n$@\n"; | |
532 | exit(1); | |
533 | } | |
534 | } | |
535 | $poi->[$tcidx][4] = $filename; | |
536 | $poi->[$tcidx][6] = 'NONE'; | |
537 | } | |
538 | # Parse test case data | |
539 | sub sa_parseTCs() { | |
540 | # give only a list of the test cases | |
541 | if ($sa_list_TCs) { | |
542 | sa_log( "Collected test cases:\n"); | |
543 | my $idx = 1; | |
544 | # collect test case data from all specified script files | |
545 | foreach my $filename (@sa_scriptFiles) { | |
546 | my $Buffer = sa_readFile($filename); | |
547 | while ($Buffer =~ s/^.*?(${sa_re_TCheader}.+?<END_TC>)//s) { | |
548 | sa_getTCInfo(@sa_TCInfo, $1, $filename); | |
549 | } | |
550 | } | |
551 | foreach my $poi (@sa_TCInfo) { | |
552 | sa_log( "$idx. '$poi->[0]' \n"); | |
553 | sa_log( " source:$poi->[4]; leaf:$poi->[5]\n"); | |
554 | $idx++; | |
555 | } | |
556 | exit(1); | |
557 | } | |
558 | foreach my $filename (@sa_scriptFiles) { | |
559 | my $Buffer = sa_readFile($filename); | |
560 | while ($Buffer =~ s/^.*?(${sa_re_TCheader}.+?<END_TC>)//s) { | |
561 | if (not sa_isInList(@sa_tcList2Execute,$2)) { next; } | |
562 | sa_getTCInfo(@sa_TCInfo, $1, $filename); | |
563 | } | |
564 | } | |
565 | } | |
566 | ||
567 | # Writes the modules of the TC | |
568 | sub sa_writeModulesOfTC(\@) { | |
569 | my $root = $_[0]; | |
570 | foreach my $poi (@{$root->[2]}) { | |
571 | open(TMP, "> $poi->[2]") or die "Can't create file '$poi->[2]': $!\n"; | |
572 | sa_log("Module $poi->[1] (file $poi->[2]):\n"); | |
573 | sa_log("$poi->[3]\n"); | |
574 | print TMP $poi->[3] . "\n"; | |
575 | close (TMP); | |
576 | } | |
577 | } | |
578 | # Deletes the files(modules) of the TC | |
579 | sub sa_deleteModulesOfTC(\@) { | |
580 | my $root = $_[0]; | |
581 | sa_log( "Cleanup... "); | |
582 | if (-f 'Makefile') { | |
583 | my $makefile; | |
584 | `make clean 2>&1`; | |
585 | $makefile = sa_readFile('Makefile'); | |
586 | while ($makefile =~ s/^(\s*USER_SOURCES\s*=\s*)(\w+\.cc)/$1/im) { | |
587 | if (not exists($sa_existedFiles{$2})) { | |
588 | if (unlink $2) {sa_log( "$2 ");} | |
589 | } | |
590 | } | |
591 | while ($makefile =~ s/^(\s*USER_HEADERS\s*=\s*)(\w+\.hh)/$1/im) { | |
592 | if (not exists($sa_existedFiles{$2})) { | |
593 | if (unlink $2) {sa_log( "$2 ");} | |
594 | } | |
595 | } | |
596 | } | |
597 | if (unlink "Makefile") {sa_log( "Makefile ");} | |
598 | foreach my $poi (@{$root->[2]}) { | |
599 | if (unlink $poi->[2]) {sa_log( "$poi->[2] ");} | |
600 | # remove possible generated code | |
601 | if ($poi->[0] eq 'TTCN') { | |
602 | if (unlink "$poi->[1].cc") {sa_log( "$poi->[1].cc ");} | |
603 | if (unlink "$poi->[1].hh") {sa_log( "$poi->[1].hh ");} | |
604 | } else { | |
605 | my $tmp = $poi->[1]; | |
606 | $tmp =~ s/\-/_/g; | |
607 | if (unlink "$tmp.cc") {sa_log( "$tmp.cc ");} | |
608 | if (unlink "$tmp.hh") {sa_log( "$tmp.hh ");} | |
609 | } | |
610 | } | |
611 | sa_log("\n"); | |
612 | } | |
613 | ||
614 | # Fetch the executable name from Makefile | |
615 | sub sa_fetchExecutableName() { | |
616 | my $makefile = sa_readFile('Makefile'); | |
617 | if ($makefile =~ /^\s*EXECUTABLE\s*=\s*(\w+)/im) { return $1; } | |
618 | die "ERROR: Executable name is not found in generated Makefile\n"; | |
619 | } | |
620 | ||
621 | # Perform a system call | |
622 | # return value: (status, output) | |
623 | # status = 0 on success | |
624 | # status = 1 on command timeout | |
625 | # status = 2 on abnormal termination | |
626 | # output: collected printout from the process | |
627 | sub sa_executeCommand($) { | |
628 | # Silly Perl does not allow to capture STDERR, only STDOUT. | |
629 | # As a workaround, ask the shell to redirect STDERR to STDOUT. | |
630 | # It's OK until TITAN writes everything to STDERR (as it is today) | |
631 | my $command = "$_[0] 2>&1"; | |
632 | my $subRes = ""; | |
633 | my $pid; | |
634 | my $exitStatus = 0; | |
635 | sa_log( "$_[0]\n"); | |
636 | # run as a separate Perl program to be able to use timeout | |
637 | eval { | |
638 | local $SIG{ALRM} = sub { die "timeout\n" }; # NB: \n required | |
639 | alarm $sa_timeout; # send an alarm signal in specified time | |
640 | # call via exec to be able to catch the exit status | |
641 | # (without exec, the shell always return with 0 exit status) | |
642 | $pid = open(TMP, "exec $command |"); | |
643 | die "ERROR: Cannot fork: $!\n" unless ($pid); | |
644 | while (<TMP>) { $subRes .= $_; } | |
645 | close(TMP); | |
646 | $exitStatus = $? & 128; # whether core dump occured | |
647 | alarm 0; | |
648 | }; | |
649 | sa_log("$subRes\n"); | |
650 | if ($@) { # an error occured (thought, not only at timeout) | |
651 | sa_log("\nSoftly killing forked process $pid\n"); | |
652 | kill 1, $pid; | |
653 | sa_log("ERROR: system call '$command' is not finished within $sa_timeout seconds\n"); | |
654 | return (1, $subRes); | |
655 | } | |
656 | if ($exitStatus) { # core dump occured | |
657 | sa_log("\nERROR: system call '$command' is terminated abnormally\n"); | |
658 | return (2, $subRes); | |
659 | } | |
660 | return (0, $subRes); | |
661 | } | |
662 | ||
663 | # Compile the stuff now | |
664 | # return value: (status, output) | |
665 | # status = 0 on success | |
666 | # status = 1 on ERROR | |
667 | # status = 2 on test case FAIL (compiler related ERROR) | |
668 | sub sa_compileTC(\@) { | |
669 | my $root = $_[0]; | |
670 | my $modules2compile = ''; | |
671 | my $configFile = ''; | |
672 | my $subRes = ''; | |
673 | my $res; | |
674 | my $cycles = 0; | |
675 | foreach my $poi (@{$root->[2]}) { | |
676 | if ($poi->[0] eq "CFG") {$configFile = $poi->[2]; next;} | |
677 | $modules2compile .= " $poi->[2]"; | |
678 | } | |
679 | if ($modules2compile eq '') { | |
680 | sa_log( "WARNING: test case '$root->[0]' does not contain any modules, skipping\n"); | |
681 | return (1, ''); | |
682 | } | |
683 | sa_log( "Compiling sources...\n"); | |
684 | my $runtimeOption = ''; | |
685 | if ($sa_titanRuntime2) { $runtimeOption = '-R'; } | |
686 | do { | |
687 | if ($cycles) { sleep(60 * 10); } | |
688 | $cycles++; | |
689 | ($res, $subRes) = sa_executeCommand("$sa_compilerCmd $runtimeOption $modules2compile"); | |
690 | # Purify message, when no floating license available. Sleep for a while | |
691 | # and retry. | |
692 | # -continue-without-license=yes | |
693 | } while (($subRes =~ /\-continue\-without\-license\=yes/mi) and ($cycles <= $max_cycles)); | |
694 | if ($res) { return (2, $subRes); } | |
695 | my $resultBuffer = $subRes; | |
696 | if ($root->[1] eq "COMPILE") { return (0, $resultBuffer); } | |
697 | ||
698 | sa_log( "Generating test port skeletons...\n"); | |
699 | ($res, $subRes) = sa_executeCommand("$sa_compilerCmd $runtimeOption -t -f $modules2compile"); | |
700 | if ($res) { return (1, $subRes); } | |
701 | $resultBuffer .= $subRes; | |
702 | ||
703 | sa_log( "Generating Makefile...\n"); | |
704 | ($res, $subRes) = sa_executeCommand("$sa_mfgenCmd $runtimeOption -s -f $modules2compile *.cc*"); | |
705 | if ($res) { return (1, $subRes); } | |
706 | $resultBuffer .= $subRes; | |
707 | if (not (-e 'Makefile')) { | |
708 | sa_log( "ERROR: Makefile could not be generated\n"); | |
709 | sa_log ($subRes); | |
710 | return (1, $subRes); | |
711 | } | |
712 | if ($root->[1] eq "EXECUTE_PARALLEL") { | |
713 | sa_log("Patching Makefile for parallel mode...\n"); | |
714 | my $Buffer = sa_readFile('Makefile'); | |
715 | $Buffer =~ s/^\s*TTCN3_LIB\s*=\s*(ttcn3\S*)\s*$/TTCN3_LIB = $1-parallel/im; | |
716 | unlink 'Makefile'; | |
717 | sa_writeFile('Makefile', $Buffer); | |
718 | } | |
719 | sa_log("Building...\n"); | |
720 | my $coverage_args = $sa_coverageEnabled ? "CXXFLAGS=\"-fprofile-arcs -ftest-coverage -g\" LDFLAGS=\"-fprofile-arcs -ftest-coverage -g -lgcov\"" : ""; | |
721 | ($res, $subRes) = sa_executeCommand("make " . $coverage_args); | |
722 | if ($res) { return (1, $subRes); } | |
723 | $resultBuffer .= $subRes; | |
724 | my $exeName = sa_fetchExecutableName(); | |
725 | if (not (-e $exeName)) { | |
726 | sa_log( "ERROR: GCC compilation error, no executable produced ('$exeName')\n"); | |
727 | if ($sa_halt_on_errors) { | |
728 | sa_log( "\nTest execution interrupted (no cleanup).\n\n"); | |
729 | exit(1); | |
730 | } | |
731 | ||
732 | return (1, $subRes); | |
733 | } | |
734 | if ($root->[1] eq "COMPILEGCC") { return (0, $resultBuffer); } | |
735 | ||
736 | # go on with execution | |
737 | sa_log("Fetched executable name: $exeName\n"); | |
738 | if ($root->[1] eq "EXECUTE") { | |
739 | sa_log( "Executing in single mode...\n"); | |
740 | if ($configFile eq '') { | |
741 | sa_log( "ERROR: No runtime config file is specified in the test case\n"); | |
742 | return (1, $subRes); | |
743 | } | |
744 | ($res, $subRes) = sa_executeCommand("./$exeName $configFile"); | |
745 | if ($res) { return (1, $subRes); } | |
746 | $resultBuffer .= $subRes; | |
747 | return (0, $resultBuffer); | |
748 | } else { | |
749 | sa_log( "Executing in parallel mode...\n"); | |
750 | if ($configFile eq '') { | |
751 | ($res, $subRes) = sa_executeCommand("$sa_runtimeCmd $exeName"); | |
752 | } else { | |
753 | ($res, $subRes) = sa_executeCommand("$sa_runtimeCmd $exeName $configFile"); | |
754 | } | |
755 | if ($res) { return (1, $subRes); } | |
756 | $resultBuffer .= $subRes; | |
757 | return (0, $resultBuffer); | |
758 | } | |
759 | } | |
760 | ||
761 | ||
762 | # Print a test case result | |
763 | # $_[0] name of the test case | |
764 | # $_[1] verdict | |
765 | sub sa_printResult($$) { | |
766 | sa_log( "\nTest case '$_[0]' \n '$_[1]'\n".$sa_separator); | |
767 | } | |
768 | ||
769 | # Check test case result based on RESULT lists | |
770 | sub sa_checkTCResult(\@$) { | |
771 | my ($root, $resultBuffer) = @_; | |
772 | my $result = 'PASS'; | |
773 | my $expectedResult = $root->[5]; | |
774 | if (not defined($root->[3])) { | |
775 | sa_log( "ERROR: No RESULT section in test case '$root->[0]'\n"); | |
776 | sa_printResult($root->[0], 'ERROR'); | |
777 | $root->[6] = 'ERROR'; | |
778 | return; | |
779 | } | |
780 | foreach my $poi (@{$root->[3]{$expectedResult}}) { | |
781 | # match with each result | |
782 | if ($poi->[1] !~ /\S/) {next;} | |
783 | if (($poi->[0] eq 'POSITIVE') and defined($poi->[2])) { # counter match | |
784 | my $counter = 0; | |
785 | my $tmpBuf = $resultBuffer; | |
786 | while ($tmpBuf =~ s/$poi->[1]//) { $counter++; } | |
787 | if ($counter != $poi->[2]) { | |
788 | sa_log( "Failing at counting: pattern '$poi->[1]'\nexpected '$poi->[2]' times, found '$counter' times\n"); | |
789 | $result = 'FAIL'; last; | |
790 | } else { sa_log("Passed matching pattern (counting $counter times): '$poi->[1]'\n"); } | |
791 | } else { # simple pattern match | |
792 | if ($poi->[0] eq 'POSITIVE') { | |
793 | if ($resultBuffer !~ /$poi->[1]/si) { | |
794 | sa_log( "Failing at pattern (expected, not found):\n$poi->[1]\n"); | |
795 | $result = 'FAIL'; last; | |
796 | } else { sa_log("Passed matching pattern (expected): '$poi->[1]'\n"); } | |
797 | } else { # NEGATIVE | |
798 | if ($resultBuffer =~ /$poi->[1]/si) { | |
799 | sa_log( "Failing at pattern (not expected but found):\n$poi->[1]\n"); | |
800 | $result = 'FAIL'; last; | |
801 | } else { sa_log("Passed matching pattern (not expected): '$poi->[1]'\n"); } | |
802 | } | |
803 | } | |
804 | } | |
805 | # Check if there is any memory leak in compiler | |
806 | if ($resultBuffer =~ /${sa_re_MemoryLeak}/mi) { | |
807 | sa_log( "WARNING: Memory leak detected in compiler, setting verdict to 'FAIL'\n"); | |
808 | $root->[7] = 'memory leak detected'; | |
809 | $result = 'FAIL'; | |
810 | } | |
811 | sa_printResult($root->[0], $result); | |
812 | if ($sa_halt_on_errors and ($result ne 'PASS')) { | |
813 | sa_log( "\nTest execution interrupted (no cleanup).\n\n"); | |
814 | exit(1); | |
815 | } | |
816 | $root->[6] = $result; | |
817 | } | |
818 | ||
819 | # Execute test cases | |
820 | sub sa_executeTCs() { | |
821 | my $flag; | |
822 | # Log general info | |
823 | sa_log($sa_separator); | |
824 | sa_log("Date : " . `date`); | |
825 | sa_log("User : " . `whoami`); | |
826 | if (defined($ENV{HOST})) { | |
827 | sa_log("Host : $ENV{HOST}\n"); | |
828 | } else { | |
829 | sa_log("Host : <unknown>\n"); | |
830 | } | |
831 | sa_log("Platform : " . `uname -a`); | |
832 | sa_log("g++ : " . `which g++ | grep g++`); | |
833 | sa_log("g++ vers.: " . `g++ -dumpversion`); | |
834 | if (defined($ENV{TTCN3_DIR})) { | |
835 | sa_log( "compiler : $sa_compilerCmd\n"); | |
836 | sa_log( "TTCN3_DIR: $ENV{TTCN3_DIR}\n"); | |
837 | } else { | |
838 | sa_log( "compiler : " . `which compiler | grep compiler`); | |
839 | sa_log( "TTCN3_DIR: <undefined>\n"); | |
840 | } | |
841 | sa_log("Location : $ENV{PWD}\n"); | |
842 | sa_log( `$sa_compilerCmd -v 2>&1` . "\n"); | |
843 | my $sa_nrOfTCs2Execute = scalar @sa_tcList2Execute; | |
844 | my $sa_nrOfTCs2Executed = 1; | |
845 | # test case execution | |
846 | foreach my $poi (@sa_TCInfo) { | |
847 | sa_log ("\n\n$sa_separator Executing test case: '$poi->[0]'\n"); | |
848 | sa_log (" leaf: $poi->[5] ; mode: $poi->[1] ; source: $poi->[4] ;"); | |
849 | sa_log (" index: $sa_nrOfTCs2Executed of $sa_nrOfTCs2Execute\n$sa_separator"); | |
850 | opendir(DIR, '.') || die "can't opendir '.': $!"; | |
851 | foreach my $f (readdir(DIR)) { $sa_existedFiles{$f} = $f; } | |
852 | closedir DIR; | |
853 | sa_writeModulesOfTC(@{$poi}); | |
854 | my ($res, $resultBuffer) = sa_compileTC(@{$poi}); | |
855 | if ($res == 1) { # error | |
856 | sa_printResult($poi->[0], 'ERROR'); | |
857 | $poi->[6] = 'ERROR'; | |
858 | next; | |
859 | } elsif ($res == 2) { # compiler hanged or terminated abnormally | |
860 | sa_printResult($poi->[0], 'FAIL'); | |
861 | $poi->[6] = 'FAIL'; | |
862 | $poi->[8] = 'hanged or abnormal termination'; | |
863 | next; | |
864 | } | |
865 | # Check result now | |
866 | sa_checkTCResult(@{$poi}, $resultBuffer); | |
867 | sa_deleteModulesOfTC(@{$poi}); | |
868 | $sa_nrOfTCs2Executed++; | |
869 | } | |
870 | ||
871 | sa_log("\n\n$sa_separator"); | |
872 | ||
873 | $flag = 0; | |
874 | sa_log("The following test cases passed:\n"); | |
875 | sa_log("================================\n"); | |
876 | foreach my $poi (@sa_TCInfo) { | |
877 | if ($poi->[6] eq 'PASS') { | |
878 | sa_log(" [$poi->[4]]: '$poi->[0]' \n"); | |
879 | $sa_executionStatistics[0]++; | |
880 | $flag = 1; | |
881 | } | |
882 | } | |
883 | if (not $flag) { sa_log(" None.\n"); } | |
884 | ||
885 | $flag = 0; | |
886 | sa_log("The following test cases failed:\n"); | |
887 | sa_log("================================\n"); | |
888 | foreach my $poi (@sa_TCInfo) { | |
889 | if ($poi->[6] eq 'FAIL') { | |
890 | sa_log(" [$poi->[4]]: '$poi->[0]' \n"); | |
891 | $sa_executionStatistics[1]++; | |
892 | $flag = 1; | |
893 | } | |
894 | } | |
895 | if (not $flag) { sa_log(" None.\n"); } | |
896 | ||
897 | $flag = 0; | |
898 | sa_log("The following test cases are inconclusive:\n"); | |
899 | sa_log("==========================================\n"); | |
900 | foreach my $poi (@sa_TCInfo) { | |
901 | if ($poi->[6] eq 'ERROR') { | |
902 | sa_log(" [$poi->[4]]: '$poi->[0]' \n"); | |
903 | $sa_executionStatistics[2]++; | |
904 | $flag = 1; | |
905 | } | |
906 | } | |
907 | if (not $flag) { sa_log(" None.\n"); } | |
908 | ||
909 | $flag = 0; | |
910 | sa_log("\nMemory leak detected in the following test cases:\n"); | |
911 | foreach my $poi (@sa_TCInfo) { | |
912 | if (defined($poi->[7])) { | |
913 | sa_log(" [$poi->[4]]: '$poi->[0]' \n"); | |
914 | $sa_executionStatistics[4]++; | |
915 | $flag = 1; | |
916 | } | |
917 | } | |
918 | if (not $flag) { sa_log(" None.\n"); } | |
919 | ||
920 | $flag = 0; | |
921 | sa_log("\nAbnormal termination occured during the following test cases:\n"); | |
922 | foreach my $poi (@sa_TCInfo) { | |
923 | if (defined($poi->[8])) { | |
924 | sa_log(" [$poi->[4]]: '$poi->[0]' \n"); | |
925 | $sa_executionStatistics[3]++; | |
926 | $flag = 1; | |
927 | } | |
928 | } | |
929 | if (not $flag) { sa_log(" None.\n"); } | |
930 | ||
931 | my $sa_nrOfTCs2Execute = scalar @sa_tcList2Execute; | |
932 | my $nrOfScriptFiles = scalar @sa_scriptFiles; | |
933 | sa_log("\n\n$sa_separator"); | |
934 | sa_log("$sa_nrOfTCs2Execute test cases from $nrOfScriptFiles script files were executed\n"); | |
935 | sa_log("Total number of executed test cases: $sa_nrOfTCs2Execute\n"); | |
936 | sa_log(" PASSED test cases: $sa_executionStatistics[0]\n"); | |
937 | sa_log(" FAILED test cases: $sa_executionStatistics[1]\n"); | |
938 | sa_log(" INCONCLUSIVE test cases: $sa_executionStatistics[2]\n"); | |
939 | sa_log(" Abnormally terminated test cases: $sa_executionStatistics[3]\n"); | |
940 | sa_log(" Memory leaked test cases: $sa_executionStatistics[4]\n"); | |
941 | if ($sa_nrOfTCs2Execute != $sa_executionStatistics[0] + $sa_executionStatistics[1] + | |
942 | $sa_executionStatistics[2]) { sa_log( "INTERNAL ERROR: Statistics mismatch\n"); } | |
943 | ||
944 | if (defined($sa_LOG)) {sa_log("Session saved to log file '$sa_logFile'\n");} | |
945 | return ($sa_nrOfTCs2Execute==$sa_executionStatistics[0]); | |
946 | } | |
947 | ||
948 | ############################################################################### | |
949 | ## M A I N | |
950 | ############################################################################### | |
951 | ||
952 | $sessionTime = time(); | |
953 | $sa_compilerCmd = (defined $ENV{TTCN3_DIR}) ? | |
954 | "$ENV{TTCN3_DIR}/bin/compiler" : 'compiler'; | |
955 | $sa_mfgenCmd = (defined $ENV{TTCN3_DIR}) ? | |
956 | "$ENV{TTCN3_DIR}/bin/ttcn3_makefilegen" : 'ttcn3_makefilegen'; | |
957 | $sa_runtimeCmd = (defined $ENV{TTCN3_DIR}) ? | |
958 | "$ENV{TTCN3_DIR}/bin/ttcn3_start" : 'ttcn3_start'; | |
959 | sa_processCommandLine(); | |
960 | sa_collectTCs(); | |
961 | sa_parseTCs(); | |
962 | my $isAllPassed = sa_executeTCs(); | |
963 | $sessionTime = time() - $sessionTime; | |
964 | sa_log("Elapsed time in this session: $sessionTime seconds\n"); | |
965 | if (defined($sa_LOG)) { close $sa_LOG; } | |
966 | exit($isAllPassed?0:1); |