BuildSystem/test/test_Build.pm

#
# Build.pm test suite
#

package BuildSystem::test::test_Build;
require 5.001;
use BuildSystem::Build;
use Configuration::ConfigArea;

@ISA=qw(Utilities::TestClass); #methods both from the test class

sub init {
        my $self=shift;
        $self->{testfile}=$self->datadir()."/BuildFileDoc";

        # -- make a release area
        require BuildSystem::test::TestBuildArea;
        $self->{tba}=BuildSystem::test::TestBuildArea->new($self->temparea(),
                                        $self->datadir());
        $self->{testarea}=$self->{tba}->releasearea();

        # --  make a dummy developer area
        ($self->{testdevarea}, $self->{devconfigarea})=
                        $self->{tba}->developerarea($self->temparea());


        $self->{twigstore}=$self->{testarea}->location()."/twigs";
        $self->{devtwigstore}=$self->{testdevarea}->location()."/twigs";
        print "Initialisation Complete\n";

}

sub test {
        my $self=shift;
        $self->newtest("Initiation test - Release Area");
        $self->newobject($self->{testarea});
        $self->testinterface("verbosity",1);

        # -- perform all basic build operations
        $self->_basicbuildoperations($self->{testarea}->location()); 

        # -- specific release behaviour tests

        $self->newtest("Initiation test - Development Area");
        $self->newobject($self->{testdevarea});
        $self->testinterface("verbosity",1);

        $self->_basicbuildoperations($self->{testdevarea}->location()); 

        $self->newtest("Change local configuration");
        $self->testfail("not implemented");

        $self->newtest("Add new src files");
        $self->testfail("not implemented");
}       

# -- support routines

sub _basicbuildoperations {
        my $self=shift;
        my $topdir=shift;
        my $report;

        # -- build from invalid directory
        my $twigdir=$topdir."/".$self->{tba}->twigdir();
        $self->newtest("build from invalid directory");
        $report=$self->testinterface("build",$self->{configurationareadir});
        $self->testswitch($report->status(),"Build Returned OK",
                                    "Build Returned Fail as expected");

        # -- default build from twig in src tree
        $self->newtest("echo internal variables");
        my $twig="src/sub/twig";
        $report=$self->testinterface("build",$twig,"echo_Class");
        $self->_buildOKtest($report);
        $report=$self->testinterface("build",$twig,"echo_twigname");
        $self->_buildOKtest($report);
        $report=$self->testinterface("build",$twig,"echo_twig1src");
        $self->_buildOKtest($report);

        $self->newtest("default build from twig - configuration setup");
        $report=$self->testinterface("build",$twig);
        $self->_buildOKtest($report);
        my $twig1=$self->{twigstore}."/firsttwigdir.twig1";
        my $t1sr1=$twigdir."/a.twig1src";
        my $t1sr2=$twigdir."/b.twig1src";
        my $t1sr3=$twigdir."/c.twig1src";
        if ( ! $self->_twigupdated($twig1) ) {
          $self->testfail("Failed to update twig1");
        }
        else {
          $self->testpass("twig was updated");
          $self->_testcontents($twig1,"twigdir",$t1sr1,$t1sr2,$t1sr3);
          $self->_analysetwigdates($twig1,[$t1rs1,"update"],
                                         [$t1rs2,"update"], [$t1rs3,"update"]);
        }
        my $twig2=$self->{twigstore}."/firsttwigdir.twig2";
        my $t2sr1=$self->{twigdir}."/a.twig2src";
        if ( ! $self->_twigupdated($twig2) ) {
          $self->testfail("Failed to update twig2");
        }
        else {
          $self->_testcontents($twig2,$t2sr1);
          $self->_analysetwigdates($twig2,[$t2sr1,"update"]);
        }
exit;

        # -- specific build from twig
        $self->newtest("alternative build from twig");
        $report=$self->testinterface("build",$twig,"alternative");
        $self->_buildOKtest($report);

        # -- remove some source files
        $self->newtest("partial src file removal");
        $self->testfail("not implemented");

        # -- date change on src files
        $self->newtest("date change on src files");
        $self->testfail("not implemented");

        # -- build from sub - recursive
        $self->newtest("build from sublevel");
        $self->testfail("not implemented");

        $self->newtest("default build from unassigned class below twig");
        $self->testfail("not implemented");
}

sub _buildOKtest {
        my $self=shift;
        my $report=shift;

        my @errors=$report->error();
        $self->testswitch($report->status(),"Build Returned OK",
                                    "Build Returned Fail (@errors)");
}

sub _twigupdated {
        my $self=shift;
        my $name=shift;

        my $twigfile=$name;
        my $updated=0;
        if ( ! -f $twigfile ) {
           $self->testfail("$twigfile not created - test failed");
        }
        else {
          # -- get twig datestamp
          my $twigdatestamp=(stat($file))[9];
          if ( defined $self->{twigs}{$name} ) {
            if ($self->{twigs}{$name} ne $twigdatestamp ) {
              $updated=1;
            }
          }
          else {
            # twig must be new
            $updated=1;
          }
          $self->{twigs}{$name}=$twigdatestamp;
        }
        return $updated;
}

#
# expects an array of array pairs 
# ((file,"update"),(file,"no-update") 
sub _analysetwigdates {
        my $self=shift;

        my $twigfile=shift;
        my $twig=BuildSystem::test::twigmaker->new($twigfile);
        
        # -- check input dates
        foreach $file ( @_ ) {
          # -- do we want it updated
          if ( $file[1]=~/^update/i ) {
            if ( ( defined $self->{twigfiles}{$file[0]} )  && 
              ( $twig->filedate($file[0]) eq $self->{twigfiles}{$file[0]} )) {
                  $self->testfail($file[0]." not updated - test failed");
            }
            $self->{twigfiles}{$file[0]}=$twig->filedate($file[0]);
          }
          else {
            if ( ( ! defined $self->{twigfiles}{$file[0]} ) || 
              ( $twig->filedate($file[0]) ne $self->{twigfiles}{$file[0]} )) {
                  $self->testfail($file[0]." updated - test failed");
            }
          }
          $self->{twigfiles}{$file[0]}=$twig->filedate($file[0]);
        }
}

sub _testcontents {
        my $self=shift;
        my $twig=shift;

        use BuildSystem::test::twigmaker;
        my $twigobject=BuildSystem::test::twigmaker->new($twig);
        print "Checking contents of $twig\n";
        my @objs=$twigobject->contents();
        $self->cmparray(\@objs, @_);
}
# === dummy routines
Revision:	1.3
Committed:	Fri Sep 15 14:58:20 2000 UTC (24 years, 7 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.2:	+9 -9 lines
Log Message:	ci for export
#	User	Rev	Content
1	williamc	1.1	#
2	williamc	1.2	# Build.pm test suite
3	williamc	1.1	#
4
5			package BuildSystem::test::test_Build;
6			require 5.001;
7			use BuildSystem::Build;
8			use Configuration::ConfigArea;
9
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
16			# -- make a release area
17	williamc	1.2	require BuildSystem::test::TestBuildArea;
18			$self->{tba}=BuildSystem::test::TestBuildArea->new($self->temparea(),
19			$self->datadir());
20			$self->{testarea}=$self->{tba}->releasearea();
21	williamc	1.1
22			# -- make a dummy developer area
23	williamc	1.2	($self->{testdevarea}, $self->{devconfigarea})=
24			$self->{tba}->developerarea($self->temparea());
25
26
27			$self->{twigstore}=$self->{testarea}->location()."/twigs";
28			$self->{devtwigstore}=$self->{testdevarea}->location()."/twigs";
29			print "Initialisation Complete\n";
30	williamc	1.1
31			}
32
33			sub test {
34			my $self=shift;
35			$self->newtest("Initiation test - Release Area");
36			$self->newobject($self->{testarea});
37			$self->testinterface("verbosity",1);
38
39			# -- perform all basic build operations
40	williamc	1.3	$self->_basicbuildoperations($self->{testarea}->location());
41	williamc	1.1
42			# -- specific release behaviour tests
43
44			$self->newtest("Initiation test - Development Area");
45			$self->newobject($self->{testdevarea});
46			$self->testinterface("verbosity",1);
47
48	williamc	1.3	$self->_basicbuildoperations($self->{testdevarea}->location());
49	williamc	1.1
50			$self->newtest("Change local configuration");
51			$self->testfail("not implemented");
52
53			$self->newtest("Add new src files");
54			$self->testfail("not implemented");
55			}
56
57			# -- support routines
58
59			sub _basicbuildoperations {
60			my $self=shift;
61			my $topdir=shift;
62			my $report;
63
64			# -- build from invalid directory
65	williamc	1.3	my $twigdir=$topdir."/".$self->{tba}->twigdir();
66	williamc	1.1	$self->newtest("build from invalid directory");
67			$report=$self->testinterface("build",$self->{configurationareadir});
68	williamc	1.2	$self->testswitch($report->status(),"Build Returned OK",
69	williamc	1.1	"Build Returned Fail as expected");
70
71			# -- default build from twig in src tree
72	williamc	1.2	$self->newtest("echo internal variables");
73			my $twig="src/sub/twig";
74			$report=$self->testinterface("build",$twig,"echo_Class");
75			$self->_buildOKtest($report);
76			$report=$self->testinterface("build",$twig,"echo_twigname");
77			$self->_buildOKtest($report);
78			$report=$self->testinterface("build",$twig,"echo_twig1src");
79			$self->_buildOKtest($report);
80
81	williamc	1.1	$self->newtest("default build from twig - configuration setup");
82			$report=$self->testinterface("build",$twig);
83			$self->_buildOKtest($report);
84	williamc	1.2	my $twig1=$self->{twigstore}."/firsttwigdir.twig1";
85	williamc	1.3	my $t1sr1=$twigdir."/a.twig1src";
86			my $t1sr2=$twigdir."/b.twig1src";
87			my $t1sr3=$twigdir."/c.twig1src";
88	williamc	1.2	if ( ! $self->_twigupdated($twig1) ) {
89			$self->testfail("Failed to update twig1");
90	williamc	1.1	}
91			else {
92	williamc	1.3	$self->testpass("twig was updated");
93			$self->_testcontents($twig1,"twigdir",$t1sr1,$t1sr2,$t1sr3);
94	williamc	1.2	$self->_analysetwigdates($twig1,[$t1rs1,"update"],
95			[$t1rs2,"update"], [$t1rs3,"update"]);
96			}
97			my $twig2=$self->{twigstore}."/firsttwigdir.twig2";
98			my $t2sr1=$self->{twigdir}."/a.twig2src";
99			if ( ! $self->_twigupdated($twig2) ) {
100			$self->testfail("Failed to update twig2");
101	williamc	1.1	}
102			else {
103	williamc	1.2	$self->_testcontents($twig2,$t2sr1);
104	williamc	1.3	$self->_analysetwigdates($twig2,[$t2sr1,"update"]);
105	williamc	1.1	}
106	williamc	1.2	exit;
107	williamc	1.1
108			# -- specific build from twig
109			$self->newtest("alternative build from twig");
110			$report=$self->testinterface("build",$twig,"alternative");
111			$self->_buildOKtest($report);
112
113			# -- remove some source files
114			$self->newtest("partial src file removal");
115			$self->testfail("not implemented");
116
117			# -- date change on src files
118			$self->newtest("date change on src files");
119			$self->testfail("not implemented");
120
121			# -- build from sub - recursive
122			$self->newtest("build from sublevel");
123			$self->testfail("not implemented");
124	williamc	1.2
125			$self->newtest("default build from unassigned class below twig");
126			$self->testfail("not implemented");
127	williamc	1.1	}
128
129			sub _buildOKtest {
130			my $self=shift;
131			my $report=shift;
132
133			my @errors=$report->error();
134	williamc	1.2	$self->testswitch($report->status(),"Build Returned OK",
135	williamc	1.1	"Build Returned Fail (@errors)");
136			}
137
138			sub _twigupdated {
139			my $self=shift;
140			my $name=shift;
141
142	williamc	1.2	my $twigfile=$name;
143	williamc	1.1	my $updated=0;
144	williamc	1.2	if ( ! -f $twigfile ) {
145	williamc	1.1	$self->testfail("$twigfile not created - test failed");
146			}
147			else {
148			# -- get twig datestamp
149			my $twigdatestamp=(stat($file))[9];
150			if ( defined $self->{twigs}{$name} ) {
151			if ($self->{twigs}{$name} ne $twigdatestamp ) {
152			$updated=1;
153			}
154			}
155			else {
156			# twig must be new
157			$updated=1;
158			}
159			$self->{twigs}{$name}=$twigdatestamp;
160			}
161	williamc	1.2	return $updated;
162	williamc	1.1	}
163
164			#
165			# expects an array of array pairs
166			# ((file,"update"),(file,"no-update")
167	williamc	1.2	sub _analysetwigdates {
168	williamc	1.1	my $self=shift;
169
170			my $twigfile=shift;
171			my $twig=BuildSystem::test::twigmaker->new($twigfile);
172
173			# -- check input dates
174			foreach $file ( @_ ) {
175			# -- do we want it updated
176			if ( $file[1]=~/^update/i ) {
177			if ( ( defined $self->{twigfiles}{$file[0]} ) &&
178			( $twig->filedate($file[0]) eq $self->{twigfiles}{$file[0]} )) {
179			$self->testfail($file[0]." not updated - test failed");
180			}
181			$self->{twigfiles}{$file[0]}=$twig->filedate($file[0]);
182			}
183			else {
184			if ( ( ! defined $self->{twigfiles}{$file[0]} ) \|\|
185			( $twig->filedate($file[0]) ne $self->{twigfiles}{$file[0]} )) {
186			$self->testfail($file[0]." updated - test failed");
187			}
188			}
189			$self->{twigfiles}{$file[0]}=$twig->filedate($file[0]);
190			}
191			}
192
193	williamc	1.2	sub _testcontents {
194			my $self=shift;
195			my $twig=shift;
196
197			use BuildSystem::test::twigmaker;
198			my $twigobject=BuildSystem::test::twigmaker->new($twig);
199			print "Checking contents of $twig\n";
200			my @objs=$twigobject->contents();
201			$self->cmparray(\@objs, @_);
202			}
203	williamc	1.1	# === dummy routines