[Lxr-commits] CVS: lxr/tests BKTest.pm,1.1.2.1,1.1.2.2

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

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

Modified Files:
      Tag: bk-dev-branch
	BKTest.pm 
Log Message:
BK::getdir starting to come together - code builds an in-memory hash of 
the entire source tree per version, as there appears to be no good way
to get the directory structure at a release point otherwise.

Tests for building the tree from the output of bk -r prs -r$release 
are passing - no tests yet for correctly interfacing with BK.

Index: BKTest.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/tests/Attic/BKTest.pm,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -u -d -r1.1.2.1 -r1.1.2.2
--- BKTest.pm	4 Dec 2004 23:31:15 -0000	1.1.2.1
+++ BKTest.pm	12 Dec 2004 02:41:40 -0000	1.1.2.2
@@ -12,9 +12,13 @@
 
 use base qw(Test::Unit::TestCase);
 
+use vars qw($bkpath);
+
+$bkpath = "/Users/malcolmbox/dev/bk-linux/linux-2.4";
+
 sub new {
 	my $self = shift()->SUPER::new(@_);
-	$self->{config} = 0;
+#	$self->{config} = {};
 	return $self;
 }
 
@@ -23,24 +27,93 @@
 # test that a bk files object can be created
 sub test_creation {
 	my $self = shift;
-	$self->assert(defined($self->{files}), "Failed to create Files::BK");
-	$self->assert($self->{files}->isa("LXR::Files::BK"), "Not a BK object");
+	$self->assert(defined($self->{'bk'}), "Failed to create Files::BK");
+	$self->assert($self->{'bk'}->isa("LXR::Files::BK"), "Not a BK object");
 }
 
 # Access some of the values to check what is found
 sub test_root {
 	my $self = shift;
-	$self->assert($self->{files}->{rootpath} eq '/a/path/',
-		   "rootpath failed $self->{files}->{rootpath}");
+	$self->assert($self->{'bk'}->{rootpath} eq $self->{'config'}->{'dir'},
+		   "rootpath failed $self->{bk}->{rootpath} $self->{'config'}->{'dir'}");
 }
 
-# Test the allreleases function
+# Test the getdir function
 
-sub test_allreleases {
+package LXR::Files::BK::Test;
+use LXR::Files::BK;
+
+use vars qw(@ISA);
+
+@ISA = ("LXR::Files::BK");
+
+sub new {
+	my ($proto, $rootpath) = @_;
+	my $class = ref($proto) || $proto;
+	my $self = $class->SUPER::new($rootpath);
+	
+	bless($self, $class);
+	return $self;
+}
+
+sub set_tree() {
+	my ($self) = shift;
+	$self->{tree} = \@_;
+}
+
+sub get_tree() {
+	my($self) = shift;
+	return @{$self->{'tree'}};
+}
+
+1;
+
+package BKTest;
+
+# Test the tree building & caching for the getdir function.  Doesn't go near real BK commands
+
+sub test_getdir_part1 {
 	my $self = shift;
-	$self->assert($self->allreleases("testfile") eq 1);
+	my $bk = new LXR::Files::BK::Test("/");
+	$bk->set_tree("README", "src/file1", "src/file2", "src/tests/newtest/test1");
+	
+	my @files = sort($bk->getdir("/",'test1'));  # use different releases to disambiguate
+	$self->assert_deep_equals(\@files, ["README", "src"]);
+	@files = sort($bk->getdir("/src/", 'test1'));
+	$self->assert_deep_equals(\@files, ["file1", "file2", "tests"]);
+	@files = sort($bk->getdir("/src/tests/newtest/", 'test1'));
+	$self->assert_deep_equals(\@files, ["test1"]);
+	@files = sort($bk->getdir("/src/tests/", 'test1'));
+	$self->assert_deep_equals(\@files, ["newtest"]);
+	@files = sort($bk->getdir("/src/tests/newtest/", 'test1'));
+	$self->assert_deep_equals(\@files, ["test1"]);
+	
+	$bk->set_tree("README", "src/file1", "src/file2", "src/tests/newtest/test1", "src/tests/newtest/test2",
+				 "Config");
+	@files = sort($bk->getdir("/src/tests/newtest/", 'test1'));  # Check cache is working
+	$self->assert_deep_equals(\@files, ["test1"]);
+	@files = sort($bk->getdir("/src/tests/newtest/", 'test2'));	  # Should pick up new entry
+	$self->assert_deep_equals(\@files, ["test1", "test2"]);
+	@files = sort($bk->getdir("/src/tests/", 'test2'));   # Should still only see one copy of dir
+	$self->assert_deep_equals(\@files, ["newtest"]);
+	@files = sort($bk->getdir("/src/tests/newtest/", 'test1'));  # Check cache is still ok
+	$self->assert_deep_equals(\@files, ["test1"]);
+
 }
 
+# Test the get_tree function and ensure it is giving the right answers
+
+sub test_get_tree {
+	my $self = shift;
+	my $bk = $self->{'bk'};
+	
+	my @tree = sort $bk->get_tree('@1.15');
+	open (X, "test_get_tree_filelist") || die "Can't read test_get_tree_filelist";
+	my @answer = sort <X>;
+	chomp @answer;
+	
+	$self->assert_deep_equals(\@tree, \@answer); 
+}	
 
 # set_up and tear_down are used to
 # prepare and release resources need for testing
@@ -48,7 +121,8 @@
 # Prepare a config object
  sub set_up {
 	my $self = shift;
-	$self->{files} = new LXR::Files("bk:/a/path");
+	$self->{'bk'} = new LXR::Files("bk:$bkpath");
+ 	$self->{'config'}->{'dir'} = "$bkpath/";
  	}
 
  sub tear_down {