| 3 |
|
# |
| 4 |
|
# Interface |
| 5 |
|
# --------- |
| 6 |
< |
# new($module,testdatadir,project) : module example - Utilities/urlhandler |
| 6 |
> |
# new($module,testdatadir) : module example - Utilities/urlhandler |
| 7 |
|
# dotest(@args) : Start testing - arguments dependent on inheriting class |
| 8 |
|
# |
| 9 |
+ |
# cmpstring(expectedstring,returnedstring) : cmp a string and fail if not equal |
| 10 |
|
# newtest() : Initiate a testing sequence |
| 11 |
|
# verify(actual_result_file, expected_result_file) : compare two files |
| 12 |
|
# verifydir(dir) : Check existence of the directory |
| 13 |
+ |
# verifyexists(file) : Verify the existence of file |
| 14 |
|
# datadir([dir]) : return the current data directory (set it to dir if supplied) |
| 15 |
< |
# ------------------- Private Methods ---------------------------------- |
| 15 |
> |
# testswitch(bool,"true text","falsetext") : testpass or fail according to bool |
| 16 |
> |
# testfail(string) : report that current test has failed |
| 17 |
> |
# testpass(string) : report that current test has passed |
| 18 |
|
# newfilename() : return a new filename that can be opened etc. |
| 19 |
|
# temparea() : return a directory for building temporary stuff |
| 20 |
|
# newobject(@args) : Set up a new object to be tested |
| 21 |
|
# testinterface($name,@args) : perform interface tests for $name with @args |
| 22 |
|
# expect(string) : tell the testinterface of any expected return values |
| 23 |
|
# clearexpect() : Reset any expect variables. |
| 24 |
+ |
#cleantemp() : delete the temporary area |
| 25 |
+ |
# cmparray(arrayref, @reqvals) : test the arrayref against expected |
| 26 |
+ |
# cmpstring(expectedstring,actualstring) : |
| 27 |
|
|
| 28 |
< |
package TestClass; |
| 28 |
> |
package Utilities::TestClass; |
| 29 |
|
require 5.004; |
| 30 |
|
$bold = "\033[1m"; |
| 31 |
|
$normal = "\033[0m"; |
| 36 |
|
my $fullmodule=shift; |
| 37 |
|
chomp $fullmodule; |
| 38 |
|
my $datadir=shift; |
| 32 |
– |
my $project=shift; |
| 39 |
|
|
| 40 |
|
# The usual Object blessing |
| 41 |
|
$self={}; |
| 44 |
|
#some local working variables |
| 45 |
|
my $testmodule; |
| 46 |
|
my $module; |
| 47 |
< |
my $dir; |
| 48 |
< |
if ( $fullmodule=~/\// ) { |
| 49 |
< |
($dir=$fullmodule)=~s/(.*\/)(.*)/$1/; |
| 50 |
< |
} |
| 47 |
> |
my $dir=""; |
| 48 |
> |
# if ( $fullmodule=~/\// ) { |
| 49 |
> |
# ($dir=$fullmodule)=~s/(.*\/)(.*)/$1/; |
| 50 |
> |
# } |
| 51 |
> |
if ( $fullmodule=~/::/ ) { |
| 52 |
> |
($dir=$fullmodule)=~s/(.*::)(.*)/$1/; |
| 53 |
> |
} |
| 54 |
|
else { $dir="" } |
| 55 |
< |
($testmodule=$fullmodule)=~s/(.*\/)(.*)/$1test\/test_$2/; |
| 56 |
< |
($testmodule=$fullmodule)=~s/${dir}(.*)/${dir}test\/test_$1/; |
| 55 |
> |
($testmodule=$fullmodule)=~s/(.*\/)(.*)/$1test::test_$2/; |
| 56 |
> |
($testmodule=$fullmodule)=~s/${dir}(.*)/${dir}test::test_$1/; |
| 57 |
|
($module=$testmodule)=~s/.*\///g; |
| 58 |
|
|
| 50 |
– |
# Data Initialisation |
| 51 |
– |
$self->{project}=$project; |
| 59 |
|
$self->{class}=$module; |
| 60 |
|
$self->{"datadir"}=$datadir; |
| 61 |
|
$self->{filenumber}=0; |
| 62 |
+ |
rmtree("/tmp/SCRAMtest++"); |
| 63 |
+ |
$self->{temparea}="/tmp/SCRAMtest++"; |
| 64 |
+ |
use File::Path; |
| 65 |
+ |
mkpath ($self->{temparea},0, 0777); |
| 66 |
|
|
| 67 |
|
# Now setup a new testobject of the appropriate type |
| 68 |
< |
require $testmodule."\.pm"; |
| 68 |
> |
eval "require $testmodule"; |
| 69 |
> |
die $@ if $@; |
| 70 |
|
$self->{testobj}=$module->_new($self, $fullmodule); |
| 71 |
|
|
| 72 |
+ |
# make sure the temparea is cleaned |
| 73 |
+ |
use File::Path; |
| 74 |
+ |
|
| 75 |
|
return $self; |
| 76 |
|
} |
| 77 |
|
|
| 84 |
|
$self->{testobj}->checktests(); |
| 85 |
|
} |
| 86 |
|
|
| 87 |
+ |
sub cmparray { |
| 88 |
+ |
my $self=shift; |
| 89 |
+ |
my $array=shift; |
| 90 |
+ |
my @vals=@_; |
| 91 |
+ |
|
| 92 |
+ |
if ( $#{$array} ne $#vals) { $self->testfail( |
| 93 |
+ |
$#{$array}." items retuned, $#vals expected"); |
| 94 |
+ |
} |
| 95 |
+ |
else { |
| 96 |
+ |
for( my $i=0; $i<= $#{$array}; $i++) { |
| 97 |
+ |
$self->cmpstring($vals[$i],$$array[$i]); |
| 98 |
+ |
} |
| 99 |
+ |
} |
| 100 |
+ |
} |
| 101 |
+ |
|
| 102 |
|
|
| 103 |
+ |
sub cmpstring { |
| 104 |
+ |
my $self=shift; |
| 105 |
+ |
my $s1=shift; |
| 106 |
+ |
my $s2=shift; |
| 107 |
+ |
|
| 108 |
+ |
if ( ! defined $s2) { |
| 109 |
+ |
$self->testfail("Return string is undefined expecting $s1"), |
| 110 |
+ |
} |
| 111 |
+ |
elsif ( $s1 ne $s2 ) { |
| 112 |
+ |
$self->testfail("Expecting $s1 got $s2"); |
| 113 |
+ |
} |
| 114 |
+ |
else { |
| 115 |
+ |
$self->testpass("Got $s2 as expected"); |
| 116 |
+ |
} |
| 117 |
+ |
} |
| 118 |
|
|
| 119 |
|
# A virtual method to be overridden |
| 120 |
|
sub init { |
| 128 |
|
my $self=shift; |
| 129 |
|
my $string=shift; |
| 130 |
|
$self->{testnumber}++; |
| 131 |
< |
$self->_testout(); |
| 131 |
> |
$self->_testout(""); |
| 132 |
|
$self->_testout("---------------------------* Test $self->{testnumber}". |
| 133 |
|
" *------------------------------"); |
| 134 |
|
$self->_testout("| $string "); |
| 149 |
|
open ( FILE1, "<$file1" ) or die "Cannot Read Test Output $file1 $!\n"; |
| 150 |
|
open ( FILE2, "<$file2" ) or die "Cannot Read Benchmark file ". |
| 151 |
|
"$file2 $!\n"; |
| 152 |
< |
while ( $f1=<FILE1> ) { |
| 153 |
< |
$f2=<FILE2>; |
| 154 |
< |
if ( $f2 ne $f1 ) { |
| 155 |
< |
print "T:\n$f1\nB:$f2\n"; |
| 152 |
> |
while ( $f1=<FILE2> ) { |
| 153 |
> |
$f2=<FILE1>; |
| 154 |
> |
if ( (!defined $f2 ) || ( ! defined $f1) || ($f2 ne $f1 )) { |
| 155 |
> |
#print "T:\n$f1\nB:$f2\n"; |
| 156 |
|
$same=0; |
| 157 |
|
} |
| 158 |
|
} |
| 168 |
|
my $name=shift; |
| 169 |
|
|
| 170 |
|
if ( -d "$name" ) { |
| 171 |
< |
$self->testpass(); |
| 171 |
> |
$self->testpass("Directory $name exists - test passed"); |
| 172 |
|
} |
| 173 |
|
else { |
| 174 |
|
$self->testfail("Directory $name does not exist"); |
| 175 |
|
} |
| 176 |
|
} |
| 177 |
|
|
| 178 |
+ |
sub verifyexists { |
| 179 |
+ |
my $self=shift; |
| 180 |
+ |
my $name=shift; |
| 181 |
+ |
|
| 182 |
+ |
if ( -e "$name" ) { |
| 183 |
+ |
$self->testpass("$name exists - test passed"); |
| 184 |
+ |
} |
| 185 |
+ |
else { |
| 186 |
+ |
$self->testfail("$name does not exist"); |
| 187 |
+ |
} |
| 188 |
+ |
} |
| 189 |
+ |
|
| 190 |
+ |
sub testswitch { |
| 191 |
+ |
my $self=shift; |
| 192 |
+ |
my $bool=shift; |
| 193 |
+ |
my $string1=shift; |
| 194 |
+ |
my $string2=shift; |
| 195 |
+ |
|
| 196 |
+ |
if ( $bool ) { |
| 197 |
+ |
$self->testpass($string1); |
| 198 |
+ |
} |
| 199 |
+ |
else { |
| 200 |
+ |
$self->testfail($string2); |
| 201 |
+ |
} |
| 202 |
+ |
} |
| 203 |
+ |
|
| 204 |
|
sub testfail { |
| 205 |
|
my $self=shift; |
| 206 |
|
my $string=shift; |
| 267 |
|
|
| 268 |
|
# Data Initialisation |
| 269 |
|
$self->{testclass}=$class; |
| 270 |
< |
$self->{classname}=$module; |
| 270 |
> |
($self->{classname}=$module)=~s/::/\//g; |
| 271 |
|
($self->{class}=$module)=~s/.*\///g; |
| 272 |
|
$self->{classfile}=$ENV{SCRAM_HOME}."/src/".$self->{classname}."\.pm"; |
| 202 |
– |
$self->{testclassfile}=$path."/test/".$self->{testclass}."\.pm"; |
| 273 |
|
$self->init(@_); |
| 274 |
|
$self->analyseInterface(); |
| 275 |
|
delete $self->{expect}; |
| 283 |
|
my $self=shift; |
| 284 |
|
my $subname=shift; |
| 285 |
|
my $myreturn; |
| 286 |
+ |
my $expected; |
| 287 |
|
|
| 288 |
|
$self->_checkdoc($subname); |
| 289 |
|
$self->{inttest}{$subname}++; |
| 290 |
|
$self->_testout(">Trying interface $subname "); |
| 291 |
|
my $args=join ', ', @_; |
| 292 |
|
$self->_testout( " (".$args.")" ); |
| 293 |
+ |
$num=0; |
| 294 |
|
if ( exists $self->{expect} ) { |
| 295 |
< |
@myreturn=($self->{object}->$subname(@_)); |
| 296 |
< |
if ( "@myreturn" eq $self->{expect} ) { |
| 297 |
< |
$self->testpass("OK - returned as expected"); |
| 298 |
< |
} |
| 299 |
< |
else { |
| 300 |
< |
$self->testfail("Expecting $self->{expect}, got @myreturn"); |
| 295 |
> |
print "Testing Expected Values against actual returns ....\n"; |
| 296 |
> |
@mylist=eval { $self->{object}->$subname(@_); }; |
| 297 |
> |
die "Test Failed $@\n" if $@; |
| 298 |
> |
my $nrv=$#mylist+1; my $nrve=$#{$self->{expect}}+1; |
| 299 |
> |
print $nrv." values returned ".$nrve." expected\n"; |
| 300 |
> |
if ( $nrv != $nrve ) { |
| 301 |
> |
$self->testfail("Number of returned values != that expected"); |
| 302 |
> |
} |
| 303 |
> |
if ( defined @mylist ) { |
| 304 |
> |
# size check |
| 305 |
> |
if ( $#mylist != $#{$self->{expect}} ) { |
| 306 |
> |
$self->testfail("Number of returned values inconsistent"); |
| 307 |
> |
} |
| 308 |
> |
foreach $myreturn ( @mylist ) { |
| 309 |
> |
if ( ! defined $myreturn ) { |
| 310 |
> |
print "Undefined Value Passed Back\n"; |
| 311 |
> |
} |
| 312 |
> |
elsif ( $myreturn=~/HASH/ ) { |
| 313 |
> |
print "Hash Ref ".ref($myreturn)." returned\n"; |
| 314 |
|
} |
| 315 |
< |
return @myreturn; |
| 315 |
> |
elsif ( $myreturn=~/CODE/ ) { |
| 316 |
> |
print "Code Ref returned\n"; |
| 317 |
> |
} |
| 318 |
> |
elsif ( $myreturn=~/ARRAY/ ) { |
| 319 |
> |
print "Array Ref returned\n"; |
| 320 |
> |
} |
| 321 |
> |
else { |
| 322 |
> |
$expected=$self->{expect}[$num++]; |
| 323 |
> |
if ( $myreturn eq $expected ) { #simple return case |
| 324 |
> |
$self->testpass("OK - returned as expected ($expected)"); |
| 325 |
> |
} |
| 326 |
> |
else { |
| 327 |
> |
$self->testfail("Expecting $expected, got ". |
| 328 |
> |
$myreturn); |
| 329 |
> |
} |
| 330 |
> |
} |
| 331 |
> |
} # end foreach block |
| 332 |
> |
} |
| 333 |
> |
return @mylist; |
| 334 |
|
} |
| 335 |
|
else { |
| 336 |
|
return ($self->{object}->$subname(@_)); |
| 342 |
|
# |
| 343 |
|
sub expect { |
| 344 |
|
my $self=shift; |
| 242 |
– |
my $string=shift; |
| 345 |
|
|
| 346 |
< |
$self->{expect}=$string; |
| 346 |
> |
push @{$self->{expect}}, @_; |
| 347 |
|
} |
| 348 |
|
|
| 349 |
|
sub clearexpect { |
| 441 |
|
} |
| 442 |
|
close SRCIN; |
| 443 |
|
} |
| 444 |
+ |
|
| 445 |
+ |
sub cleantemp { |
| 446 |
+ |
my $self=shift; |
| 447 |
+ |
use File::Path; |
| 448 |
+ |
rmtree($self->temparea()); |
| 449 |
+ |
} |
