ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/BuildSystem/test/test_BuildFile.pm
Revision: 1.2
Committed: Tue Sep 12 13:00:27 2000 UTC (24 years, 8 months ago) by williamc
Content type: text/plain
Branch: MAIN
Changes since 1.1: +131 -0 lines
Log Message:
add basic test infrastructure

File Contents

# User Rev Content
1 williamc 1.2 #
2     # BuildFile.pm test suite
3     #
4    
5     package BuildSystem::test::test_BuildFile;
6     require 5.001;
7     use BuildSystem::BuildFile;
8    
9     @ISA=qw(Utilities::TestClass); #methods both from the test class
10    
11     sub init {
12     my $self=shift;
13     $self->{testfile}=$self->datadir()."/BuildFileDoc";
14     $self->{arch}="testarch";
15     $ENV{SCRAM_ARCH}=$self->{arch};
16     $ENV{INTwork}="tmp/".$ENV{SCRAM_ARCH};
17    
18     $self->{path}="/src";
19     $ENV{THISDIR}=$self->{path};
20     $self->{testarea}=$self->temparea()."/TestArea";
21     $self->{workarea}=$self->{testarea}."/".
22     $ENV{INTwork}."/".$self->{path};
23    
24     # make a dummy area
25     $ENV{LOCALTOP}=$self->{testarea};
26     $ENV{TOOL_HOME}=$ENV{SCRAM_HOME}."/src";
27     $ENV{projconfigdir}="config";
28    
29     # some dummy source files
30     $ENV{INTsrc}="src";
31     $self->{srcarea}=$self->{testarea}."/".$ENV{INTsrc};
32     AddDir::adddir($self->{srcarea});
33     $fh=FileHandle->new();
34     $fh->open(">".$self->{srcarea}."/testfile1.cc");
35     print $fh "\n";
36     $fh->close();
37     $fh->open(">".$self->{srcarea}."/testfile2.cc");
38     print $fh "\n";
39     $fh->close();
40    
41     # $fh->open(">".$self->{testarea}."/\.SCRAM/Environment");
42     # print $fh "\n";
43     undef $fh
44    
45     }
46    
47     sub test {
48     my $self=shift;
49     $self->newtest("Initiation test");
50     $self->newobject($self);
51    
52     $self->newtest("Build Routine - failure Testing");
53     $self->{object}->{switch}=$self;
54     $self->{object}->{mapper}=$self;
55     $self->{object}->{parseerrorcalled}=0;
56     $self->{exist}=0;
57     $self->testinterface("Build_start","Build",{ "class" => "lib"});
58     if ( $self->{parseerrorcalled} != 2) {
59     $self->testfail("Parse error not called when class does not exist ".
60     "(called ".$self->{parseerrorcalled}." times)");
61     }
62    
63     $self->newtest("ParseBuildFile test");
64     $self->{parseerrorcalled}=0;
65     $self->testinterface("ParseBuildFile",$self->{testarea},
66     $self->{path},$self->{testfile});
67    
68     # -- check build structure
69     if ( $self->{parseerrorcalled} != 0) {
70     $self->testfail("Parseerror called wrongly");
71     }
72     $self->verifydir($self->{workarea});
73     $self->verifyexists($self->{workarea}."/Env_1.mk");
74     $self->verifyexists($self->{workarea}."/Env_2.mk");
75     my $makefile=$self->{workarea}."/BuildFile.mk";
76    
77     # -- integration tests ------
78     $self->newtest("Integration Tests - building libaries");
79     undef $self->{object}->{mapper}; # use the real mapper
80     $self->testinterface("ParseBuildFile",$self->{testarea},
81     $self->{path},$self->{testfile});
82     if ($self->verifyexists($makefile) ) {
83     print "> -- Trying to build lib\n";
84     my @cmds=("gmake","-f",$ENV{SCRAM_HOME}."/src/basics.mk",
85     "ClassDir=".$self->{srcarea},"LatestBuildFile=$makefile");
86     system(@cmds, "lib");
87     print "> -- Trying to build bin\n";
88     system(@cmds, "bin");
89     }
90     }
91    
92     # --- dummies
93    
94     sub checktag {
95     }
96    
97     sub parseerror {
98     my $self=shift;
99     $self->{parseerrorcalled}++;
100     }
101    
102     sub types {
103     my $self=shift;
104     my $class=shift;
105    
106     return qw(type1 type2 type3 type4);
107     }
108    
109     sub exists {
110     my $self=shift;
111     my $class=shift;
112    
113     my $rv=$self->{exist};
114     if ( $self->{exist}==0 ) { #
115     $self->{exist}=1;
116     }
117     return $rv;
118     }
119    
120     sub defaulttypes {
121     my $self=shift;
122     my $class=shift;
123    
124     return qw(type2 type3);
125     }
126    
127     sub rulesfile {
128     my $self=shift;
129     my $class=shift;
130     return "somefile";
131     }