src/Testing/TestSuite.pm

#____________________________________________________________________ 
# File: TestSuite.pm
#____________________________________________________________________ 
#  
# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
# Update: 2005-08-17 15:49:06+0200
# Revision: $Id: TestSuite.pm,v 1.3 2005/08/17 16:24:52 sashby Exp $ 
#
# Copyright: 2005 (C) Shaun Ashby
#
#--------------------------------------------------------------------
package TestSuite;

=head1 NAME

TestSuite - A package to contain testing routines for each SCRAM command.

=head1 SYNOPSIS

        my $obj = TestSuite->new();
        $obj->run();
        $obj->statusreport();

=head1 DESCRIPTION

A testing utility. This runs the installed scram script B<scram.pl> using
B<system()>, passing whichever arguments are needed. Each command has a
self-contained set of tests in its own subroutine in this package to fully
exercise all supported options.

This package is used only by the test script B<testsuite.pl> found in the
Testing directory.

When a new command or command option is introduced, a subroutine in this package
must be created (or modified, if an option is added) to define a test.

=head1 METHODS

=over

=cut

require 5.004;
use Exporter;
use Installation::SCRAM_SITE;
use SCRAM::SCRAM;
use Cwd;

@ISA=qw(Exporter);
@EXPORT_OK=qw( );


sub new()
   {
   ###############################################################
   # new                                                         #
   ###############################################################
   # modified : Wed Aug 17 15:49:14 2005 / SFA                   #
   # params   :                                                  #
   #          :                                                  #
   # function :                                                  #
   #          :                                                  #
   ###############################################################
   my $proto=shift;
   my $class=ref($proto) || $proto;
   my $self={};
   bless $self,$class;
   $self->{TESTREPORT}={};
   $self->{SCRAM} = SCRAM::SCRAM->new();
   $self->{COMMANDS} = $self->{SCRAM}->commands();
   $self->{SCRAMMAIN} = $ENV{'SCRAM_HOME'}."/src/main/scram.pl";

   # Check to make sure that SCRAM installation has already been done:
   die "SCRAM TestSuite: Unable to find the installed scram script!","\n"
      if (! -f $self->{SCRAMMAIN});
   $self->init_();
   return $self;
   }

sub init_()
   {
   my $self=shift;
   
   # Set up parameters needed for the tests:
   my $SANDBOX=cwd()."/SandBoxForTestSuite";
   # Get rid of existing dir:
   if ( -d $SANDBOX )
      {
      system("rm","-rf",$SANDBOX);      
      }
   
   # Create new sandbox:
   mkdir($SANDBOX);
   mkdir($SANDBOX."/scramdb");
   $self->{WORKDIR} = $SANDBOX;
   chdir($self->{WORKDIR});
   $self->{PROJECTNAME} = "SCRAMTestSuite";
   $self->{PROJECTVERSION} = "1.0";
   $self->{PROJECTFULLNAME} = $self->{PROJECTNAME}."_".$self->{PROJECTVERSION};
   $self->{PROJECTINSTALLNAME} = "SCRAMtsdev";

   # Override the installation project db:
   $ENV{SCRAM_USERLOOKUPDB} = $self->{WORKDIR}."/scramdb/project.lookup";
   system("touch",$ENV{SCRAM_USERLOOKUPDB});
   }

sub run()
   {
   my $self=shift;
   map { print "-> Running test for \"".$_."\" command\n\n"; $self->$_(); }
   @{$self->{COMMANDS}};
   }

sub statusreport()
   {
   my $self=shift;
   print "\n";
   foreach my $cmd (keys %{$self->{TESTREPORT}})
      {
      print "Report for ".uc($cmd)." tests:","\n";

      foreach my $detail (@{$self->{TESTREPORT}->{$cmd}})
         {
         print "\t".$detail->[0]." (status = ".$detail->[1].")","\n";
         }
      print "\n";
      }
   
   }

sub log()
   {
   my $self=shift;
   my ($cmd,$message,$status)=@_;

   if (exists($self->{TESTREPORT}->{$cmd}))
      {
      push(@{$self->{TESTREPORT}->{$cmd}},[ $message, $status ]);
      }
   else
      {
      $self->{TESTREPORT}->{$cmd} = [ [ $message, $status ] ];
      }
   }


#### Command Routines ####
sub version()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"version","-h");
   $self->log("version","Test of help functionality", $status);
   my $status = system($self->{SCRAMMAIN},"version","-c");
   $self->log("version","Test of \"-c\" argument", $status);
   my $status = system($self->{SCRAMMAIN},"version","-i");
   $self->log("version","Test of \"-i\" argument", $status);
   }

sub arch()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"arch","-h");
   $self->log("arch","Test of help functionality", $status);
   my $status = system($self->{SCRAMMAIN},"-arch","TEST_ARCHITECTURE","arch");
   $self->log("arch","Test of -arch argument", $status);
   }

sub urlget()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"urlget","-h");
   $self->log("urlget","Test of help functionality", $status);
   }

sub list()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"list","-h");
   $self->log("list","Test of help functionality", $status);

      
   $ENV{SCRAM_USERLOOKUPDB} = "";
   }

sub db()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"db","-h");
   $self->log("db","Test of help functionality", $status);

   
   }


sub project()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"project","-h");
   $self->log("project","Test of help functionality", $status);

   # Copy the config and toolbox to the sandbox dir:
   system("cp","-r","../config",".");
   system("cp","-r","../SCRAMToolBox",".");
   
   # Create a new project:
   my $status = system($self->{SCRAMMAIN},"project","-b","config/bootfile.test");
   $self->log("project","Test creating new project areas", $status);
   chdir($self->{PROJECTFULLNAME});
   # Install it:
   my $status = system($self->{SCRAMMAIN},"install");
   $self->log("install","Test installing new project areas", $status);

   # Create a developer area, rename it, install it in a different directory:
   
   # Remove project from database:
   

   }

sub runtime()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"runtime","-h");
   $self->log("runtime","Test of help functionality", $status);


   }

sub config()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"config","-h");
   $self->log("config","Test of help functionality", $status);

   
   }

sub setup()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"setup","-h");
   $self->log("setup","Test of help functionality", $status);   
   }

sub tool()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"tool","-h");
   $self->log("tool","Test of help functionality", $status);   

   }

sub gui()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"gui","-h");
   $self->log("gui","Test of help functionality", $status);   
   }

sub build()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"build","-h");
   $self->log("build","Test of help functionality", $status);   
   }

sub xmlmigrate()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"xmlmigrate","-h");
   $self->log("xmlmigrate","Test of help functionality", $status);   
   }

sub install()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"install","-h");
   $self->log("install","Test of help functionality", $status);
   }

sub remove()
   {
   my $self=shift;
   my $status = system($self->{SCRAMMAIN},"remove","-h");
   $self->log("remove","Test of help functionality", $status);
   }


1;

__END__


=back

=head1 AUTHOR/MAINTAINER

Shaun Ashby

=cut

Revision:	1.4
Committed:	Fri Oct 14 15:56:10 2005 UTC (19 years, 6 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_0_3-p4, forV1_1_0, v103_xml_071106, V1_0_3-p3, V1_0_3-p2, before110xmlBRmerge, V110p2, V110p1, V1_0_4p1, V1_0_3-p1, V1_0_3, V1_0_2, V1_0_2_p1
Branch point for:	v103_with_xml, v103_branch
Changes since 1.3:	+4 -4 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	sashby	1.1	#____________________________________________________________________
2			# File: TestSuite.pm
3			#____________________________________________________________________
4			#
5			# Author: Shaun Ashby <Shaun.Ashby@cern.ch>
6			# Update: 2005-08-17 15:49:06+0200
7	sashby	1.4	# Revision: $Id: TestSuite.pm,v 1.3 2005/08/17 16:24:52 sashby Exp $
8	sashby	1.1	#
9			# Copyright: 2005 (C) Shaun Ashby
10			#
11			#--------------------------------------------------------------------
12			package TestSuite;
13
14			=head1 NAME
15
16			TestSuite - A package to contain testing routines for each SCRAM command.
17
18			=head1 SYNOPSIS
19
20			my $obj = TestSuite->new();
21			$obj->run();
22			$obj->statusreport();
23
24			=head1 DESCRIPTION
25
26			A testing utility. This runs the installed scram script B<scram.pl> using
27			B<system()>, passing whichever arguments are needed. Each command has a
28			self-contained set of tests in its own subroutine in this package to fully
29			exercise all supported options.
30
31			This package is used only by the test script B<testsuite.pl> found in the
32			Testing directory.
33
34			When a new command or command option is introduced, a subroutine in this package
35			must be created (or modified, if an option is added) to define a test.
36
37			=head1 METHODS
38
39			=over
40
41			=cut
42
43			require 5.004;
44			use Exporter;
45			use Installation::SCRAM_SITE;
46			use SCRAM::SCRAM;
47	sashby	1.2	use Cwd;
48	sashby	1.1
49			@ISA=qw(Exporter);
50			@EXPORT_OK=qw( );
51
52
53			sub new()
54			{
55			###############################################################
56			# new #
57			###############################################################
58			# modified : Wed Aug 17 15:49:14 2005 / SFA #
59			# params : #
60			# : #
61			# function : #
62			# : #
63			###############################################################
64			my $proto=shift;
65			my $class=ref($proto) \|\| $proto;
66			my $self={};
67			bless $self,$class;
68	sashby	1.2	$self->{TESTREPORT}={};
69	sashby	1.1	$self->{SCRAM} = SCRAM::SCRAM->new();
70			$self->{COMMANDS} = $self->{SCRAM}->commands();
71			$self->{SCRAMMAIN} = $ENV{'SCRAM_HOME'}."/src/main/scram.pl";
72
73			# Check to make sure that SCRAM installation has already been done:
74			die "SCRAM TestSuite: Unable to find the installed scram script!","\n"
75			if (! -f $self->{SCRAMMAIN});
76	sashby	1.2	$self->init_();
77			return $self;
78			}
79
80			sub init_()
81			{
82			my $self=shift;
83
84			# Set up parameters needed for the tests:
85			my $SANDBOX=cwd()."/SandBoxForTestSuite";
86			# Get rid of existing dir:
87			if ( -d $SANDBOX )
88			{
89			system("rm","-rf",$SANDBOX);
90			}
91
92			# Create new sandbox:
93			mkdir($SANDBOX);
94	sashby	1.3	mkdir($SANDBOX."/scramdb");
95	sashby	1.2	$self->{WORKDIR} = $SANDBOX;
96			chdir($self->{WORKDIR});
97			$self->{PROJECTNAME} = "SCRAMTestSuite";
98			$self->{PROJECTVERSION} = "1.0";
99	sashby	1.3	$self->{PROJECTFULLNAME} = $self->{PROJECTNAME}."_".$self->{PROJECTVERSION};
100			$self->{PROJECTINSTALLNAME} = "SCRAMtsdev";
101
102			# Override the installation project db:
103			$ENV{SCRAM_USERLOOKUPDB} = $self->{WORKDIR}."/scramdb/project.lookup";
104			system("touch",$ENV{SCRAM_USERLOOKUPDB});
105	sashby	1.1	}
106
107			sub run()
108			{
109			my $self=shift;
110	sashby	1.2	map { print "-> Running test for \"".$_."\" command\n\n"; $self->$_(); }
111	sashby	1.1	@{$self->{COMMANDS}};
112			}
113
114			sub statusreport()
115			{
116			my $self=shift;
117	sashby	1.2	print "\n";
118			foreach my $cmd (keys %{$self->{TESTREPORT}})
119			{
120			print "Report for ".uc($cmd)." tests:","\n";
121
122			foreach my $detail (@{$self->{TESTREPORT}->{$cmd}})
123			{
124			print "\t".$detail->[0]." (status = ".$detail->[1].")","\n";
125			}
126			print "\n";
127			}
128
129	sashby	1.1	}
130
131	sashby	1.2	sub log()
132			{
133			my $self=shift;
134			my ($cmd,$message,$status)=@_;
135
136			if (exists($self->{TESTREPORT}->{$cmd}))
137			{
138			push(@{$self->{TESTREPORT}->{$cmd}},[ $message, $status ]);
139			}
140			else
141			{
142			$self->{TESTREPORT}->{$cmd} = [ [ $message, $status ] ];
143			}
144			}
145
146
147			#### Command Routines ####
148	sashby	1.1	sub version()
149			{
150			my $self=shift;
151	sashby	1.2	my $status = system($self->{SCRAMMAIN},"version","-h");
152			$self->log("version","Test of help functionality", $status);
153			my $status = system($self->{SCRAMMAIN},"version","-c");
154			$self->log("version","Test of \"-c\" argument", $status);
155			my $status = system($self->{SCRAMMAIN},"version","-i");
156			$self->log("version","Test of \"-i\" argument", $status);
157	sashby	1.1	}
158
159			sub arch()
160			{
161			my $self=shift;
162	sashby	1.2	my $status = system($self->{SCRAMMAIN},"arch","-h");
163			$self->log("arch","Test of help functionality", $status);
164			my $status = system($self->{SCRAMMAIN},"-arch","TEST_ARCHITECTURE","arch");
165			$self->log("arch","Test of -arch argument", $status);
166	sashby	1.1	}
167
168	sashby	1.2	sub urlget()
169	sashby	1.1	{
170			my $self=shift;
171	sashby	1.2	my $status = system($self->{SCRAMMAIN},"urlget","-h");
172			$self->log("urlget","Test of help functionality", $status);
173	sashby	1.1	}
174
175	sashby	1.2	sub list()
176	sashby	1.1	{
177			my $self=shift;
178	sashby	1.2	my $status = system($self->{SCRAMMAIN},"list","-h");
179			$self->log("list","Test of help functionality", $status);
180
181
182			$ENV{SCRAM_USERLOOKUPDB} = "";
183	sashby	1.1	}
184
185	sashby	1.2	sub db()
186	sashby	1.1	{
187			my $self=shift;
188	sashby	1.2	my $status = system($self->{SCRAMMAIN},"db","-h");
189			$self->log("db","Test of help functionality", $status);
190
191
192
193	sashby	1.1	}
194
195	sashby	1.2
196
197
198
199			sub project()
200	sashby	1.1	{
201			my $self=shift;
202	sashby	1.2	my $status = system($self->{SCRAMMAIN},"project","-h");
203			$self->log("project","Test of help functionality", $status);
204
205	sashby	1.3	# Copy the config and toolbox to the sandbox dir:
206			system("cp","-r","../config",".");
207			system("cp","-r","../SCRAMToolBox",".");
208
209	sashby	1.2	# Create a new project:
210	sashby	1.3	my $status = system($self->{SCRAMMAIN},"project","-b","config/bootfile.test");
211			$self->log("project","Test creating new project areas", $status);
212			chdir($self->{PROJECTFULLNAME});
213	sashby	1.2	# Install it:
214	sashby	1.3	my $status = system($self->{SCRAMMAIN},"install");
215			$self->log("install","Test installing new project areas", $status);
216	sashby	1.2
217			# Create a developer area, rename it, install it in a different directory:
218	sashby	1.3
219	sashby	1.2	# Remove project from database:
220
221
222	sashby	1.1	}
223
224	sashby	1.2	sub runtime()
225	sashby	1.1	{
226			my $self=shift;
227	sashby	1.2	my $status = system($self->{SCRAMMAIN},"runtime","-h");
228			$self->log("runtime","Test of help functionality", $status);
229
230
231	sashby	1.1	}
232
233	sashby	1.2	sub config()
234	sashby	1.1	{
235			my $self=shift;
236	sashby	1.2	my $status = system($self->{SCRAMMAIN},"config","-h");
237			$self->log("config","Test of help functionality", $status);
238
239
240	sashby	1.1	}
241
242			sub setup()
243			{
244			my $self=shift;
245	sashby	1.2	my $status = system($self->{SCRAMMAIN},"setup","-h");
246			$self->log("setup","Test of help functionality", $status);
247	sashby	1.1	}
248
249			sub tool()
250			{
251			my $self=shift;
252	sashby	1.2	my $status = system($self->{SCRAMMAIN},"tool","-h");
253			$self->log("tool","Test of help functionality", $status);
254
255	sashby	1.1	}
256
257	sashby	1.4	sub gui()
258	sashby	1.1	{
259			my $self=shift;
260	sashby	1.4	my $status = system($self->{SCRAMMAIN},"gui","-h");
261			$self->log("gui","Test of help functionality", $status);
262	sashby	1.1	}
263
264			sub build()
265			{
266			my $self=shift;
267	sashby	1.2	my $status = system($self->{SCRAMMAIN},"build","-h");
268			$self->log("build","Test of help functionality", $status);
269	sashby	1.1	}
270
271			sub xmlmigrate()
272			{
273			my $self=shift;
274	sashby	1.2	my $status = system($self->{SCRAMMAIN},"xmlmigrate","-h");
275			$self->log("xmlmigrate","Test of help functionality", $status);
276	sashby	1.1	}
277
278			sub install()
279			{
280			my $self=shift;
281	sashby	1.2	my $status = system($self->{SCRAMMAIN},"install","-h");
282			$self->log("install","Test of help functionality", $status);
283	sashby	1.1	}
284
285			sub remove()
286			{
287	sashby	1.2	my $self=shift;
288			my $status = system($self->{SCRAMMAIN},"remove","-h");
289			$self->log("remove","Test of help functionality", $status);
290	sashby	1.1	}
291
292
293			1;
294
295			__END__
296
297
298			=back
299
300			=head1 AUTHOR/MAINTAINER
301
302			Shaun Ashby
303
304			=cut
305