ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/cvsroot/COMP/SCRAM/src/BuildSystem/test/test_BuildFile.pm
Revision: 1.3
Committed: Tue Nov 14 15:18:28 2000 UTC (24 years, 6 months ago) by williamc
Content type: text/plain
Branch: MAIN
CVS Tags: v102p1, V1_0_1, V1_0_0, V1_pre0, SCRAM_V1, SCRAMV1_IMPORT, V0_19_7, V0_19_6, V0_19_6p1, V0_19_5, SFATEST, V0_19_4, V0_19_4_pre3, V0_19_4_pre2, V0_19_4_pre1, V0_19_3, V0_19_2, V0_19_1, V0_19_0, V0_18_5, V0_18_4, V0_18_2, V0_18_1
Branch point for: V1_pre1, SCRAM_V1_BRANCH, V0_19_4_B
Changes since 1.2: +10 -19 lines
Log Message:
tests imported

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