[Lxr-commits] CVS: lxr/tests BKTest.pm,1.1.2.9,1.1.2.10

[Malcolm B. <mb...@us...>]

Update of /cvsroot/lxr/lxr/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11983/tests

Modified Files:
      Tag: bk-dev-branch
	BKTest.pm 
Log Message:
Add a disk-based cache for the results of the 'bk rset' command.
This prevents this from taking too long on subsequent invocations - 
bk rset being a slow operation.

As a disk-based cache this can get out of sync with the repository, 
there is currently no code to detect this.  The idea is that this would be
manually deleted before running genxref, which would have the side
effect of creating an up-to-date cache.

Index: BKTest.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/tests/Attic/BKTest.pm,v
retrieving revision 1.1.2.9
retrieving revision 1.1.2.10
diff -u -d -r1.1.2.9 -r1.1.2.10
--- BKTest.pm	19 Feb 2005 22:22:44 -0000	1.1.2.9
+++ BKTest.pm	20 Feb 2005 23:44:55 -0000	1.1.2.10
@@ -14,10 +14,11 @@
 
 use base qw(Test::Unit::TestCase);
 
-use vars qw($bkpath $bkrefdir);
+use vars qw($bkpath $bkrefdir $bkcache	);
 
 $bkpath   = getcwd() . "/bk-test-repository";
 $bkrefdir = getcwd() . "/bk-reference-files/";
+$bkcache  = getcwd() . "/bk-cache-dir";
 
 sub new {
 	my $self = shift()->SUPER::new(@_);
@@ -33,6 +34,7 @@
 	my $self = shift;
 	$self->assert(defined($self->{'bk'}), "Failed to create Files::BK");
 	$self->assert($self->{'bk'}->isa("LXR::Files::BK"), "Not a BK object");
+	$self->assert($self->{'bk'}->{'cache'} eq $bkcache);
 }
 
 # Access some of the values to check what is found
@@ -56,7 +58,7 @@
 sub new {
 	my ($proto, $rootpath) = @_;
 	my $class = ref($proto) || $proto;
-	my $self  = $class->SUPER::new($rootpath);
+	my $self  = $class->SUPER::new($rootpath, {'cachepath' => ''});
 
 	bless($self, $class);
 	return $self;
@@ -178,6 +180,59 @@
 	$self->assert_deep_equals(\@entries, [ sort ('file2') ]);
 }
 
+# Test the cache of bitkeeper trees
+
+sub test_cache_creation {
+	my $self = shift;
+	my $bk   = $self->{'bk'};
+
+	# First nuke the cache directory & the memory cache
+	$self->clear_disk_cache();
+	
+	# Now ask for a specific tree
+	$bk->getdir('/', '@1.10');
+	$self->assert(-r $bk->cachename('@1.10'));
+	$bk->getdir('/sourcedir', '@1.3');
+	$self->assert(-r $bk->cachename('@1.3'));
+	
+	$self->clear_disk_cache();
+}	
+
+# Test the disk cache usage
+
+sub test_cache_usage {
+	my $self = shift;
+	my $bk = $self->{'bk'};
+	
+	# Test strategy is to clear the cache, create a cache file for a version
+	# that is known not to exist, then check that the info from that cached
+	# version is returned.
+	# First nuke the cache directory & the memory cache
+	$self->clear_disk_cache();
+
+	# Create the new information
+	open(X, ">", $bk->cachename('testversion')) or die "Can't create test cache entry";
+	print X "foobar|foobar|1.1\n";
+	print X "another|another|1.2\n";
+	print X "somewhere/other|somewhere/new|1.3\n";
+	close X;
+	
+	my @entries = sort $bk->getdir('/', 'testversion');
+	$self->assert_deep_equals(\@entries, [sort ("foobar", "another", "somewhere/")]);
+	
+	$self->clear_disk_cache();
+}
+
+sub clear_disk_cache {
+	my $self = shift;
+	
+	system('rm -rf '.$bkcache);
+	$self->assert(!-d $bkcache);	
+	system('mkdir '.$bkcache);
+	$self->assert(-d $bkcache);
+	%LXR::Files::BK::tree_cache = ('' => '');
+}
+
 # Tests for the cache manipulation commands
 sub test_fileexists {
 	my $self = shift;
@@ -348,7 +403,7 @@
 	my ($self) = shift;
 	my $bk = $self->{'bk'};
 	
-	$self->assert_equals($bk->getfiletime('/file1', '@1.3'), timegm(30,20,14,13,02,2005));
+	$self->assert_equals($bk->getfiletime('/file1', '@1.3'), timegm(30,20,14,13,01,2005)); # Note months is 0..11
 	$self->assert_equals($bk->getfiletime('/file1', '@1.3'), $bk->getfiletime('file1', '@1.11'));
 	$self->assert(!defined($bk->getfiletime('/sourcedir/', '@1.12')));
 }
@@ -400,7 +455,7 @@
 # Prepare a config object
 sub set_up {
 	my $self = shift;
-	$self->{'bk'} = new LXR::Files("bk:$bkpath");
+	$self->{'bk'} = new LXR::Files("bk:$bkpath", {'cachepath' => $bkcache});
 	$self->{'config'}->{'dir'} = "$bkpath";
 }