source: trunk/ETSI-Testsuites/ETSI_auto_IOT/codec/validation/LoopbackTests/SipCodecTestGenerator.pl @ 55

Last change on this file since 55 was 22, checked in by rings, 14 years ago
  • Property svn:executable set to *
File size: 27.2 KB
Line 
1#!/usr/bin/perl -w
2
3# TODO:
4#      Add comments
5#      File input/output
6#      Improve parser so that it can accept any valid input, not only sanitized input
7
8# Usage:
9# cat compiledTypes.txt | SipCodecTestGenerator.pl
10
11use strict "vars";
12use Class::Struct;
13
14#--------------------------------------------------------------------------
15my $testcaseTemplate = "\ttestcase %s() runs on SipSimu {\n\n"
16    . "\t\t// Variables\n"
17    . "\t\ttimer t_ac := 3.0;\n\n"
18    . "\t\t// Test Body\n"
19    . "\t\tsipPort.send(%s);\n"
20    . "\t\tt_ac.start;\n"
21    . "\t\talt {\n"
22    . "\t\t\t[] sipPort.receive(%s) {\n"
23    . "\t\t\t\tsetverdict(pass);\n"
24    . "\t\t\t}\n"
25    . "\t\t\t[] t_ac.timeout {\n"
26    . "\t\t\t\tsetverdict(fail);\n"
27    . "\t\t\t}\n"
28    . "\t\t}\n"
29    . "\t}\n\n";
30
31my $templateModule = "SipCodecTest_LoopbackTemplates";
32my $testcaseModule = "SipCodecTest_LoopbackTestcases";
33my $controlModule = "SipCodecTest_LoopbackTestControl";
34my $systemModule = "TestSystem";
35my @typeModules = ("LibSip_SIPTypesAndValues", "LibSip_SDPTypes", "LibSip_XMLTypes");
36my $debug;# = 1;
37
38#--------------------------------------------------------------------------
39
40my %types;
41my @messages;
42my %defaultValues;
43my %templates;
44
45
46struct(Field, {type => '$', name => '$', optional => '$', constraints => '@'});
47struct(Type, {baseType => '$', type => '$', field => '@'});
48struct(Template, {text => '$', ref => '$', before => '$', after => '$'});
49
50#--------------------------------------------------------------------------
51
52sub initializeDefaultValues() {
53    %defaultValues = (
54                      'charstring'                      => ['"a"', '"abcde"', '"abcdefghij"'],
55                      'integer'                         => [1, 2, 3],
56                      'boolean'                         => ["true", "false"],
57                     
58                      'Request payload'                                         => ["omit"],
59                      'REGISTER_Request payload'        => ["omit"],
60                'INVITE_Request payload'                => ["omit"],
61                'OPTIONS_Request payload'               => ["omit"],
62                'BYE_Request payload'                           => ["omit"],
63                'CANCEL_Request payload'                => ["omit"],
64                'ACK_Request payload'                           => ["omit"],
65                'PRACK_Request payload'                 => ["omit"],
66                'NOTIFY_Request payload'                => ["omit"],
67                'SUBSCRIBE_Request payload'     => ["omit"],
68                'PUBLISH_Request payload'               => ["omit"],
69                'UPDATE_Request payload'                => ["omit"],
70                'REFER_Request payload'                 => ["omit"],
71                'MESSAGE_Request payload'               => ["omit"],
72                'INFO_Request payload'                  => ["omit"],
73                'Response payload'                                      => ["omit"],
74                     
75                      'SipUrl scheme'                   => ['"sip"'],
76                      'StatusLine sipVersion'           => ['"SIP/2.0"'],       
77                      'RequestLine sipVersion'  => ['"SIP/2.0"'],
78                      'ContactBody wildcard'            => ['"*"'],
79                      'ContentType mediaType'           => ['"application/sdp"'],
80                      'DeltaSec'                                                                => ['"1"', '"123456"', '"123456789"'],
81                      'PMediaAuthValue'                                 => ['"DEAD"', '"BABE"', '"DEAF"', '"1EE7"'],   
82                     
83                      'SDP_Message protocol_version'    => [0],
84                      'SDP_Message uri'                                                         => ['"test_uri@etsi.org"'],
85                      'SDP_contact addr_or_phone'                       => ['"test_email@etsi.org"', '"+33 4 - 9294 4200"'],
86                      'SDP_contact disp_name'                                   => ['"John Smith"', '"Jane Doe"'],
87                      'SDP_typed_time unit'                                             => ['"d"', '"h"', '"m"', '"s"'],
88                      'SDP_time_field start_time'                       => ['"1243951581"'],
89                      'SDP_time_field stop_time'                        => ['"1243951781"'],
90                      'SDP_timezone adjustment_time'    => ['"42"', '"1241781"'],
91                      'SDP_Origin session_id'                                   => ['"1"', '"2"', '"3"'],       
92                      'SDP_Origin session_version'              => ['"1"', '"2"', '"3"'],
93                      'SDP_connection net_type'                         => ['"IN"'],
94                      'SDP_connection addr_type'                        => ['"IP4"'],
95                      'SDP_conn_addr addr'                                              => ['"224.0.0.1"'],
96                      'SDP_key method'                                                          => ['"prompt"', '"clear"', '"base64"', '"uri"'],
97                      'SDP_attribute_curr statusType'   => ['"e2e"', '"local"', '"remote"'],
98                      'SDP_attribute_des statusType'    => ['"e2e"', '"local"', '"remote"'],
99                      'SDP_attribute_conf statusType'   => ['"e2e"', '"local"', '"remote"'],
100                'SDP_attribute_curr direction'  => ['"none"', '"send"', '"recv"', '"sendrecv"'],
101                'SDP_attribute_des direction'           => ['"none"', '"send"', '"recv"', '"sendrecv"'],
102                'SDP_attribute_conf direction'  => ['"none"', '"send"', '"recv"', '"sendrecv"'],
103                                        'SDP_attribute_des strength'            => ['"mandatory"', '"optional"', '"none"', '"failure"', '"unknown"'].
104                     
105                      'UndefinedHeader headerName'              => ['"az"', '"abcde"', '"abcdefghij"']
106                      );
107}
108
109
110sub processTypeFile($) {
111    my $typeFiles_ref = shift;
112    my @typeFiles;
113    my $file;
114    my $line;
115    my $BaseType;
116    my $Type;
117   
118    @typeFiles = @$typeFiles_ref; 
119   
120    foreach $file (@typeFiles) {
121        open(FILE, $file) or die "Unable to open file $file";
122        while(defined($line=<FILE>)) {
123            if( # set of
124                $line=~ m/^\s*type\s+set of\s+(\S+)\s+(\S+)\s*[\{|;]\s*$/
125                or $line=~ m/^\s*type\s+set of\s+(\S+)\s+(\S+)\s*$/ ){
126                my @field;
127               
128                $BaseType = $1;
129                $Type = $2;
130                push (@field, new Field(type => $BaseType, optional => 1));
131                $types{$Type} = new Type(baseType => "set of", type => $Type, field => \@field);
132            }
133            elsif( # record of
134                   $line=~ m/^\s*type\s+record of\s+(\S+)\s+(\S+)\s*[\{|;]\s*$/
135                   or $line=~ m/^\s*type\s+record of\s+(\S+)\s+(\S+)\s*$/ ){
136                my @field;
137               
138                $BaseType = $1;
139                $Type = $2;
140                push (@field, new Field(type => $BaseType, optional => 1));
141                $types{$Type} = new Type(baseType => "record of", type => $Type, field => \@field);   
142            }
143            elsif( # port
144                   $line=~ m/^\s*type\s+port\s+(\S+)\s+message\s*[\{|;]\s*$/
145                   or $line=~ m/^\s*type\s+port\s+(\S+)\s+message\s*$/ ) {
146                my $loop=1;
147                while($loop==1 and defined($line=<FILE>)) {
148                    if($line=~ m/^\s*(in|out|inout)\s*$/) {
149                        # do nothing
150                    }
151                    elsif($line=~ m/^\s*(\S*)\s*,\s*$/) { 
152                        push(@messages, $1);   
153                    }
154                    elsif($line=~ m/^\s*(\S*)\s*$/) { 
155                        push(@messages, $1);   
156                        $loop=0;
157                    }
158                    else {
159                        die("MISMATCH in port: $line");
160                    }
161                }
162            }
163           
164            elsif( # standard type
165                   $line=~ m/^\s*type\s+(\S+)\s+(\S+)\s*[\{|;]\s*$/
166                   or $line=~ m/^\s*type\s+(\S+)\s+(\S+)\s*$/ ){   
167                $BaseType = $1;
168                $Type = $2;
169                if($BaseType eq "record" or $BaseType eq "set" or $BaseType eq "union") {
170                    my @field;
171                    my $loop=1;
172                   
173                    while($loop==1 and defined($line=<FILE>)) {       
174                        my $optional;
175                       
176                        if($line=~ m/^\s*\{\s*$/) {
177                            # do nothing
178                        }
179                        elsif($line=~ m/^\s*\}\s*$/) {
180                            $loop=0;
181                        }
182                        elsif( # non-final field
183                               $line=~ m/^\s*(\S*)\s+(\w*)\s*(\(.*\))?\s*(\s+optional)?\s*,\s*$/) {
184                            my @constraint;
185                            if(defined $3) {
186                                my $constraints = $3;
187                                @constraint = split(/,/, substr($constraints, 1, length($constraints) - 2));
188                            }
189                            if(defined $4) {
190                                $optional = 1;
191                            }
192                            else {
193                                $optional = 0;
194                            }
195                            push (@field, new Field(type => $1, name => $2, optional => $optional, constraints => \@constraint));
196                        }
197                        elsif( # final field
198                               $line=~ m/^\s*(\S*)\s+(\w*)\s*(\(.*\))?\s*(\s+optional)?\s*$/) { 
199                            my @constraint;
200                            if(defined $3) {
201                                my $constraints = $3;
202                                @constraint = split(/,/, substr($constraints, 1, length($constraints) - 2));
203                            }
204                            if(defined $4) {
205                                $optional = 1;
206                            }
207                            else {
208                                $optional = 0;
209                            }
210                            push (@field, new Field(type => $1, name => $2, optional => $optional, constraints => \@constraint));
211                            $loop=0;
212                        }
213                        else {
214                            die("MISMATCH in record $Type: $line");
215                        }
216                    }
217                    $types{$Type} = new Type(baseType => $BaseType, type => $Type, field => \@field);
218                }
219                elsif($BaseType eq "charstring") {
220                    $types{$Type} = new Type(baseType => $BaseType, type => $Type);
221                }
222                elsif($BaseType eq "integer") {
223                    $types{$Type} = new Type(baseType => $BaseType, type => $Type);
224                }
225                elsif($BaseType eq "enumerated") {
226                    my @field;
227                    my $loop = 1;
228                   
229                    while($loop==1 and defined($line=<FILE>)) {               
230                        if($line=~ m/^\s*\{\s*$/) {
231                            # do nothing
232                        }
233                        elsif($line=~ m/^\s*\}\s*$/) {
234                            $loop=0;
235                        }
236                        elsif($line=~ m/^\s*(\S*)\s*,\s*$/) {
237                            push (@field, $1);
238                        }
239                        elsif($line=~ m/^\s*(\S*)\s*$/) { 
240                            push (@field, $1);
241                            $loop=0;
242                        }
243                        else {
244                            die("MISMATCH in record $Type: $line");
245                        }
246                    }
247                    $types{$Type} = new Type(baseType => $BaseType, type => $Type, field => \@field);
248                }
249                elsif($BaseType eq "boolean") {
250                    $types{$Type} = new Type(baseType => $BaseType, type => $Type);
251                }
252                else {
253                    $types{$Type} = new Type(baseType => $BaseType, type => $Type);
254                }
255            }   
256        }
257        close FILE;
258    }
259}
260
261sub createTemplatesFromRecord($) {
262    my $type = shift;
263   
264    print "createTemplatesFromRecord\n" if defined $debug;
265   
266    bless($type, 'Type');
267    helper_createTemplatesFromRecord($type, "all");
268    helper_createTemplatesFromRecord($type, "none");
269    helper_createTemplatesFromRecord($type, "random");
270}
271
272
273sub helper_createTemplatesFromRecord($ $) {
274    my $type = shift;
275    my $optionalStrategy = shift;
276    my $baseTemplateIndex;
277    my @fields_;
278    my $field;
279    my $fieldIndex;
280
281    print "helper_createTemplatesFromRecord\n" if defined $debug;
282   
283    bless($type, 'Type');
284   
285    if(defined $templates{$type->type}) {
286        $baseTemplateIndex = scalar @{$templates{$type->type}};
287    }
288    else {
289        $baseTemplateIndex = 0;
290    }
291    ${$templates{$type->type}}[$baseTemplateIndex] = new Template(text => "{\n");
292   
293    @fields_ = @{$type->field};
294    for($fieldIndex=0; $fieldIndex < scalar @fields_;) { # incremented while inserting comma !
295        my $fieldType;
296        my $fieldTypeName;
297        my $comma;
298
299        $field = $fields_[$fieldIndex];
300        $comma = (++$fieldIndex == scalar @fields_) ? "" : ",";
301       
302        bless($field, 'Field');
303        $fieldTypeName = $field->type;
304       
305        if(
306           ($optionalStrategy eq "all")
307           or (($optionalStrategy eq "none" or $optionalStrategy eq "random") and $field->optional == 0)
308           or ($optionalStrategy eq "random" and $field->optional == 1 and round(rand()) == 1)) {
309
310            if((scalar @{$field->constraints} > 0)
311               or $fieldTypeName eq "charstring"
312               or $fieldTypeName eq "integer"
313               or $fieldTypeName eq "boolean") {
314                # Terminal field
315                # Derive all possible values
316               
317                my $vals_ref;
318                my @vals = [];
319                my $i;
320                my $before;
321                my $after;
322               
323                if(scalar @{$field->constraints} > 0) {
324                    $vals_ref = $field->constraints;
325                }
326                else {
327                    $vals_ref = $defaultValues{$type->type . ' ' . $field->name};
328                    $vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;
329                    die("Undefined default values for $fieldTypeName") unless defined $vals_ref;
330                }
331                @vals = @$vals_ref;
332               
333                $before = length ${$templates{$type->type}}[$baseTemplateIndex]->text;
334               
335                ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text
336                                                                     . "\t" . $field->name . ' := ' . $vals[0] . "$comma \n");
337
338                $after = length ${$templates{$type->type}}[$baseTemplateIndex]->text;
339               
340                ## Derive all values
341                for($i=1; $i < scalar @vals; $i++) {       
342                    push(@{$templates{$type->type}}, new Template(  text => "\t" . $field->name . ' := ' . $vals[$i] . "$comma \n",
343                                                                    ref => $baseTemplateIndex,
344                                                                    before => $before,
345                                                                    after => $after));
346                }     
347            }
348            else {
349                # Templatable field     
350               
351                my $vals_ref;
352
353                $fieldType = $types{$fieldTypeName};
354                die("Undefined type $fieldTypeName") unless defined($fieldType);
355               
356                $vals_ref = $defaultValues{$type->type . ' ' . $field->name};
357                $vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;
358                if(defined $vals_ref) {
359
360                    my @vals = [];
361                    my $i;
362                    my $before;
363                    my $after;
364                   
365                    @vals = @$vals_ref;
366                   
367                    # override with default values
368                    $before = length ${$templates{$type->type}}[$baseTemplateIndex]->text;
369                   
370                    ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text
371                                                                         . "\t" . $field->name . ' := ' . $vals[0] . "$comma \n");
372                   
373                    $after = length ${$templates{$type->type}}[$baseTemplateIndex]->text;
374                   
375                    ## Derive all values
376                    for($i=1; $i < scalar @vals; $i++) {       
377                        push(@{$templates{$type->type}}, new Template(  text => "\t" . $field->name . ' := ' . $vals[$i] . "$comma \n",
378                                                                        ref => $baseTemplateIndex,
379                                                                        before => $before,
380                                                                        after => $after));
381                    }
382                }
383                else {
384                    if(defined $templates{$fieldTypeName}) {
385                        # Sub-template has already been defined and derived.
386                        # Use template 0.       
387                        ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text
388                                                                             . "\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_0$comma \n");
389                    }
390                    else {   
391                        # Sub-template not yet defined.
392                        # Use all template versions.
393                        my $before;
394                        my $after;
395                        my $i;
396                       
397                        createTemplatesFromType($fieldType);
398                        die "Undefined templates for $fieldTypeName" unless defined $templates{$fieldTypeName};
399                       
400                        $before = length ${$templates{$type->type}}[$baseTemplateIndex]->text;
401                   
402                        ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text
403                                                                             . "\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_0$comma \n"); 
404                   
405                        $after = length ${$templates{$type->type}}[$baseTemplateIndex]->text;
406                       
407                        # Derive all template versions         
408                        for($i=1; $i < scalar @{$templates{$fieldTypeName}}; $i++) {
409                            push(@{$templates{$type->type}}, new Template(  text => "\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_" . $i . "$comma \n",
410                                                                            ref => $baseTemplateIndex,
411                                                                            before => $before,
412                                                                            after => $after)); 
413                        }   
414                    }
415                }     
416            }
417        }
418        else {
419            ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text
420                                                                 . "\t" . $field->name . " := omit$comma \n"); 
421        }
422    }   
423   
424    ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text . "};\n");
425}
426
427sub createTemplatesFromSet($) {
428    my $type = shift;
429   
430    createTemplatesFromRecord($type);
431}
432
433sub createTemplatesFromRecordOf($) {
434    my $type = shift;
435    my $i;
436    my @fields_;
437    my $field;
438    my $fieldTypeName;
439    my $comma;
440
441    print "createTemplatesFromRecordOf\n" if defined $debug;
442   
443    bless($type, 'Type');
444
445    ${$templates{$type->type}}[0] = new Template(text => "{\n");
446
447    @fields_ = @{$type->field};
448    $field = $fields_[0];
449    bless($field, 'Field');
450    $fieldTypeName = $field->type;
451
452    if(defined $templates{$fieldTypeName}) {
453        ${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text
454                                            . "\t" . 'm_' . lcfirst($fieldTypeName) . "_0\n"); 
455       
456    }
457    else {
458        if($fieldTypeName eq "charstring"
459           or $fieldTypeName eq "integer"
460           or $fieldTypeName eq "boolean") {
461            # Terminal field
462            # Derive all possible values
463           
464            my $vals_ref;
465            my @vals = [];
466            my $i;
467
468            $vals_ref = $defaultValues{$type->type . ' ' . $fieldTypeName};
469            $vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;
470            die("Undefined default values for $fieldTypeName") unless defined $vals_ref;
471
472            @vals = @$vals_ref;
473           
474            ## Derive all values
475            for($i=0; $i < scalar @vals; $i++) {       
476                $comma = ($i+1 == scalar @vals) ? "" : ",";
477                ${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text
478                                                    . "\t" . $vals[$i] . "$comma \n");
479            }     
480        }
481        else {
482            # Templatable field     
483
484            createTemplatesFromType($types{$fieldTypeName});
485            die "Undefined templates for $fieldTypeName" unless defined $templates{$fieldTypeName};
486           
487            # Derive all template versions         
488            for($i=0; $i < scalar @{$templates{$fieldTypeName}}; $i++) {
489                $comma = ($i+1 == scalar @{$templates{$fieldTypeName}}) ? "" : ",";
490                ${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text
491                                                    . "\t" . 'm_' . lcfirst($fieldTypeName) . "_" . $i . "$comma \n"); 
492            }
493        }
494    }
495   
496    ${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text . "};\n");
497} 
498
499sub createTemplatesFromSetOf($) {
500    my $type = shift;
501    my $i;
502    my @fields_;
503    my $field;
504    my $fieldTypeName;
505    my $comma;
506   
507    print "createTemplatesFromSetOf\n" if defined $debug;
508   
509    bless($type, 'Type');
510
511    ${$templates{$type->type}}[0] = new Template(text => "{\n");
512
513    @fields_ = @{$type->field};
514    $field = $fields_[0];
515    bless($field, 'Field');
516    $fieldTypeName = $field->type;
517
518    if(defined $templates{$fieldTypeName}) {
519        ${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text
520                                            . "\t" . 'm_' . lcfirst($fieldTypeName) . "_0\n"); 
521       
522    }
523    else {
524        if($fieldTypeName eq "charstring"
525           or $fieldTypeName eq "integer"
526           or $fieldTypeName eq "boolean") {
527            # Terminal field
528            # Derive all possible values
529           
530            my $vals_ref;
531            my @vals = [];
532            my $i;
533           
534            $vals_ref = $defaultValues{$type->type . ' ' . $fieldTypeName};
535            $vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;
536            die("Undefined default values for $fieldTypeName") unless defined $vals_ref;
537
538            @vals = @$vals_ref;
539           
540            ## Derive all values
541            for($i=0; $i < scalar @vals; $i++) {       
542                $comma = ($i+1 == scalar @vals) ? "" : ",";
543                ${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text
544                                                    . "\t" . $vals[$i] . "$comma \n");
545            }     
546        }
547        else {
548            # Templatable field     
549
550            createTemplatesFromType($types{$fieldTypeName});
551            die "Undefined templates for $fieldTypeName" unless defined $templates{$fieldTypeName};
552           
553            # Derive all template versions         
554            for($i=0; $i < scalar @{$templates{$fieldTypeName}}; $i++) {
555                $comma = ($i+1 == scalar @{$templates{$fieldTypeName}}) ? "" : ",";
556                ${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text
557                                                    . "\t" . 'm_' . lcfirst($fieldTypeName) . "_" . $i . "$comma \n"); 
558            }
559        }
560    }
561   
562    ${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text . "};\n");
563}   
564
565sub createTemplatesFromUnion($) {
566    my $type = shift;
567    my @fields_;
568    my $field;
569
570    print "createTemplatesFromUnion\n" if defined $debug;
571   
572    bless($type, 'Type');
573
574    @fields_ = @{$type->field};
575    foreach $field (@fields_) {
576        my $fieldType;
577        my $fieldTypeName;
578       
579        bless($field, 'Field');
580        $fieldTypeName = $field->type;
581       
582        if((scalar @{$field->constraints} > 0)
583           or $fieldTypeName eq "charstring"
584           or $fieldTypeName eq "integer"
585           or $fieldTypeName eq "boolean") {
586            # Terminal field
587            # Derive all possible values
588           
589            my $vals_ref;
590            my @vals = [];
591            my $i;
592
593            if(scalar @{$field->constraints} > 0) {
594                $vals_ref = $field->constraints;
595            }
596            else {
597                $vals_ref = $defaultValues{$type->type . ' ' . $field->name};
598                $vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;
599                die("Undefined default values for $fieldTypeName") unless defined $vals_ref;
600            }
601            @vals = @$vals_ref;
602           
603            ## Derive all values
604            for($i=0; $i < scalar @vals; $i++) {       
605                push(@{$templates{$type->type}}, new Template(  text => "{\n\t" . $field->name . ' := ' . $vals[$i] . "\n}\n"));
606            }     
607        }
608        else {
609            # Templatable field     
610           
611            $fieldType = $types{$fieldTypeName};
612            die("Undefined type $fieldTypeName") unless defined($fieldType);
613           
614            if(defined $templates{$fieldTypeName}) {
615                # Sub-template has already been defined and derived.
616                # Use template 0.       
617                push(@{$templates{$type->type}}, new Template(  text => "{\n\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_0\n}\n"));
618            }
619            else {   
620                # Sub-template not yet defined.
621                # Use all template versions.
622                my $i;
623               
624                createTemplatesFromType($fieldType);
625                die "Undefined templates for $fieldTypeName" unless defined $templates{$fieldTypeName};
626               
627                # Derive all template versions         
628                for($i=0; $i < scalar @{$templates{$fieldTypeName}}; $i++) {
629                    push(@{$templates{$type->type}}, new Template(  text => "{\n\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_" . $i . "\n}\n"));
630                }   
631            }     
632        }
633    }   
634}
635
636sub createTemplatesFromEnum($) {
637    my $type = shift;
638    my $vals_ref;
639    my @vals = [];
640    my $i;   
641   
642    print "createTemplatesFromEnum\n" if defined $debug;
643   
644    bless($type, 'Type');
645
646    $vals_ref = $type->field;
647    $vals_ref = $defaultValues{$type->type} unless defined $vals_ref;
648    die("Undefined default values for " . $type->type) unless defined $vals_ref;
649
650    @vals = @$vals_ref;
651   
652    ## Derive all values
653    for($i=0; $i < scalar @vals; $i++) {       
654        push(@{$templates{$type->type}}, new Template(  text => $vals[$i] . ";\n"));
655    }     
656}
657
658sub createTemplatesFromAlias($) {
659    my $type = shift;
660    my $baseTypeName;
661    my $baseType;
662   
663    print "createTemplatesFromAlias\n" if defined $debug;
664   
665    bless($type, 'Type');
666
667    $baseTypeName = $type->baseType;
668   
669    if($baseTypeName eq "charstring"
670       or $baseTypeName eq "integer"
671       or $baseTypeName eq "boolean") {
672        # Terminal field
673        # Derive all possible values
674       
675        my $vals_ref;
676        my @vals = [];
677        my $i;
678
679        $vals_ref = $defaultValues{$type->type};
680        $vals_ref = $defaultValues{$baseTypeName} unless defined $vals_ref;
681        die("Undefined default values for $baseTypeName") unless defined $vals_ref;
682        @vals = @$vals_ref;
683       
684        push(@{$templates{$type->type}}, new Template( text => $vals[0] . ";\n"));
685       
686        ## Derive all values
687        for($i=1; $i < scalar @vals; $i++) {       
688            push(@{$templates{$type->type}}, new Template(  text => $vals[$i] . ";\n"));
689        }
690    }     
691    else { 
692        $baseType = $types{$baseTypeName};   
693        die("Undefined type $baseTypeName") unless defined($baseType);
694       
695        if(defined $templates{$baseTypeName}) {
696            # Sub-template has already been defined and derived.
697            # Use template 0.       
698            push(@{$templates{$type->type}}, new Template( text => 'm_' . lcfirst($baseTypeName) . "_0;\n"));
699        }
700        else {   
701            # Sub-template not yet defined.
702            # Use all template versions.
703            my $i;
704           
705            createTemplatesFromType($baseType);
706            die "Undefined templates for $baseTypeName" unless defined $templates{$baseTypeName};
707           
708            push(@{$templates{$type->type}}, new Template( text => 'm_' . lcfirst($baseTypeName) . "_0;\n"));
709           
710            # Derive all template versions         
711            for($i=1; $i < scalar @{$templates{$baseTypeName}}; $i++) {
712                push(@{$templates{$type->type}}, new Template(  text => 'm_' . lcfirst($baseTypeName) . "_" .$i . ";\n")); 
713            } 
714        } 
715    }     
716}
717
718sub createTemplatesFromType($) {
719    my $type = shift;
720   
721    print "createTemplatesFromType\n" if defined $debug;
722   
723    bless($type, 'Type');
724   
725    if($type->baseType eq "record") {
726        createTemplatesFromRecord($type);
727    }
728    elsif($type->baseType eq "set") {
729        createTemplatesFromSet($type);
730    }
731    elsif($type->baseType eq "record of") {
732        createTemplatesFromRecordOf($type);
733    }
734    elsif($type->baseType eq "set of") {
735        createTemplatesFromSetOf($type);
736    }
737    elsif($type->baseType eq "union") {
738        createTemplatesFromUnion($type);
739    }
740    elsif($type->baseType eq "enumerated") {
741        createTemplatesFromEnum($type);
742    }
743    else {
744        #Alias
745        createTemplatesFromAlias($type);
746    }
747}
748
749sub createTemplates() {
750    my $message;
751   
752    print "createTemplates\n" if defined $debug;
753   
754    foreach $message (@messages) {
755        my $type;
756       
757        $type = $types{$message};
758        die("Undefined message $message") unless defined($type);
759       
760        createTemplatesFromType($type);
761    }
762}
763
764sub printTemplates($ $) {
765    my $module = shift;
766    my $imported = shift;
767    my @imports;
768    my $key;
769    my $i;
770   
771    @imports = @$imported;
772
773    open(FILE, ">" . $module . ".ttcn") or die "Unable to open file ${module}.ttcn";
774    print FILE "module $module {\n\n";
775    foreach $imported (@imports) {
776        print FILE "\timport from $imported all;\n";
777    }
778    print FILE "\n";
779    foreach $key (keys %templates) {
780        my @templates_array = @{$templates{$key}};
781       
782        for($i=0; $i < scalar @templates_array; $i++) {
783            my $parentRef;
784
785            $parentRef = $templates_array[$i]->ref;
786            $parentRef = 0 unless defined $parentRef;
787            print FILE "template $key m_" . lcfirst(${key}) . "_$i := ";
788            print FILE substr($templates_array[$parentRef]->text, 0, $templates_array[$i]->before) if defined $templates_array[$i]->before;
789            print FILE $templates_array[$i]->text;
790            print FILE substr($templates_array[$parentRef]->text, $templates_array[$i]->after) if defined $templates_array[$i]->after;
791            print FILE "\n";
792        }
793    }
794    print FILE "} // end module\n";
795    close FILE;
796}
797
798sub printTestcases($ $) {
799    my $module = shift;
800    my $imported = shift;
801    my @imports;
802    my $message;
803    my $i;
804   
805    @imports = @$imported;
806
807    open(FILE, ">" . $module . ".ttcn") or die "Unable to open file ${module}.ttcn";
808    print FILE "module $module {\n\n";
809    foreach $imported (@imports) {
810        print FILE "import from $imported all;\n";
811    }
812    print FILE "\n";
813    foreach $message (@messages) {
814        my @templates_array = @{$templates{$message}};
815       
816        for($i=0; $i < scalar @templates_array; $i++) {
817            my $testcaseName = "TC_LOOPBACK_" . uc($message) . "_" . $i;
818            my $templateName = "m_" . lcfirst($message) . "_" . $i;
819
820            printf FILE $testcaseTemplate, $testcaseName, $templateName, $templateName;
821        }
822    }
823    print FILE "} // end module\n";
824    close FILE;
825}
826
827sub printControl($ $) {
828    my $module = shift;
829    my $imported = shift;
830    my @imports;
831    my $message;
832    my $i;
833   
834    @imports = @$imported;
835
836    open(FILE, ">" . $module . ".ttcn") or die "Unable to open file ${module}.ttcn";
837    print FILE "module $module {\n\n";
838    foreach $imported (@imports) {
839        print FILE "import from $imported all;\n";
840    }
841    print FILE "\n";
842    print FILE "control {\n";
843    foreach $message (@messages) {
844        my @templates_array = @{$templates{$message}};
845       
846        for($i=0; $i < scalar @templates_array; $i++) {
847            my $testcaseName = "TC_LOOPBACK_" . uc($message) . "_" . $i;
848
849            print FILE "\texecute(${testcaseName}());\n";
850        }
851    }
852    print FILE "}\n";
853    print FILE "} // end module\n";
854    close FILE;
855}
856
857sub round($) {
858    my $number = shift;
859    return int($number + .5 * ($number <=> 0));
860}
861
862# MAIN
863my @imports;
864
865initializeDefaultValues();
866
867@imports = ("compiledTypes.txt");
868processTypeFile(\@imports); #TODO ideally would be: \@typeModules
869
870# Create templates !
871createTemplates();
872
873# save template file
874printTemplates($templateModule, \@typeModules);
875
876# save testcase file
877@imports = ($systemModule, $templateModule);
878printTestcases($testcaseModule, \@imports);
879
880# save control file
881@imports = ($testcaseModule);
882printControl($controlModule, \@imports);
Note: See TracBrowser for help on using the repository browser.