summaryrefslogtreecommitdiff
path: root/CIAO/bin/PerlCIAO/TestUtils.pm
diff options
context:
space:
mode:
Diffstat (limited to 'CIAO/bin/PerlCIAO/TestUtils.pm')
-rw-r--r--CIAO/bin/PerlCIAO/TestUtils.pm323
1 files changed, 323 insertions, 0 deletions
diff --git a/CIAO/bin/PerlCIAO/TestUtils.pm b/CIAO/bin/PerlCIAO/TestUtils.pm
new file mode 100644
index 00000000000..6cb4ca22fe7
--- /dev/null
+++ b/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
View Lorry Controller Status