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 *
#	Content
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	# Revision: $Id: TestSuite.pm,v 1.3 2005/08/17 16:24:52 sashby Exp $
8	#
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	use Cwd;
48
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	$self->{TESTREPORT}={};
69	$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	$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	mkdir($SANDBOX."/scramdb");
95	$self->{WORKDIR} = $SANDBOX;
96	chdir($self->{WORKDIR});
97	$self->{PROJECTNAME} = "SCRAMTestSuite";
98	$self->{PROJECTVERSION} = "1.0";
99	$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	}
106
107	sub run()
108	{
109	my $self=shift;
110	map { print "-> Running test for \"".$_."\" command\n\n"; $self->$_(); }
111	@{$self->{COMMANDS}};
112	}
113
114	sub statusreport()
115	{
116	my $self=shift;
117	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	}
130
131	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	sub version()
149	{
150	my $self=shift;
151	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	}
158
159	sub arch()
160	{
161	my $self=shift;
162	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	}
167
168	sub urlget()
169	{
170	my $self=shift;
171	my $status = system($self->{SCRAMMAIN},"urlget","-h");
172	$self->log("urlget","Test of help functionality", $status);
173	}
174
175	sub list()
176	{
177	my $self=shift;
178	my $status = system($self->{SCRAMMAIN},"list","-h");
179	$self->log("list","Test of help functionality", $status);
180
181
182	$ENV{SCRAM_USERLOOKUPDB} = "";
183	}
184
185	sub db()
186	{
187	my $self=shift;
188	my $status = system($self->{SCRAMMAIN},"db","-h");
189	$self->log("db","Test of help functionality", $status);
190
191
192
193	}
194
195
196
197
198
199	sub project()
200	{
201	my $self=shift;
202	my $status = system($self->{SCRAMMAIN},"project","-h");
203	$self->log("project","Test of help functionality", $status);
204
205	# Copy the config and toolbox to the sandbox dir:
206	system("cp","-r","../config",".");
207	system("cp","-r","../SCRAMToolBox",".");
208
209	# Create a new project:
210	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	# Install it:
214	my $status = system($self->{SCRAMMAIN},"install");
215	$self->log("install","Test installing new project areas", $status);
216
217	# Create a developer area, rename it, install it in a different directory:
218
219	# Remove project from database:
220
221
222	}
223
224	sub runtime()
225	{
226	my $self=shift;
227	my $status = system($self->{SCRAMMAIN},"runtime","-h");
228	$self->log("runtime","Test of help functionality", $status);
229
230
231	}
232
233	sub config()
234	{
235	my $self=shift;
236	my $status = system($self->{SCRAMMAIN},"config","-h");
237	$self->log("config","Test of help functionality", $status);
238
239
240	}
241
242	sub setup()
243	{
244	my $self=shift;
245	my $status = system($self->{SCRAMMAIN},"setup","-h");
246	$self->log("setup","Test of help functionality", $status);
247	}
248
249	sub tool()
250	{
251	my $self=shift;
252	my $status = system($self->{SCRAMMAIN},"tool","-h");
253	$self->log("tool","Test of help functionality", $status);
254
255	}
256
257	sub gui()
258	{
259	my $self=shift;
260	my $status = system($self->{SCRAMMAIN},"gui","-h");
261	$self->log("gui","Test of help functionality", $status);
262	}
263
264	sub build()
265	{
266	my $self=shift;
267	my $status = system($self->{SCRAMMAIN},"build","-h");
268	$self->log("build","Test of help functionality", $status);
269	}
270
271	sub xmlmigrate()
272	{
273	my $self=shift;
274	my $status = system($self->{SCRAMMAIN},"xmlmigrate","-h");
275	$self->log("xmlmigrate","Test of help functionality", $status);
276	}
277
278	sub install()
279	{
280	my $self=shift;
281	my $status = system($self->{SCRAMMAIN},"install","-h");
282	$self->log("install","Test of help functionality", $status);
283	}
284
285	sub remove()
286	{
287	my $self=shift;
288	my $status = system($self->{SCRAMMAIN},"remove","-h");
289	$self->log("remove","Test of help functionality", $status);
290	}
291
292
293	1;
294
295	__END__
296
297
298	=back
299
300	=head1 AUTHOR/MAINTAINER
301
302	Shaun Ashby
303
304	=cut
305