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,$t1sr1,$t1sr2,$t1sr3);
          $self->_analysetwigdates($twig1,[($t1sr1,"update")],
                                         [($t1sr2,"update")], [($t1sr3,"update")]);
        }
        my $twig2=$self->{twigstore}."/firsttwigdir.twig2";
        my $t2sr1=$twigdir."/a.twig2src";
        if ( ! $self->_twigupdated($twig2) ) {
          $self->testfail("Failed to update twig2");
        }
        else {
          $self->testpass("twig was updated");
          $self->_testcontents($twig2,$t2sr1);
          $self->_analysetwigdates($twig2,[$t2sr1,"update"]);
        }

        # -- rerun - no build should take place
        $self->newtest("default build from twig - rerun");
        $report=$self->testinterface("build",$twig,"DEBUG=true");
        $self->_buildOKtest($report);
        if ( $self->_twigupdated($twig1) ) {
          $self->testfail("Failed - update to twig1 has happened");
        }
        $self->_analysetwigdates($twig1,[($t1sr1,"no update")],
                                         [($t1sr2,"no update")], [($t1sr3,"no update")]);

        # -- date change on src files
        $self->newtest("date change on src files");
        my ($atime,$mtime)=(stat($t1sr1))[8,9];
        $mtime--;
        utime($atime,$mtime, $t1sr1);

        $report=$self->testinterface("build",$twig);
        $self->_buildOKtest($report);
        if ( ! $self->_twigupdated($twig1) ) {
          $self->testfail("Failed - no update to twig1 has happened");
        }
        $self->_testcontents($twig1,$t1sr1,$t1sr2,$t1sr3);
        $self->_analysetwigdates($twig1,[($t1sr1,"update")],
                                         [($t1sr2,"no update")], [($t1sr3,"no update")]);
        
exit;

        # -- remove some source files
        $self->newtest("partial src file removal");
        $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($twigfile))[9];
          if ( defined $self->{twigs}{$name} ) {
            if ($self->{twigs}{$name} ne $twigdatestamp ) {
              print $self->{twigs}{$name}." ".$twigdatestamp."\n";
              $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");
            }
            else {
                  $self->testpass("updated version of $$file[0] as expected");
            }
            $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 ".
                                "(was ".$twig->filedate($$file[0])." now "
                                .$self->{twigfiles}{$$file[0]}.")" );
            }
            else {
                $self->testpass("Same version of $$file[0] as before as expected");
            }
          }
          $self->{twigfiles}{$$file[0]}=$twig->filedate($$file[0]);
        }
}

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

        my @expect=@_;
        use BuildSystem::test::twigmaker;
        my $twigobject=BuildSystem::test::twigmaker->new($twig);
        print "Checking contents of $twig\n";
        my @objs=$twigobject->contents();
        $self->cmparray(\@objs,@expect);
}
# === dummy routines
Revision:	1.6
Committed:	Wed Sep 20 16:54:15 2000 UTC (24 years, 7 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.5:	+2 -1 lines
Log Message:	correction to testing routines
#	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	williamc	1.4	$self->_testcontents($twig1,$t1sr1,$t1sr2,$t1sr3);
94			$self->_analysetwigdates($twig1,[($t1sr1,"update")],
95			[($t1sr2,"update")], [($t1sr3,"update")]);
96	williamc	1.2	}
97			my $twig2=$self->{twigstore}."/firsttwigdir.twig2";
98	williamc	1.4	my $t2sr1=$twigdir."/a.twig2src";
99	williamc	1.2	if ( ! $self->_twigupdated($twig2) ) {
100			$self->testfail("Failed to update twig2");
101	williamc	1.1	}
102			else {
103	williamc	1.4	$self->testpass("twig was updated");
104	williamc	1.2	$self->_testcontents($twig2,$t2sr1);
105	williamc	1.3	$self->_analysetwigdates($twig2,[$t2sr1,"update"]);
106	williamc	1.1	}
107	williamc	1.4
108			# -- rerun - no build should take place
109			$self->newtest("default build from twig - rerun");
110			$report=$self->testinterface("build",$twig,"DEBUG=true");
111			$self->_buildOKtest($report);
112			if ( $self->_twigupdated($twig1) ) {
113			$self->testfail("Failed - update to twig1 has happened");
114			}
115			$self->_analysetwigdates($twig1,[($t1sr1,"no update")],
116			[($t1sr2,"no update")], [($t1sr3,"no update")]);
117
118			# -- date change on src files
119			$self->newtest("date change on src files");
120	williamc	1.5	my ($atime,$mtime)=(stat($t1sr1))[8,9];
121			$mtime--;
122			utime($atime,$mtime, $t1sr1);
123
124	williamc	1.4	$report=$self->testinterface("build",$twig);
125			$self->_buildOKtest($report);
126			if ( ! $self->_twigupdated($twig1) ) {
127			$self->testfail("Failed - no update to twig1 has happened");
128			}
129			$self->_testcontents($twig1,$t1sr1,$t1sr2,$t1sr3);
130			$self->_analysetwigdates($twig1,[($t1sr1,"update")],
131			[($t1sr2,"no update")], [($t1sr3,"no update")]);
132
133	williamc	1.2	exit;
134	williamc	1.1
135			# -- remove some source files
136			$self->newtest("partial src file removal");
137			$self->testfail("not implemented");
138
139
140			# -- build from sub - recursive
141			$self->newtest("build from sublevel");
142			$self->testfail("not implemented");
143	williamc	1.2
144			$self->newtest("default build from unassigned class below twig");
145			$self->testfail("not implemented");
146	williamc	1.1	}
147
148			sub _buildOKtest {
149			my $self=shift;
150			my $report=shift;
151
152			my @errors=$report->error();
153	williamc	1.2	$self->testswitch($report->status(),"Build Returned OK",
154	williamc	1.1	"Build Returned Fail (@errors)");
155			}
156
157			sub _twigupdated {
158			my $self=shift;
159			my $name=shift;
160
161	williamc	1.2	my $twigfile=$name;
162	williamc	1.1	my $updated=0;
163	williamc	1.2	if ( ! -f $twigfile ) {
164	williamc	1.1	$self->testfail("$twigfile not created - test failed");
165			}
166			else {
167			# -- get twig datestamp
168	williamc	1.6	my $twigdatestamp=(stat($twigfile))[9];
169	williamc	1.1	if ( defined $self->{twigs}{$name} ) {
170			if ($self->{twigs}{$name} ne $twigdatestamp ) {
171	williamc	1.6	print $self->{twigs}{$name}." ".$twigdatestamp."\n";
172	williamc	1.1	$updated=1;
173			}
174			}
175			else {
176			# twig must be new
177			$updated=1;
178			}
179			$self->{twigs}{$name}=$twigdatestamp;
180			}
181	williamc	1.2	return $updated;
182	williamc	1.1	}
183
184			#
185			# expects an array of array pairs
186			# ((file,"update"),(file,"no-update")
187	williamc	1.2	sub _analysetwigdates {
188	williamc	1.1	my $self=shift;
189	williamc	1.4	my $twigfile=shift;
190	williamc	1.1
191			my $twig=BuildSystem::test::twigmaker->new($twigfile);
192
193			# -- check input dates
194			foreach $file ( @_ ) {
195			# -- do we want it updated
196	williamc	1.4	if ( $$file[1]=~/^update/i ) {
197			if ( ( defined $self->{twigfiles}{$$file[0]} ) &&
198			( $twig->filedate($$file[0]) eq $self->{twigfiles}{$$file[0]} )) {
199			$self->testfail($$file[0]." not updated - test failed");
200			}
201			else {
202			$self->testpass("updated version of $$file[0] as expected");
203	williamc	1.1	}
204	williamc	1.4	$self->{twigfiles}{$$file[0]}=$twig->filedate($file[0]);
205	williamc	1.1	}
206			else {
207	williamc	1.4	if ( ( ! defined $self->{twigfiles}{$$file[0]} ) \|\|
208			( $twig->filedate($$file[0]) ne $self->{twigfiles}{$$file[0]} )) {
209			$self->testfail($$file[0]." updated - test failed ".
210			"(was ".$twig->filedate($$file[0])." now "
211			.$self->{twigfiles}{$$file[0]}.")" );
212	williamc	1.1	}
213	williamc	1.4	else {
214			$self->testpass("Same version of $$file[0] as before as expected");
215			}
216	williamc	1.1	}
217	williamc	1.4	$self->{twigfiles}{$$file[0]}=$twig->filedate($$file[0]);
218	williamc	1.1	}
219			}
220
221	williamc	1.2	sub _testcontents {
222			my $self=shift;
223			my $twig=shift;
224
225	williamc	1.4	my @expect=@_;
226	williamc	1.2	use BuildSystem::test::twigmaker;
227			my $twigobject=BuildSystem::test::twigmaker->new($twig);
228			print "Checking contents of $twig\n";
229			my @objs=$twigobject->contents();
230	williamc	1.4	$self->cmparray(\@objs,@expect);
231	williamc	1.2	}
232	williamc	1.1	# === dummy routines