diff options
Diffstat (limited to 'CIAO/bin/PerlCIAO/TestUtils.pm')
| -rw-r--r-- | CIAO/bin/PerlCIAO/TestUtils.pm | 323 |
1 files changed, 0 insertions, 323 deletions
diff --git a/CIAO/bin/PerlCIAO/TestUtils.pm b/CIAO/bin/PerlCIAO/TestUtils.pm deleted file mode 100644 index 6cb4ca22fe7..00000000000 --- a/CIAO/bin/PerlCIAO/TestUtils.pm +++ /dev/null @@ -1,323 +0,0 @@ - -#------------------------------------------------------------------------ -# 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 |