Commit 06a757db authored by berge's avatar berge
Browse files

Added loopback test

parent 7e9a4575

codec/validation/LoopbackTests/SipCodecTestGenerator.pl

0 → 100755
+792 −0
Original line number Diff line number Diff line 
#!/usr/bin/perl -w



# TODO:

#      Add comments

#      File input/output 

#      Improve parser so that it can accept any valid input, not only sanitized input



use strict "vars";

use Class::Struct;



#--------------------------------------------------------------------------

my $testcaseTemplate = "\ttestcase %s() runs on SipSimu system SipSimu {\n\n"

    . "\t\t// Preamble\n"

    . "\t\tmap(self:sipPort, self:sipPort);\n\n"

    . "\t\t// Test Body\n"

    . "\t\tsipPort.send(%s);\n"

    . "\t\tsipPort.receive(%s);\n"

    . "\t}\n\n";



my $templateModule = "SipCodecTest_LoopbackTemplates";

my $testcaseModule = "SipCodecTest_LoopbackTestcases";

my $controlModule = "SipCodecTest_LoopbackTestControl";

my @typeModules = ("LibSip_SIPTypesAndValues", "LibSip_SDPTypes", "LibSip_XMLTypes");

my $debug;# = 1;



#--------------------------------------------------------------------------



my %types;

my @messages;

my %defaultValues;

my %templates;





struct(Field, {type => '$', name => '$', optional => '$', constraints => '@'});

struct(Type, {baseType => '$', type => '$', field => '@'});

struct(Template, {text => '$', ref => '$', before => '$', after => '$'});



#--------------------------------------------------------------------------



sub initializeDefaultValues() {

    %defaultValues = (

		      'charstring'          => ['"a"', '"abcde"', '"abcdefghij"'],

		      'integer'             => [1, 2, 3],

		      'boolean'             => ["true", "false"],

		      'SipUrl scheme'       => ['"sip"']

		      );

}





sub processTypeFile($) {

    my $typeFiles_ref = shift;

    my @typeFiles;

    my $file;

    my $line;

    my $BaseType;

    my $Type;

    

    @typeFiles = @$typeFiles_ref;  

    

    foreach $file (@typeFiles) {

	open(FILE, $file) or die "Unable to open file $file";

	while(defined($line=<FILE>)) {

	    if( # set of

		$line=~ m/^\s*type\s+set of\s+(\S+)\s+(\S+)\s*[\{|;]\s*$/

		or $line=~ m/^\s*type\s+set of\s+(\S+)\s+(\S+)\s*$/ ){

		my @field;

		

		$BaseType = $1;

		$Type = $2;

		push (@field, new Field(type => $BaseType, optional => 1));

		$types{$Type} = new Type(baseType => "set of", type => $Type, field => \@field);

	    }

	    elsif( # record of

		   $line=~ m/^\s*type\s+record of\s+(\S+)\s+(\S+)\s*[\{|;]\s*$/ 

		   or $line=~ m/^\s*type\s+record of\s+(\S+)\s+(\S+)\s*$/ ){

		my @field;

		

		$BaseType = $1;

		$Type = $2;

		push (@field, new Field(type => $BaseType, optional => 1));

		$types{$Type} = new Type(baseType => "record of", type => $Type, field => \@field);    

	    }

	    elsif( # port

		   $line=~ m/^\s*type\s+port\s+(\S+)\s+message\s*[\{|;]\s*$/ 

		   or $line=~ m/^\s*type\s+port\s+(\S+)\s+message\s*$/ ) {

		my $loop=1;

		while($loop==1 and defined($line=<FILE>)) {

		    if($line=~ m/^\s*(in|out|inout)\s*$/) {

			# do nothing

		    }

		    elsif($line=~ m/^\s*(\S*)\s*,\s*$/) {  

			push(@messages, $1);    

		    }

		    elsif($line=~ m/^\s*(\S*)\s*$/) {  

			push(@messages, $1);    

			$loop=0;

		    }

		    else {

			die("MISMATCH in port: $line");

		    }

		}

	    }

	    

	    elsif( # standard type

		   $line=~ m/^\s*type\s+(\S+)\s+(\S+)\s*[\{|;]\s*$/

		   or $line=~ m/^\s*type\s+(\S+)\s+(\S+)\s*$/ ){    

		$BaseType = $1;

		$Type = $2;

		if($BaseType eq "record" or $BaseType eq "set" or $BaseType eq "union") {

		    my @field;

		    my $loop=1;

		    

		    while($loop==1 and defined($line=<FILE>)) {       

			my $optional;

			

			if($line=~ m/^\s*\{\s*$/) { 

			    # do nothing

			}

			elsif($line=~ m/^\s*\}\s*$/) { 

			    $loop=0;

			}

			elsif( # non-final field

			       $line=~ m/^\s*(\S*)\s+(\w*)\s*(\(.*\))?\s*(\s+optional)?\s*,\s*$/) { 

			    my @constraint;

			    if(defined $3) { 

				my $constraints = $3;

				$constraints = substr($constraints, 1, length($constraints) - 2) if $1 eq "charstring";

				@constraint = split(/,/, substr($constraints, 1, length($constraints) - 2));

			    }

			    if(defined $4) {

				$optional = 1;

			    }

			    else {

				$optional = 0;

			    }

			    push (@field, new Field(type => $1, name => $2, optional => $optional, constraints => \@constraint));

			}

			elsif( # final field

			       $line=~ m/^\s*(\S*)\s+(\w*)\s*(\(.*\))?\s*(\s+optional)?\s*$/) {  

			    my @constraint;

			    if(defined $3) {

				my $constraints = $3;

				$constraints = substr($constraints, 1, length($constraints) - 2) if $1 eq "charstring";

				@constraint = split(/,/, substr($constraints, 1, length($constraints) - 2));

			    }

			    if(defined $4) {

				$optional = 1;

			    }

			    else {

				$optional = 0;

			    }

			    push (@field, new Field(type => $1, name => $2, optional => $optional, constraints => \@constraint));

			    $loop=0;

			}

			else {

			    die("MISMATCH in record $Type: $line");

			}

		    }

		    $types{$Type} = new Type(baseType => $BaseType, type => $Type, field => \@field);

		}

		elsif($BaseType eq "charstring") {

		    $types{$Type} = new Type(baseType => $BaseType, type => $Type);

		}

		elsif($BaseType eq "integer") {

		    $types{$Type} = new Type(baseType => $BaseType, type => $Type);

		}

		elsif($BaseType eq "enumerated") {

		    my @field;

		    my $loop = 1;

		    

		    while($loop==1 and defined($line=<FILE>)) {                

			if($line=~ m/^\s*\{\s*$/) { 

			    # do nothing

			}

			elsif($line=~ m/^\s*\}\s*$/) { 

			    $loop=0;

			}

			elsif($line=~ m/^\s*(\S*)\s*,\s*$/) { 

			    push (@field, $1);

			}

			elsif($line=~ m/^\s*(\S*)\s*$/) {  

			    push (@field, $1);

			    $loop=0;

			}

			else {

			    die("MISMATCH in record $Type: $line");

			}

		    }

		    $types{$Type} = new Type(baseType => $BaseType, type => $Type, field => \@field);

		}

		elsif($BaseType eq "boolean") {

		    $types{$Type} = new Type(baseType => $BaseType, type => $Type);

		}

		else {

		    $types{$Type} = new Type(baseType => $BaseType, type => $Type);

		}

	    }    

	}

	close FILE;

    }

}



sub createTemplatesFromRecord($) {

    my $type = shift;

    

    print "createTemplatesFromRecord\n" if defined $debug;

    

    bless($type, 'Type');

    helper_createTemplatesFromRecord($type, "all");

    helper_createTemplatesFromRecord($type, "none");

    helper_createTemplatesFromRecord($type, "random");

}





sub helper_createTemplatesFromRecord($ $) {

    my $type = shift;

    my $optionalStrategy = shift;

    my $baseTemplateIndex;

    my @fields_;

    my $field;

    my $fieldIndex;



    print "helper_createTemplatesFromRecord\n" if defined $debug;

    

    bless($type, 'Type');

    

    if(defined $templates{$type->type}) {

	$baseTemplateIndex = scalar @{$templates{$type->type}};

    }

    else {

	$baseTemplateIndex = 0;

    }

    ${$templates{$type->type}}[$baseTemplateIndex] = new Template(text => "{\n");

    

    @fields_ = @{$type->field};

    for($fieldIndex=0; $fieldIndex < scalar @fields_;) { # incremented while inserting comma !

	my $fieldType;

	my $fieldTypeName;

	my $comma;



	$field = $fields_[$fieldIndex];

	$comma = (++$fieldIndex == scalar @fields_) ? "" : ",";

	

	bless($field, 'Field');

	$fieldTypeName = $field->type;

	

	if(

	   ($optionalStrategy eq "all")

	   or (($optionalStrategy eq "none" or $optionalStrategy eq "random") and $field->optional == 0)

	   or ($optionalStrategy eq "random" and $field->optional == 1 and round(rand()) == 1)) {



	    if((scalar @{$field->constraints} > 0)

	       or $fieldTypeName eq "charstring" 

	       or $fieldTypeName eq "integer" 

	       or $fieldTypeName eq "boolean") {

		# Terminal field

		# Derive all possible values

		

		my $vals_ref;

		my @vals = [];

		my $i;

		my $before;

		my $after;

		

		if(scalar @{$field->constraints} > 0) {

		    $vals_ref = $field->constraints;

		}

		else {

		    $vals_ref = $defaultValues{$type->type . ' ' . $field->name};

		    $vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;

		    die("Undefined default values for $fieldTypeName") unless defined $vals_ref;

		}

		@vals = @$vals_ref;

		

		$before = length ${$templates{$type->type}}[$baseTemplateIndex]->text;

		

		${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text 

								     . "\t" . $field->name . ' := ' . $vals[0] . "$comma \n");



		$after = length ${$templates{$type->type}}[$baseTemplateIndex]->text;

		

		## Derive all values

		for($i=1; $i < scalar @vals; $i++) {        

		    push(@{$templates{$type->type}}, new Template(  text => "\t" . $field->name . ' := ' . $vals[$i] . "$comma \n",

								    ref => $baseTemplateIndex,

								    before => $before,

								    after => $after));

		}      

	    }

	    else { 

		# Templatable field      

		

		$fieldType = $types{$fieldTypeName};

		die("Undefined type $fieldTypeName") unless defined($fieldType);

		

		if(defined $templates{$fieldTypeName}) {

		    # Sub-template has already been defined and derived.

		    # Use template 0.        

		    ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text 

									 . "\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_0$comma \n"); 

		}

		else {    

		    # Sub-template not yet defined. 

		    # Use all template versions.

		    my $before;

		    my $after;

		    my $i;

		    

		    createTemplatesFromType($fieldType);

		    die "Undefined templates for $fieldTypeName" unless defined $templates{$fieldTypeName};

		    

		    $before = length ${$templates{$type->type}}[$baseTemplateIndex]->text;

		    

		    ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text 

									 . "\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_0$comma \n");  

		    

		    $after = length ${$templates{$type->type}}[$baseTemplateIndex]->text;

		    

		    # Derive all template versions          

		    for($i=1; $i < scalar @{$templates{$fieldTypeName}}; $i++) {

			push(@{$templates{$type->type}}, new Template(  text => "\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_" . $i . "$comma \n",

									ref => $baseTemplateIndex,

									before => $before,

									after => $after));  

		    }    

		}      

	    }

	}

	else {

	    ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text 

								 . "\t" . $field->name . " := omit$comma \n");  

	}

    }   

    

    ${$templates{$type->type}}[$baseTemplateIndex]->text(${$templates{$type->type}}[$baseTemplateIndex]->text . "};\n");

}



sub createTemplatesFromSet($) {

    my $type = shift;

    

    createTemplatesFromRecord($type);

}



sub createTemplatesFromRecordOf($) {

    my $type = shift;

    my $i;

    my @fields_;

    my $field;

    my $fieldTypeName;

    my $comma;



    print "createTemplatesFromRecordOf\n" if defined $debug;

    

    bless($type, 'Type');



    ${$templates{$type->type}}[0] = new Template(text => "{\n");



    @fields_ = @{$type->field};

    $field = $fields_[0];

    bless($field, 'Field');

    $fieldTypeName = $field->type;



    if(defined $templates{$fieldTypeName}) {

	${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text 

					    . "\t" . 'm_' . lcfirst($fieldTypeName) . "_0\n");  

	

    }

    else {

	if($fieldTypeName eq "charstring" 

	   or $fieldTypeName eq "integer" 

	   or $fieldTypeName eq "boolean") {

	    # Terminal field

	    # Derive all possible values

	    

	    my $vals_ref;

	    my @vals = [];

	    my $i;



	    $vals_ref = $defaultValues{$type->type . ' ' . $fieldTypeName};

	    $vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;

	    die("Undefined default values for $fieldTypeName") unless defined $vals_ref;



	    @vals = @$vals_ref;

	    

	    ## Derive all values

	    for($i=0; $i < scalar @vals; $i++) {        

		$comma = ($i+1 == scalar @vals) ? "" : ",";

		${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text 

						    . "\t" . $vals[$i] . "$comma \n");

	    }      

	}

	else {

	    # Templatable field      



	    createTemplatesFromType($types{$fieldTypeName});

	    die "Undefined templates for $fieldTypeName" unless defined $templates{$fieldTypeName};

	    

	    # Derive all template versions          

	    for($i=0; $i < scalar @{$templates{$fieldTypeName}}; $i++) {

		$comma = ($i+1 == scalar @{$templates{$fieldTypeName}}) ? "" : ",";

		${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text 

						    . "\t" . 'm_' . lcfirst($fieldTypeName) . "_" . $i . "$comma \n");  

	    }

	}

    }

    

    ${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text . "};\n");

}  



sub createTemplatesFromSetOf($) {

    my $type = shift;

    my $i;

    my @fields_;

    my $field;

    my $fieldTypeName;

    my $comma;

    

    print "createTemplatesFromSetOf\n" if defined $debug;

    

    bless($type, 'Type');



    ${$templates{$type->type}}[0] = new Template(text => "{\n");



    @fields_ = @{$type->field};

    $field = $fields_[0];

    bless($field, 'Field');

    $fieldTypeName = $field->type;



    if(defined $templates{$fieldTypeName}) {

	${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text 

					    . "\t" . 'm_' . lcfirst($fieldTypeName) . "_0\n");  

	

    }

    else {

	if($fieldTypeName eq "charstring" 

	   or $fieldTypeName eq "integer" 

	   or $fieldTypeName eq "boolean") {

	    # Terminal field

	    # Derive all possible values

	    

	    my $vals_ref;

	    my @vals = [];

	    my $i;

	    

	    $vals_ref = $defaultValues{$type->type . ' ' . $fieldTypeName};

	    $vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;

	    die("Undefined default values for $fieldTypeName") unless defined $vals_ref;



	    @vals = @$vals_ref;

	    

	    ## Derive all values

	    for($i=0; $i < scalar @vals; $i++) {        

		$comma = ($i+1 == scalar @vals) ? "" : ",";

		${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text 

						    . "\t" . $vals[$i] . "$comma \n");

	    }      

	}

	else {

	    # Templatable field      



	    createTemplatesFromType($types{$fieldTypeName});

	    die "Undefined templates for $fieldTypeName" unless defined $templates{$fieldTypeName};

	    

	    # Derive all template versions          

	    for($i=0; $i < scalar @{$templates{$fieldTypeName}}; $i++) {

		$comma = ($i+1 == scalar @{$templates{$fieldTypeName}}) ? "" : ",";

		${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text 

						    . "\t" . 'm_' . ($fieldTypeName) . "_" . $i . "$comma \n");  

	    }

	}

    }

    

    ${$templates{$type->type}}[0]->text(${$templates{$type->type}}[0]->text . "};\n");

}   



sub createTemplatesFromUnion($) {

    my $type = shift;

    my @fields_;

    my $field;



    print "createTemplatesFromUnion\n" if defined $debug;

    

    bless($type, 'Type');



    @fields_ = @{$type->field};

    foreach $field (@fields_) {

	my $fieldType;

	my $fieldTypeName;

	

	bless($field, 'Field');

	$fieldTypeName = $field->type;

	

	if((scalar @{$field->constraints} > 0)

	   or $fieldTypeName eq "charstring" 

	   or $fieldTypeName eq "integer" 

	   or $fieldTypeName eq "boolean") {

	    # Terminal field

	    # Derive all possible values

	    

	    my $vals_ref;

	    my @vals = [];

	    my $i;



	    if(scalar @{$field->constraints} > 0) {

		$vals_ref = $field->constraints;

	    }

	    else {

		$vals_ref = $defaultValues{$type->type . ' ' . $field->name};

		$vals_ref = $defaultValues{$fieldTypeName} unless defined $vals_ref;

		die("Undefined default values for $fieldTypeName") unless defined $vals_ref;

	    }

	    @vals = @$vals_ref;

	    

	    ## Derive all values

	    for($i=0; $i < scalar @vals; $i++) {        

		push(@{$templates{$type->type}}, new Template(  text => "{\n\t" . $field->name . ' := ' . $vals[$i] . "\n}\n"));

	    }      

	}

	else { 

	    # Templatable field      

	    

	    $fieldType = $types{$fieldTypeName};

	    die("Undefined type $fieldTypeName") unless defined($fieldType);

	    

	    if(defined $templates{$fieldTypeName}) {

		# Sub-template has already been defined and derived.

		# Use template 0.        

		push(@{$templates{$type->type}}, new Template(  text => "{\n\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_0\n}\n")); 

	    }

	    else {    

		# Sub-template not yet defined. 

		# Use all template versions.

		my $i;

		

		createTemplatesFromType($fieldType);

		die "Undefined templates for $fieldTypeName" unless defined $templates{$fieldTypeName};

		

		# Derive all template versions          

		for($i=0; $i < scalar @{$templates{$fieldTypeName}}; $i++) {

		    push(@{$templates{$type->type}}, new Template(  text => "{\n\t" . $field->name . ' := m_' . lcfirst($fieldTypeName) . "_" . $i . "\n}\n")); 

		}    

	    }      

	}

    }   

} 



sub createTemplatesFromEnum($) {

    my $type = shift;

    my $vals_ref;

    my @vals = [];

    my $i;    

    

    print "createTemplatesFromEnum\n" if defined $debug;

    

    bless($type, 'Type');



    $vals_ref = $type->field;

    $vals_ref = $defaultValues{$type->type} unless defined $vals_ref;

    die("Undefined default values for " . $type->type) unless defined $vals_ref;



    @vals = @$vals_ref;

    

    ## Derive all values

    for($i=0; $i < scalar @vals; $i++) {        

	push(@{$templates{$type->type}}, new Template(  text => $vals[$i] . ";\n"));

    }      

} 



sub createTemplatesFromAlias($) {

    my $type = shift;

    my $baseTypeName;

    my $baseType;

    

    print "createTemplatesFromAlias\n" if defined $debug;

    

    bless($type, 'Type');



    $baseTypeName = $type->baseType;

    

    if($baseTypeName eq "charstring" 

       or $baseTypeName eq "integer" 

       or $baseTypeName eq "boolean") {

	# Terminal field

	# Derive all possible values

	

	my $vals_ref;

	my @vals = [];

	my $i;



	$vals_ref = $defaultValues{$baseTypeName};

	die("Undefined default values for $baseTypeName") unless defined $vals_ref;

	@vals = @$vals_ref;

	

	push(@{$templates{$type->type}}, new Template( text => $vals[0] . ";\n"));

	

	## Derive all values

	for($i=1; $i < scalar @vals; $i++) {        

	    push(@{$templates{$type->type}}, new Template(  text => $vals[$i] . ";\n"));

	} 

    }     

    else {  

	$baseType = $types{$baseTypeName};    

	die("Undefined type $baseTypeName") unless defined($baseType);

	

	if(defined $templates{$baseTypeName}) {

	    # Sub-template has already been defined and derived.

	    # Use template 0.        

	    push(@{$templates{$type->type}}, new Template( text => 'm_' . lcfirst($baseTypeName) . "_0;\n")); 

	}

	else {    

	    # Sub-template not yet defined. 

	    # Use all template versions.

	    my $i;

	    

	    createTemplatesFromType($baseType);

	    die "Undefined templates for $baseTypeName" unless defined $templates{$baseTypeName};

	    

	    push(@{$templates{$type->type}}, new Template( text => 'm_' . lcfirst($baseTypeName) . "_0;\n")); 

	    

	    # Derive all template versions          

	    for($i=1; $i < scalar @{$templates{$baseTypeName}}; $i++) {

		push(@{$templates{$type->type}}, new Template(  text => 'm_' . lcfirst($baseTypeName) . "_" .$i . ";\n"));  

	    }  

	}  

    }      

} 



sub createTemplatesFromType($) {

    my $type = shift;

    

    print "createTemplatesFromType\n" if defined $debug;

    

    bless($type, 'Type');

    

    if($type->baseType eq "record") {

	createTemplatesFromRecord($type);

    }

    elsif($type->baseType eq "set") {

	createTemplatesFromSet($type);

    }

    elsif($type->baseType eq "record of") {

	createTemplatesFromRecordOf($type);

    }

    elsif($type->baseType eq "set of") {

	createTemplatesFromSetOf($type);

    }

    elsif($type->baseType eq "union") {

	createTemplatesFromUnion($type);

    } 

    elsif($type->baseType eq "enumerated") {

	createTemplatesFromEnum($type);

    } 

    else {

	#Alias

	createTemplatesFromAlias($type);

    }

}



sub createTemplates() {

    my $message;

    

    print "createTemplates\n" if defined $debug;

    

    foreach $message (@messages) {

	my $type;

	

	$type = $types{$message};

	die("Undefined message $message") unless defined($type);

	

	createTemplatesFromType($type);

    }

}



sub printTemplates($ $) {

    my $module = shift;

    my $imported = shift;

    my @imports;

    my $key;

    my $i;

    

    @imports = @$imported;



    open(FILE, ">" . $module . ".ttcn") or die "Unable to open file ${module}.ttcn";

    print FILE "module $module {\n\n";

    foreach $imported (@imports) {

	print FILE "\timport from $imported all;\n";

    }

    print FILE "\n";

    foreach $key (keys %templates) {

	my @templates_array = @{$templates{$key}};

	

	for($i=0; $i < scalar @templates_array; $i++) {

	    my $parentRef;



	    $parentRef = $templates_array[$i]->ref;

	    $parentRef = 0 unless defined $parentRef;

	    print FILE "template $key m_" . lcfirst(${key}) . "_$i := ";

	    print FILE substr($templates_array[$parentRef]->text, 0, $templates_array[$i]->before) if defined $templates_array[$i]->before;

	    print FILE $templates_array[$i]->text;

	    print FILE substr($templates_array[$parentRef]->text, $templates_array[$i]->after) if defined $templates_array[$i]->after;

	    print FILE "\n";

	}

    }

    print FILE "} // end module\n";

    close FILE;

}



sub printTestcases($ $) {

    my $module = shift;

    my $imported = shift;

    my @imports;

    my $message;

    my $i;

    

    @imports = @$imported;



    open(FILE, ">" . $module . ".ttcn") or die "Unable to open file ${module}.ttcn";

    print FILE "module $module {\n\n";

    foreach $imported (@imports) {

	print FILE "import from $imported all;\n";

    }

    print FILE "\n";

    foreach $message (@messages) {

	my @templates_array = @{$templates{$message}};

	

	for($i=0; $i < scalar @templates_array; $i++) {

	    my $testcaseName = "TC_LOOPBACK_" . uc($message) . "_" . $i;

	    my $templateName = "m_" . ucfirst($message) . "_" . $i;



	    printf FILE $testcaseTemplate, $testcaseName, $templateName, $templateName;

	}

    }

    print FILE "} // end module\n";

    close FILE;

}



sub printControl($ $) {

    my $module = shift;

    my $imported = shift;

    my @imports;

    my $message;

    my $i;

    

    @imports = @$imported;



    open(FILE, ">" . $module . ".ttcn") or die "Unable to open file ${module}.ttcn";

    print FILE "module $module {\n\n";

    foreach $imported (@imports) {

	print FILE "import from $imported all;\n";

    }

    print FILE "\n";

    print FILE "control {\n";

    foreach $message (@messages) {

	my @templates_array = @{$templates{$message}};

	

	for($i=0; $i < scalar @templates_array; $i++) {

	    my $testcaseName = "TC_LOOPBACK_" . uc($message) . "_" . $i;



	    print FILE "\texecute(${testcaseName}());\n";

	}

    }

    print FILE "}\n";

    print FILE "} // end module\n";

    close FILE;

}



sub round($) {

    my $number = shift;

    return int($number + .5 * ($number <=> 0));

}



# MAIN

my @imports;



initializeDefaultValues(); 



@imports = ("compiledTypes.txt");

processTypeFile(\@imports); #TODO ideally would be: \@typeModules



# Create templates !

createTemplates();



# save template file

printTemplates($templateModule, \@typeModules);



# save testcase file

@imports = ($templateModule);

printTestcases($testcaseModule, \@imports);



# save control file

@imports = ($testcaseModule);

printControl($controlModule, \@imports);

codec/validation/LoopbackTests/SipCodecTest_LoopbackTemplates.ttcn

0 → 100644
+36224 −0

File added.

Preview size limit exceeded, changes collapsed.

codec/validation/LoopbackTests/SipCodecTest_LoopbackTestControl.ttcn

0 → 100644
+529 −0

File added.

Preview size limit exceeded, changes collapsed.

codec/validation/LoopbackTests/SipCodecTest_LoopbackTestcases.ttcn

0 → 100644
+5225 −0

File added.

Preview size limit exceeded, changes collapsed.

codec/validation/LoopbackTests/compiledTypes.txt

0 → 100644
+1323 −0

File added.

Preview size limit exceeded, changes collapsed.