| 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 |
|
# newtest() : Initiate a testing sequence |
| 29 |
|
my $fullmodule=shift; |
| 30 |
|
chomp $fullmodule; |
| 31 |
|
my $datadir=shift; |
| 32 |
– |
my $project=shift; |
| 32 |
|
|
| 33 |
|
# The usual Object blessing |
| 34 |
|
$self={}; |
| 38 |
|
my $testmodule; |
| 39 |
|
my $module; |
| 40 |
|
my $dir=""; |
| 41 |
< |
if ( $fullmodule=~/\// ) { |
| 42 |
< |
($dir=$fullmodule)=~s/(.*\/)(.*)/$1/; |
| 43 |
< |
} |
| 41 |
> |
# if ( $fullmodule=~/\// ) { |
| 42 |
> |
# ($dir=$fullmodule)=~s/(.*\/)(.*)/$1/; |
| 43 |
> |
# } |
| 44 |
> |
if ( $fullmodule=~/::/ ) { |
| 45 |
> |
($dir=$fullmodule)=~s/(.*::)(.*)/$1/; |
| 46 |
> |
} |
| 47 |
|
else { $dir="" } |
| 48 |
< |
($testmodule=$fullmodule)=~s/(.*\/)(.*)/$1test\/test_$2/; |
| 49 |
< |
($testmodule=$fullmodule)=~s/${dir}(.*)/${dir}test\/test_$1/; |
| 48 |
> |
($testmodule=$fullmodule)=~s/(.*\/)(.*)/$1test::test_$2/; |
| 49 |
> |
($testmodule=$fullmodule)=~s/${dir}(.*)/${dir}test::test_$1/; |
| 50 |
|
($module=$testmodule)=~s/.*\///g; |
| 51 |
|
|
| 50 |
– |
# Data Initialisation |
| 51 |
– |
$self->{project}=$project; |
| 52 |
|
$self->{class}=$module; |
| 53 |
|
$self->{"datadir"}=$datadir; |
| 54 |
|
$self->{filenumber}=0; |
| 57 |
|
mkpath ($self->{temparea},0, 0777); |
| 58 |
|
|
| 59 |
|
# Now setup a new testobject of the appropriate type |
| 60 |
< |
require $testmodule."\.pm"; |
| 60 |
> |
eval "require $testmodule"; |
| 61 |
> |
die $@ if $@; |
| 62 |
|
$self->{testobj}=$module->_new($self, $fullmodule); |
| 63 |
|
|
| 64 |
|
return $self; |
| 200 |
|
|
| 201 |
|
# Data Initialisation |
| 202 |
|
$self->{testclass}=$class; |
| 203 |
< |
$self->{classname}=$module; |
| 203 |
> |
($self->{classname}=$module)=~s/::/\//g; |
| 204 |
|
($self->{class}=$module)=~s/.*\///g; |
| 205 |
|
$self->{classfile}=$ENV{SCRAM_HOME}."/src/".$self->{classname}."\.pm"; |
| 206 |
|
$self->init(@_); |
| 216 |
|
my $self=shift; |
| 217 |
|
my $subname=shift; |
| 218 |
|
my $myreturn; |
| 219 |
+ |
my $expected; |
| 220 |
|
|
| 221 |
|
$self->_checkdoc($subname); |
| 222 |
|
$self->{inttest}{$subname}++; |
| 227 |
|
if ( exists $self->{expect} ) { |
| 228 |
|
@mylist=eval { $self->{object}->$subname(@_); }; |
| 229 |
|
die "Test Failed $@\n" if $@; |
| 230 |
< |
for $myreturn ( @mylist ) { |
| 231 |
< |
if ( \$myreturn=~/HASH/ ) { |
| 230 |
> |
if ( defined @mylist ) { |
| 231 |
> |
foreach $myreturn ( @mylist ) { |
| 232 |
> |
if ( ! defined $myreturn ) { |
| 233 |
> |
print "Undefined Value Passed Back\n"; |
| 234 |
> |
} |
| 235 |
> |
elsif ( \$myreturn=~/HASH/ ) { |
| 236 |
|
print "Hash Refreturned\n"; |
| 237 |
|
} |
| 238 |
|
elsif ( \$myreturn=~/CODE/ ) { |
| 242 |
|
print "Array Ref returned\n"; |
| 243 |
|
} |
| 244 |
|
else { |
| 245 |
< |
my $expected=$self->{expect}[$num++]; |
| 245 |
> |
$expected=$self->{expect}[$num++]; |
| 246 |
|
if ( $myreturn eq $expected ) { #simple return case |
| 247 |
|
$self->testpass("OK - returned as expected ($expected)"); |
| 248 |
|
} |
| 251 |
|
$myreturn); |
| 252 |
|
} |
| 253 |
|
} |
| 254 |
< |
} |
| 254 |
> |
} # end foreach block |
| 255 |
> |
} |
| 256 |
|
return @mylist; |
| 257 |
|
} |
| 258 |
|
else { |
