source: trunk/ETSI-Testsuites/ETSI_auto_IOT/validation/ttcn_validation.pl @ 27

Last change on this file since 27 was 22, checked in by rings, 14 years ago
  • Property svn:executable set to *
File size: 12.6 KB
Line 
1#!/usr/bin/perl -w
2
3# This perl script takes one or multiple source directories as parameter and
4# will generate the list of ttcn files contained in these directories and their
5# subdirectories. Then it will detect which TTCN-3 tools are installed one the
6# system and try to compile the files with each of them.
7#
8# Three tools are supported so far: Telelogic Tester, MessageMagic and TTworkbench
9#
10# The console display the result of the compilation of each tool (success or
11# not) and filters its output to only display the lines reporting errors or
12# warnings. The full output of each tool is saved in a separate file
13# (output.[toolname].txt).
14
15
16
17# regular expression used to identify which files are TTCN-3 files
18$TTCN_FILENAME_PATTERN = "\\.ttcn?\$";
19
20
21#######################################################################
22# An abstract class representing a TTCN-3 tool
23package TTCN3Tool;
24
25# constructor
26#
27#       name    name of the tool
28sub new
29{
30        my ($class, $name) = @_;
31        return bless {name => $name}, $class;
32}
33
34# report that this tool was detected on this system
35#
36#       dir     directory in which the tool is installed
37#
38# Note:         this function should be called from the constructors of the
39#               derived classes, it should be called at most once
40#
41# Note2:        the directory is then stored in the {dir} attribute
42sub detected
43{
44        my ($self, $dir) = @_;
45        $self->{dir} = ::get_abs_path ($dir);
46
47        printf "Detected %-24s in %s\n", $self->{name}, $dir;
48}
49
50# tell if this tool was detected on the system
51sub is_detected
52{
53        my ($self) = @_;
54        return defined $self->{dir};
55}
56
57# Check if the file given as parameter is executable, then store
58# this parameter in the {cmd} attribute. This command should be
59# the file to be executed to call the compiler.
60#
61#       cmd     path of the executable
62#
63sub try_cmd
64{
65        my ($self, $cmd) = @_;
66
67        # safety check because we store the name of the command here
68        $self->is_detected &&
69                die "TTCN3Tool::try_cmd must not be called after the tool has been detected";
70
71        $self->{cmd} = ::get_abs_path ($cmd);
72
73        return -X $cmd;
74}
75
76# Generate the name of the output file where the output of the compiler will be
77# stored. This function currently generates: "output.<name>.txt"
78#
79# Note:         the name of the compiler is mangled to avoid having strange
80#               characters in the result
81#
82sub output_file_name
83{
84        $_ = shift->{name};
85
86        s/[^A-Z0-9]/_/ig;
87
88        $_ = "output.$_.txt";
89
90        if (defined $OUTPUT_DIR) {
91                $_ = "$OUTPUT_DIR\\$_";
92        }
93}
94
95# Public interface to execute the compiler
96#
97# This function execute the command generated by the analyse_cmd() function
98# (normally implemented in the derived classes) and store the output into
99# the output file given by the function output_file_name().
100#
101# The output is also duplicated on the console. However, in order to simplify
102# the output, it is filtered so that only the lines reporting errors are
103# displayed on the console.
104#
105# The filter is implemented by the match_error() function. Since this filter is
106# compiler-dependent, it is normally reimplemented in the derived classes.
107#
108#       @files  list of the TTCN-3 input files
109#       
110#       return  true if the analysis was successful
111#
112sub analyse
113{
114        my $self = shift;
115
116#       print "Executing: ", $self->analyse_cmd(@_), "\n";
117
118        unless (open CMD, $self->analyse_cmd(@_)." 2>&1 |") {
119                print "Error: cannot execute command: ", $self->analyse_cmd(@_), "\n";
120                return undef;
121        }
122       
123        unless (open OUT, '>'.$self->output_file_name) {
124                print "Error: cannot open output file: ", $self->output_file_name, "\n";
125                return undef;
126        }
127       
128        while (<CMD>) {
129                # display only the errors on the console
130                $self->match_error ($_) && print "\t$_";
131
132                # write everything into the output file
133                print OUT $_;
134        }
135       
136        return (close OUT) && (close CMD);
137}
138
139# default filter to be used by the analyse() function
140#
141# By default all the lines are displayed on the console.
142#
143sub match_error
144{
145        return 1;
146}
147
148########################################################################
149# A driver class for controlling the TTCN-3 tool IBM Telelogic Tester
150package TTCN3Tool::TelelogicTester;
151@ISA = qw(TTCN3Tool);           
152
153# Constructor
154#
155# This function will detect the latest version of the compiler installed on the
156# system in the default path (c:\program files\telelogic)
157sub new
158{
159        $self = TTCN3Tool::new (shift, "Telelogic Tester");
160       
161        # find the newest telelogic tester version installed on the system
162        my $dir = ::find_newest_version_in_dir ("c:\\program files\\telelogic", "^(TAU_)?Tester_"); #ori
163        #my $dir = ::find_newest_version_in_dir ("c:\\program files\\telelogic\\TAU_4.2sdsfd"); ## needs to be adjusted """
164       
165        if ((defined $dir) && ($self->try_cmd ("$dir\\bin\\t3cg.exe"))) {
166                $self->detected($dir);
167        }
168        return $self;
169}
170
171# generate the command line to run the compiler
172sub analyse_cmd
173{
174        my $self = shift;
175
176        return "\"$self->{cmd}\" -D -F -a @_";
177}
178
179# match one error line in the compiler output
180sub match_error
181{
182        shift;
183        /: (Error|Warning)/;
184}
185
186
187########################################################################
188# A driver class for controlling the TTCN-3 tool TestingTech TTworkbench
189package TTCN3Tool::TTworkbench;
190@ISA = qw(TTCN3Tool);           
191
192# Constructor
193#
194# This function will detect the compiler installed on the system in the default
195# path (c:\program files\TTworkbenchBasic)
196sub new
197{
198        $self = TTCN3Tool::new (shift, "TTworkbench");
199       
200        foreach my $dir ("c:\\program files\\ttworkbenchbasic118")  #TODO: maybe add other directories to search
201        {
202                if ($self->try_cmd ("$dir\\TTthree.bat")) {
203                        $self->detected ($dir);
204                        last;
205                }
206        }
207        return $self;
208}
209
210# generate the command line to run the compiler
211sub analyse_cmd
212{
213        my $self = shift;
214
215        # TTworkbench needs to know the list of sub-directories where our files
216        # are located
217        my %subdirs=();
218        foreach (@_) {
219                if (/^(.*\\)[^\\]+/) {
220                        $subdirs{$1} = 1;
221                } else {
222                        $subdirs{"."} = 1;
223                }
224        }
225       
226        # TTworkbench needs to know one or more root module id so as to know
227        # what shall be compiled in these subdirectories
228        #
229        # Note: the compiler does not support files whose basename does not
230        # match the module id that they contain -> so we can afford just
231        # using the basename of our files
232        #
233        # Note2: we do not know which module is the root one, so we give the
234        # full list of modules
235        my @modules=();
236        foreach (@_) {
237                if (/^.*\\([^\\.]+)\.[a-z0-9]+$/i) {
238                        push @modules, $1;
239                } else {
240                        die "error: cannot extract a module name form the file: $_";
241                }
242        }
243
244        return "\"$self->{cmd}\" --clean --dry-run --continue --use-bigint --rebuild --strict-standard-compliance enforce --verbosity warning "
245                        . join (" -P ", "", keys %subdirs)." @modules";
246}
247
248# match one error line in the compiler output
249sub match_error
250{
251        shift;
252        /^(error|warning|failure):/;
253}
254
255########################################################################
256# A driver class for controlling the TTCN-3 tool OpenTTCN Tester
257#
258# warning: this class has not yet been validated
259#
260package TTCN3Tool::OpenTTCNTester;
261@ISA = qw(TTCN3Tool);           
262
263sub new
264{
265        $self = TTCN3Tool::new (shift, "OpenTTCN Tester");
266       
267        foreach my $dir ("c:\\program files\\OpenTTCN\\Tester3")  #TODO: maybe add other directories to search
268        {
269                if ($self->try_cmd ("$dir\\bin\\importer3.exe")) {
270                        $self->detected ($dir);
271                        last;
272                }
273        }
274        return $self;
275}
276
277########################################################################
278# A driver class for controlling the TTCN-3 tool Elvior MessageMagic
279package TTCN3Tool::MessageMagic;
280@ISA = qw(TTCN3Tool);           
281
282sub new
283{
284        $self = TTCN3Tool::new (shift, "Message Magic");
285       
286        # find the newest telelogic tester version installed on the system
287        my $dir = ::find_newest_version_in_dir ("c:\\program files\\elvior", "^MessageMagic5");
288
289        if ((defined $dir) && ($self->try_cmd ("$dir\\mmttcncp.exe"))) {
290                $self->detected($dir);
291        }
292        return $self;
293}
294
295# generate the command line to run the compiler
296sub analyse_cmd
297{
298        shift;
299
300        # MessageMagic must be executed from its directory to be able to locate the license
301
302        # transform the file names into absolute file names
303        my $cwd = ::cwd();
304        my @files = ();
305        foreach my $file (@_) {
306                push @files, ::get_abs_path ($file);
307        }
308
309        return "cd \"$_->{dir}\" && mmttcncp.exe -l \"".(join ';', @files).'"';
310}
311
312# match one error line in the compiler output
313sub match_error
314{
315        shift;
316        /\* Script.*: Line [0-9]+: /;
317}
318
319package main;
320
321# List all the files matching a regular expression in a directory and
322# recursively in all its subdirectories
323#
324#       dir     path of the directory to be scanned
325#       pattern regular expression to be used for selecting the files
326#
327#       return  an array containing the files that match the pattern
328#
329sub get_files_in_dir
330{
331        my ($dir, $pattern) = @_;
332        my @result = ();
333
334        (opendir "DIR$dir", "$dir") or die "cannot access directory $dir";
335        while ($_ = readdir "DIR$dir")
336        {
337                next if /^\.\.?$/;
338                my $file = "$dir\\$_";
339
340                if ((-f $file) && ($file =~ /$pattern/i)) {
341                        push @result, $file;
342                } elsif (-d $file) {
343                        my @subdir_result = get_files_in_dir ($file, $pattern);
344                        push @result, @subdir_result;
345                }
346        }
347        closedir "DIR$dir";
348
349        return @result;
350}
351
352# make a comparison of two version numbers
353#
354# This function compares separately the major an minor version numbers
355sub cmp_version
356{
357        my ($a, $b) = @_;
358
359        my ($a_maj, $a_min, $b_maj, $b_min) = ($a, undef, $b, undef);
360        if ($a =~ /^([0-9a-z]+)[_.-]([0-9a-z].*)$/i) {
361                ($a_maj, $a_min) = ($1, $2);
362        }
363        if ($b =~ /^([0-9a-z]+)[_.-]([0-9a-z].*)$/i) {
364                ($b_maj, $b_min) = ($1, $2);
365        }
366        my $result = undef;
367        if (($a_maj =~ /^[0-9]/) && ($b_maj =~ /^[0-9]/)) {
368                # numeric comparison
369                # FIXME: this comparison ignores letters appended to the
370                #        version: eg. 1.2.3a
371                $result = $a_maj <=> $b_maj;
372        } else {
373                # alphabetical comparison
374                $result = $a_maj cmp $b_maj;
375        }
376
377        $result && return $result;
378
379        if (defined $a_min) {
380                return (defined $b_min) ? cmp_version ($a_min, $b_min) : 1;
381        } else {
382                return (defined $b_min) ? -1 : 0;
383        }
384}
385
386# Find the newest versionned subdir in a directory
387#
388# This function will check the names of the subdirectories located in dir and
389# will select the one which has the highest version number in its suffix and that
390# matches the pattern
391#
392#       dir     directory to be scanned
393#       pattern regular expression to detect the elegible subdirectories
394#
395#       return  the chosen subdirectory in the form "directory\\subdirectory"
396sub find_newest_version_in_dir
397{
398        my ($base_dir, $pattern) = @_;
399
400        (opendir DIR, $base_dir) || return undef;
401
402        my @subdirs = readdir DIR;
403        my $max_version = " ";
404        my $subdir = undef;
405        foreach (@subdirs) {
406                if (    (-d "$base_dir\\$_")
407                    &&  ((!defined $pattern) || /$pattern/i)
408                    &&  /([0-9]+([._][0-9]+)*)$/
409                    &&  (cmp_version ($max_version, $1) < 0))
410                {
411                        $max_version = $1;
412                        $subdir = $_;
413                }
414        }
415        closedir DIR;
416       
417        return (defined $subdir ? "$base_dir\\$subdir" : undef);
418}
419
420# Get the absolute path of the current working directory
421sub cwd
422{
423        (open CWD, "cmd.exe /C cd |") or die "Cannot run the interpreter cmd.exe";
424        $cwd = <CWD>;
425        $cwd =~ /^[A-Z]:/i || die;
426        chomp $cwd;
427        close CWD;
428        return $cwd;
429}
430
431# Get the absolute path a file/directory
432sub get_abs_path
433{
434        my $path = shift;
435
436        return (($path =~ /^[A-Z]:/i) ? "" : cwd()."\\" ) . $path;
437}
438
439
440########################################################################
441### Beginning of the script                                          ###
442
443# output directory for storing the results
444$TTCN3Tool::OUTPUT_DIR = cwd();
445
446# generate the list of TTCN-3 files to be compiled
447if (@ARGV == 1) {
448        # if there is only one directory given, then we chdir into
449        # this directory to have shorter file name
450        # (this is purely cosmetical)
451        $_ = $ARGV[0];
452        chdir $_ or die "Error: cannot chdir into '$_'\n";
453
454        @ttcn_files = get_files_in_dir (".", $TTCN_FILENAME_PATTERN);
455} else {
456        # otherwise we just use the full directory names
457        @ttcn_files = ();
458        foreach (@ARGV) {
459                -d or die "Error: there is no directory '$_'\n";
460                push @ttcn_files, get_files_in_dir ($_, $TTCN_FILENAME_PATTERN);
461        }
462}
463
464@ttcn_files or die "usage: $0 sourcedir1 [sourcedir2 ...]\n";
465
466print "List of TTCN-3 source files: @ttcn_files\n\n";
467
468
469# detect the tools installed on the system
470my @tools = ();
471foreach (
472        new TTCN3Tool::TelelogicTester,
473#       new TTCN3Tool::OpenTTCNTester,          # FIXME: not supported yet (need a license)
474        new TTCN3Tool::MessageMagic,
475        new TTCN3Tool::TTworkbench
476) {
477        $_->is_detected  &&  push @tools, $_;
478}
479
480# execute each compiler
481foreach (@tools)
482{
483        print "\nAnalysing the ATS with $_->{name}...\n";
484        $_->analyse (@ttcn_files);
485}
486
487
Note: See TracBrowser for help on using the repository browser.