diff options
Diffstat (limited to 'modules/CIAO/bin/PerlCIAO')
| -rw-r--r-- | modules/CIAO/bin/PerlCIAO/TestUtils.base | 3 | ||||
| -rw-r--r-- | modules/CIAO/bin/PerlCIAO/TestUtils.pm | 323 | ||||
| -rw-r--r-- | modules/CIAO/bin/PerlCIAO/TestUtils_Base.pm | 78 | ||||
| -rwxr-xr-x | modules/CIAO/bin/PerlCIAO/generate_container.pl | 126 | ||||
| -rw-r--r-- | modules/CIAO/bin/PerlCIAO/perlciao.mpc | 10 |
5 files changed, 540 insertions, 0 deletions
diff --git a/modules/CIAO/bin/PerlCIAO/TestUtils.base b/modules/CIAO/bin/PerlCIAO/TestUtils.base new file mode 100644 index 00000000000..7e68a521d2f --- /dev/null +++ b/modules/CIAO/bin/PerlCIAO/TestUtils.base @@ -0,0 +1,3 @@ +processes +files +wd diff --git a/modules/CIAO/bin/PerlCIAO/TestUtils.pm b/modules/CIAO/bin/PerlCIAO/TestUtils.pm new file mode 100644 index 00000000000..6cb4ca22fe7 --- /dev/null +++ b/modules/CIAO/bin/PerlCIAO/TestUtils.pm @@ -0,0 +1,323 @@ + +#------------------------------------------------------------------------ +# class: TestUtils +# Author: Stoyan Paunov +# +# Description: This is a class to help us write better and more manage- +# able test utilities. Usually when creating a test in +# CIAO it has to do with deploying a number of managers +# and failure to deploy any process means failure of the +# test. This test utility class takes care of the error +# handling and clean-up and side of testing and allows +# the test writer to concentrate on the core logic. +# These are the main advantages of the TestUtils class: +# --> Semi-Automatic error handling +# --> Automatic process shutdown and clean-up +# --> Semi-Automatic file (IOR) deletion +# --> Location independent tests +# --> Clean and concise code base +# --> Manageable test utility suites +#------------------------------------------------------------------------ + +# class TestUtils +sub new; +sub DESTROY; +sub cleanup; +sub goto_dir; +sub spawn; +sub terminate; +sub required_file; +sub required_files; +sub mark_file; +sub mark_files; +sub remove_file; +sub remove_files; +sub cleanup_files; +sub cleanup_processes; + +package TestUtils; +use PerlCIAO::TestUtils_Base; +use strict; +our @ISA = qw(TestUtils_Base); # inherits from TestUtils_Base + +use lib "$ENV{'ACE_ROOT'}/bin"; +use PerlACE::Run_Test; +use Cwd; + +#------------------------------------------------------------------------ +# Constructor +#------------------------------------------------------------------------ +sub new { + my $class = shift; + + #call the constructor of the parent class, TestUtils_Base. + my $self = $class->SUPER::new(); + + $self->{_wd} = getcwd; + + bless $self, $class; + return $self; +} + +#------------------------------------------------------------------------ +# Destructor: performs clean-up +#------------------------------------------------------------------------ + +sub DESTROY { + my $self = shift; + + #$self->cleanup (); check the CLEAN-UP description for explanation +} + +#------------------------------------------------------------------------ +# Cleanup: This fuction kills the spawned processes and deletes the +# marked files. Optionally, once the cleanup is done it will +# cause the program to exit, iff an exit code is specified. +# +# +# NOTE: You need to call the cleanup () although it is called +# in the destructor because this class is a wrapper around +# PerlACE::Run_Test which also keep some internal state +# and tries to do some clean-up. However its destructor +# is called before this one, and this results in some +# errors. +#------------------------------------------------------------------------ + +sub cleanup { + my $self = shift; + my $exit_code = shift; + + print "Performing clean-up ...\n"; + + $self->cleanup_files (); + $self->cleanup_processes (); + + print "Cleanup = DONE\n"; + + chdir $self->wd (); + + if (defined ($exit_code)) { + exit ($exit_code); + } +} + +#------------------------------------------------------------------------ +# Goto_dir: This function allows you to change the current working +# directory. Note that the class returns to the original +# working directory upon exit. +#------------------------------------------------------------------------ + +#TODO: might want to push the dir to some stack +sub goto_dir { + my $self = shift; + my $dir = shift; + + if (! (chdir $dir)) { + print STDERR "Failed to change directory to: $dir"; + $self->cleanup (); + } + +} + +#------------------------------------------------------------------------ +# Spawn: This function is used to spawn a process. It takes a descriptive +# name under which it stores the process, the command line and the +# arguments needed by the command. Optionally, you could specify +# a timeout based on which the process would be spawned and if +# it has not terminated after timeout seconds it will be killed. +# If a failure occurs the function will perform clean-up and +# terminate the program. +#------------------------------------------------------------------------ + +sub spawn { + my $self = shift; + my $name = shift; + my $cmd = shift; + my $args = shift; + my $timeout = shift; + + if (!defined ($self->processes ())) { + $self->{_processes} = {}; + } + + my $process = new PerlACE::Process ($cmd, $args); + + if (defined ($timeout)) { + if ((my $ret = $process->SpawnWaitKill ($timeout)) == -1) { + print STDERR "ERROR: Process $name returned $ret.\n"; + $self->cleanup (1); + } + } + else { + if ($process->Spawn () == -1) { + $process->Kill (); + #just in case, lets add it to the process list + $self->processes->{$name} = $process; + print STDERR "ERROR: Failure to spawn $name.\n"; + $self->cleanup (1); + } + } + + $self->processes->{$name} = $process; + return $process; +} + +#------------------------------------------------------------------------ +# Terminate: This function takes in the descriptive process name passed +# to Spawn, looks up the process corresponding to it and +# kills it. +#------------------------------------------------------------------------ + +sub terminate { + my $self = shift; + my $pname = shift; + + $self->processes ()->{$pname}->Kill (); + $self->processes ()->{$pname}->TimedWait (1); + + print STDERR "$pname teminated!\n"; +} + +#------------------------------------------------------------------------ +# Required_file: This function checks if a required file is present in +# the current working directory. If the file is missing +# it performs cleanup and causes the program to exit. +#------------------------------------------------------------------------ + +sub required_file { + my $self = shift; + my $file = shift; + + if (PerlACE::waitforfile_timed + ($file, $PerlACE::wait_interval_for_process_creation) == -1) { + + print STDERR + "ERROR: Required file $file could not be found.\n"; + + $self->cleanup (1); + } + return 1; +} + +#------------------------------------------------------------------------ +# Required_filez: This function does the same as required_file above +# except that it works on a reference (REF) to a list +# of required files. +#------------------------------------------------------------------------ + +sub required_files { + my $self = shift; + my $files = shift; + my $pname = shift; + + foreach my $file (@{$files}) { + + if (PerlACE::waitforfile_timed + ($file, $PerlACE::wait_interval_for_process_creation) == -1) { + + print STDERR + "ERROR: Required file $file could not be found.\n"; + + $self->cleanup (1); + } + } + return 1; +} + +#------------------------------------------------------------------------ +# Mark_file: This function marks a file from the current working +# directory for deletion. Once the file is marked it will be +# deleted upon program termination. If the file cannot be +# found, it is ignored. +#------------------------------------------------------------------------ + +sub mark_file { + my $self = shift; + my $file = shift; + + if (!defined $self->files ()) { + $self->{_files} = []; + } + + push @{$self->files ()}, $file; +} + +#------------------------------------------------------------------------ +# Mark_filez: This function does the same as mark_file above except +# that it works on a reference (REF) to an array/list of +# required files. +#------------------------------------------------------------------------ + +sub mark_files { + my $self = shift; + my $files = shift; + + if (!defined $self->files ()) { + $self->{_files} = []; + } + + foreach my $file (@{$files}) { + push @{$self->files ()}, $file; + } +} + +#------------------------------------------------------------------------ +# Remove_file: This fuction removes a file from the current working +# directory. If the file is not there, it is ignored. +#------------------------------------------------------------------------ + +sub remove_file { + my $self = shift; + my $file = shift; + + my $path = PerlACE::LocalFile ($file); + unlink $path; +} + +#------------------------------------------------------------------------ +# Remove_filez: This fuction removes a list of file from the current +# working directory. It takes a REF of a list of files +# and ignores files which are not found. +#------------------------------------------------------------------------ + +sub remove_files { + my $self = shift; + my $files = shift; + + foreach my $file (@{$files}) { + my $path = PerlACE::LocalFile ($file); + unlink $path; + } +} + +#------------------------------------------------------------------------ +# Cleanup_files: clean us the files :) +#------------------------------------------------------------------------ + +sub cleanup_files { + my $self = shift; + + if (defined ($self->files ())) { + foreach my $file (@{$self->files ()}) { + $self->remove_file ($file); + } + } +} + +#------------------------------------------------------------------------ +# Cleanup_processes: clean us the processes :) +#------------------------------------------------------------------------ + +sub cleanup_processes { + my $self = shift; + + if (defined ($self->processes ())) { + foreach my $pname ( keys %{$self->processes ()}) { + $self->terminate ($pname); + delete ($self->processes ()->{$pname}); + } + } +} + +#return value of the class +1;
\ No newline at end of file diff --git a/modules/CIAO/bin/PerlCIAO/TestUtils_Base.pm b/modules/CIAO/bin/PerlCIAO/TestUtils_Base.pm new file mode 100644 index 00000000000..be0726946c9 --- /dev/null +++ b/modules/CIAO/bin/PerlCIAO/TestUtils_Base.pm @@ -0,0 +1,78 @@ +#File generated by C:\ACE_wrappers_devel\ACE_wrappers\TAO\CIAO\bin\PerlCIAO\generate_container.pl. +#Input file: TestUtils.base. +#Code generator author: Stoyan Paunov +# + +#class TestUtils_Base +package TestUtils_Base; +use strict; + +#Class constructor :) +sub new { + my ($class) = @_; + + #Create a reference to an anonymous hash + my $self = { + _processes => undef, + _files => undef, + _wd => undef + }; + + #Bless the hash. + bless $self, $class; + return $self; +} + +#accessor/mutator method for processes +sub processes { + my ( $self, $processes ) = @_; + + $self->{_processes} = $processes + if defined ($processes); + + return $self->{_processes}; +} + +#accessor/mutator method for files +sub files { + my ( $self, $files ) = @_; + + $self->{_files} = $files + if defined ($files); + + return $self->{_files}; +} + +#accessor/mutator method for wd +sub wd { + my ( $self, $wd ) = @_; + + $self->{_wd} = $wd + if defined ($wd); + + return $self->{_wd}; +} + +#print method for the class +sub print { + my ($self) = @_; + + my $f; + + $f = defined ($self->{_processes}) + ? $self->{_processes} : "not defined"; + printf ("processes: %s\n", $f); + + $f = defined ($self->{_files}) + ? $self->{_files} : "not defined"; + printf ("files: %s\n", $f); + + $f = defined ($self->{_wd}) + ? $self->{_wd} : "not defined"; + printf ("wd: %s\n", $f); + +} + +#class return value +1; + diff --git a/modules/CIAO/bin/PerlCIAO/generate_container.pl b/modules/CIAO/bin/PerlCIAO/generate_container.pl new file mode 100755 index 00000000000..c56c03ea300 --- /dev/null +++ b/modules/CIAO/bin/PerlCIAO/generate_container.pl @@ -0,0 +1,126 @@ +#!/usr/bin/perl +# +# $Id$ +# +# The above line is for compatibility /w Linux. Windows uses the .pl extension. +# Author: Stoyan Paunov +# Purpose: Generate a container class with mutator/accessor methods +# The idea is to use this class as a base class in the +# inheritance hierarchy. This way we can evolve the base +# container independently from the rest of the code! +# + +use strict; + +die "Usage: $0 <module name> <field description file>\n" + if not defined $ARGV[0]; + +die "Usage: $0 <module name> <field description file>\n" + if not defined $ARGV[1]; + +my $module_name = $ARGV[0]; +my $fields = $ARGV[1]; + +open (FIELDS, $fields) or die "Failed opening $fields\n"; + +my @fields = <FIELDS>; +close FIELDS; + +my $field; + +print "\#File generated by $0.\n"; +print "\#Input file: $fields.\n"; +print "\#Code generator author: Stoyan Paunov\n\#\n\n"; + +print "\#class $module_name\n"; +print "package $module_name;\n"; +print "use strict;\n\n"; +print "\#Class constructor :)\n"; +print "sub new {\n"; +print " my (\$class) = \@_;\n\n"; +print " \#Create a reference to an anonymous hash\n"; +print " my \$self = {\n"; + +my $count = 0; +my $end = $#fields; + +#generate initialization code +foreach $field (@fields) +{ + if ($field =~ /^$/ ) # empty line + { + next; + } + + chomp ($field); + + if ($count == $end) + { + printf (" _\%-14s => undef\n", $field); + next; + } + printf (" _\%-14s => undef,\n", $field); + + + $count++ +} + +print " };\n\n"; +print " \#Bless the hash.\n"; +print " bless \$self, \$class;\n"; +print " return \$self;\n"; +print "}\n\n"; + +#Code to generate the accessor and mutator + +foreach $field (@fields) +{ + if ($field =~ /^$/ ) # empty line + { + next; + } + + chomp ($field); + + print "\#accessor/mutator method for $field\n"; + print "sub $field {\n"; + print " my ( \$self, \$$field ) = \@_;\n\n"; + print " \$self->{_$field} = \$$field\n"; + print " if defined (\$$field);\n\n"; + print " return \$self->{_$field};\n"; + print "}\n\n"; + +} + + +print "\#print method for the class\n"; +print "sub print {\n"; +print " my (\$self) = \@_;\n\n"; + +print " my \$f;\n\n"; + +#Code to generate a print method which dumps the object state +foreach $field (@fields) +{ + if ($field =~ /^$/ ) # empty line + { + next; + } + + chomp ($field); + print " \$f = defined (\$self->{_$field}) \n"; + print " ? \$self->{_$field} : \"not defined\";\n"; + print " printf (\"$field: %s\\n\", \$f);\n\n"; + +} + + + +print "}\n\n"; + +print "\#class return value \n1;\n\n"; + + + + + diff --git a/modules/CIAO/bin/PerlCIAO/perlciao.mpc b/modules/CIAO/bin/PerlCIAO/perlciao.mpc new file mode 100644 index 00000000000..681f977300f --- /dev/null +++ b/modules/CIAO/bin/PerlCIAO/perlciao.mpc @@ -0,0 +1,10 @@ + +// $Id$ + +project(PerlCIAO) : script { + Script_Files { + TestUtils.pm + TestUtils_Base.pm + } + custom_only=1 +} |