lxr-commits — Don't use, CVS commits

[Lxr-commits] CVS: lxr-tools/test-data/source/5.5.3 aFile.txt, NONE, 1.1

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

Update of /cvsroot/lxr/lxr-tools/test-data/source/5.5.3
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv7990/source/5.5.3

Added Files:
	aFile.txt 
Log Message:
Add test data 


--- NEW FILE: aFile.txt ---

[Lxr-commits] CVS: lxr-tools/test-data/source/5.5.4/aDir anOtherFile.txt, NONE, 1.1

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

Update of /cvsroot/lxr/lxr-tools/test-data/source/5.5.4/aDir
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv7990/source/5.5.4/aDir

Added Files:
	anOtherFile.txt 
Log Message:
Add test data 


--- NEW FILE: anOtherFile.txt ---
Prince of Morocco:
"All that glisters is not gold."

The Merchant of Venice (II, vii) 

[Lxr-commits] CVS: lxr-tools/test-data/source/5.5.4/aDir - New directory

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

Update of /cvsroot/lxr/lxr-tools/test-data/source/5.5.4/aDir
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv5282/aDir

Log Message:
Directory /cvsroot/lxr/lxr-tools/test-data/source/5.5.4/aDir added to the repository

[Lxr-commits] CVS: lxr-tools/test-data/source/5.5.4 - New directory

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

Update of /cvsroot/lxr/lxr-tools/test-data/source/5.5.4
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv5235/5.5.4

Log Message:
Directory /cvsroot/lxr/lxr-tools/test-data/source/5.5.4 added to the repository

[Lxr-commits] CVS: lxr-tools/test-data/source/5.5.3 - New directory

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

Update of /cvsroot/lxr/lxr-tools/test-data/source/5.5.3
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv5207/5.5.3

Log Message:
Directory /cvsroot/lxr/lxr-tools/test-data/source/5.5.3 added to the repository

[Lxr-commits] CVS: lxr-tools/tests AllTests.pm, NONE, 1.1 BKTest.pm, NONE, 1.1 CVSTest.pm, NONE, 1.1 ConfigTest.pm, NONE, 1.1 PlainTest.pm, NONE, 1.1 README, NONE, 1.1 SecurityTest.pm, NONE, 1.1 TestRunner.pl, NONE, 1.1 lxr.conf, NONE, 1.1 test-versions, NONE, 1.1

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

Update of /cvsroot/lxr/lxr-tools/tests
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv4979/tests

Added Files:
	AllTests.pm BKTest.pm CVSTest.pm ConfigTest.pm PlainTest.pm 
	README SecurityTest.pm TestRunner.pl lxr.conf test-versions 
Log Message:
Add tests from lxr module here


--- NEW FILE: AllTests.pm ---
package AllTests;

use ConfigTest;

use Test::Unit::TestRunner;
use Test::Unit::TestSuite;

sub new {
	my $class = shift;
	return bless {}, $class;
}

sub suite {
	my $class = shift;
	my $suite = Test::Unit::TestSuite->empty_new("LXR Tests");
	$suite->add_test(Test::Unit::TestSuite->new("ConfigTest"));
	$suite->add_test(Test::Unit::TestSuite->new("SecurityTest"));
#	$suite->add_test(Test::Unit::TestSuite->new("CVSTest"));
	$suite->add_test(Test::Unit::TestSuite->new("PlainTest"));
#	$suite->add_test(Test::Unit::TestSuite->new("BKTest"));
	return $suite;
}

1;

--- NEW FILE: BKTest.pm ---
# Test cases for the LXR::Files::BK module
# Uses the associated lxr.conf file

package BKTest;
use strict;

use Test::Unit;
use Cwd;
use Time::Local;
use lib "..";
use lib "../lib";

use LXR::Files;

use base qw(Test::Unit::TestCase);

use vars qw($bkpath $bkrefdir $bkcache	);

$bkpath   = getcwd() . "../../lxr-tools/test-data/bk-test-repository";
$bkrefdir = getcwd() . "../../lxr-tools/test-data/bk-reference-files/";
$bkcache  = getcwd() . "../../lxr-tools/test-data/bk-cache-dir";

sub new {
	my $self = shift()->SUPER::new(@_);

	#	$self->{config} = {};
	return $self;
}

# define tests

# test that a bk files object can be created
sub test_creation {
	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
sub test_root {
	my $self = shift;
	$self->assert(
		$self->{'bk'}->{rootpath} eq $self->{'config'}->{'dir'},
		"rootpath failed $self->{bk}->{rootpath} $self->{'config'}->{'dir'}"
	);
}

# Test the getdir function

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, {'cachepath' => ''});

	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.
#  Uses the BK::Test module to stub out real BK commands
#  so entire operation carried out on virtual trees

sub test_getdir_part1 {
	my $self = shift;
	my $bk   = new LXR::Files::BK::Test("/");
	$bk->set_tree("README|README|1.1", "src/file1|src/file1|1.1",
		"src/file2|src/file2|1.1",
		"src/tests/newtest/test1|src/tests/newtest/test1|1.3");

	my @files =
	  sort($bk->getdir("/", 'test1'));  # use different releases to disambiguate
	$self->assert_deep_equals(\@files, [ sort "README", "src/" ]);
	@files = sort ($bk->getdir("", 'test1'));  # Check that interprets "" as "/"
	$self->assert_deep_equals(\@files, [ sort "README", "src/" ]);
	@files = sort($bk->getdir("src/", 'test1'));
	$self->assert_deep_equals(\@files, [ sort "file1", "file2", "tests/" ]);
	@files = sort($bk->getdir("src/tests/newtest/", 'test1'));
	$self->assert_deep_equals(\@files, [ sort "test1" ]);
	@files = sort($bk->getdir("src/tests/", 'test1'));
	$self->assert_deep_equals(\@files, [ sort "newtest/" ]);
	@files = sort($bk->getdir("src/tests/newtest/", 'test1'));
	$self->assert_deep_equals(\@files, [ sort "test1" ]);

	$bk->set_tree(
		"BitKeeper/deleted/.del-README-34243232432|README|1.2",
		"src/file1|src/file1|1.2",
		"src/file2|src/file2|1.2",
		"src/tests/newtest/test1|src/tests/newtest/test1|1.2",
		"src/tests/newtest/test2|src/tests/newtest/test2|1.2",
		"Config|Config|1.2"
	);
	@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"]);

	# Now tests with invalid paths on entry
	@files = sort($bk->getdir("src/tests", 'test2'));
	$self->assert($#files == -1);
}

# 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 @versions = (1.5, 1.7, 1.6, 1.8);
	foreach (@versions) {
		my @tree = sort $bk->get_tree('@' . $_);
		open(X, "${bkrefdir}bk-file-tree-$_")
		  || die "Can't read ${bkrefdir}bk-file-tree-$_";
		my @answer = sort <X>;
		close X;
		chomp @answer;
		$self->assert_deep_equals(\@tree, \@answer, "Failed for version $_");
	}
}

# Now test the getdir function with the full tree
sub test_getdir_part2 {
	my $self = shift;
	my $bk   = $self->{'bk'};

	# A revision with no deletions
	my @entries = sort $bk->getdir('/firstdir/', '@1.3');
	$self->assert(scalar(@entries) == 2, "entries is $#entries");
	$self->assert_deep_equals(\@entries, [ sort ("file2", "file3") ]);
	@entries = sort($bk->getdir('/seconddir/', '@1.6'));
	$self->assert_deep_equals(\@entries, [ sort ("file4", "thirddir/") ]);

	# Check the full recursive tree
	@entries = sort $bk->getdir('/', '@1.11');
	$self->assert_deep_equals(\@entries, [sort ("file1", "firstdir/", "seconddir/", "sourcedir/")]);
	@entries = sort $bk->getdir('/sourcedir/', '@1.11');
	$self->assert_deep_equals(\@entries, [sort ("cobol.c", "main.c", "subdir1/")]);
	
	# Now a revision after some files have been deleted
	@entries = sort $bk->getdir('firstdir/', '@1.6');
	$self->assert(scalar(@entries) == 0);
	@entries = sort $bk->getdir('seconddir/', '@1.6');
	$self->assert_deep_equals(\@entries, [ sort ('thirddir/', 'file4') ]);
	@entries = sort $bk->getdir('seconddir/thirddir/', '@1.6');
	$self->assert_deep_equals(\@entries, [ sort ('file5') ]);

	# Now after a file in firstdir has been recreated
	@entries = sort $bk->getdir('firstdir/', '@1.8');
	$self->assert_deep_equals(\@entries, [ sort ('file2') ]);
}

# test getdir() ordering - dirs before files, all alphabetical
sub test_getdir_part3 {
	my $self = shift;
	my $bk   = $self->{'bk'};

	my @nodes = $bk->getdir('/', '@1.13');
	$self->assert($nodes[0] =~ m!/$!);
	my @expected = ('firstdir/', 'seconddir/', 'sourcedir/', 'file1');
	$self->assert_deep_equals(\@nodes, \@expected);
}

# 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;
	my $bk   = $self->{'bk'};

	# These all exist
	$self->assert($bk->file_exists('/file1',                    '@1.2'));
	$self->assert($bk->file_exists('/file1',                    '@1.6'));
	$self->assert($bk->file_exists('/file1',                    '@1.8'));
	$self->assert($bk->file_exists('/firstdir/file2',           '@1.3'));
	$self->assert($bk->file_exists('/firstdir/file3',           '@1.5'));
	$self->assert($bk->file_exists('/seconddir/thirddir/file5', '@1.6'));

	# And these don't
	$self->assert(!$bk->file_exists('/file1',                    '@1.1'));
	$self->assert(!$bk->file_exists('/file2',                    '@1.3'));
	$self->assert(!$bk->file_exists('/firstdir/',                '@1.8'));
	$self->assert(!$bk->file_exists('/firstdir/file2',           '@1.2'));
	$self->assert(!$bk->file_exists('/firstdir/file3',           '@1.6'));
	$self->assert(!$bk->file_exists('/seconddir/thirddir/file4', '@1.6'));
}

sub test_getfileinfo {
	my $self = shift;
	my $bk   = $self->{'bk'};

	# These all exist
	$self->assert(defined($bk->getfileinfo('/file1', '@1.2')));
	$self->assert($bk->getfileinfo('/file1', '@1.6')->{'revision'} == 1.1);
	$self->assert($bk->getfileinfo('/file1', '@1.8')->{'curpath'} eq 'file1');
	my $info = $bk->getfileinfo('/firstdir/file2', '@1.3');
	$self->assert($info->{'revision'} == 1.1);
	$self->assert(
		$info->{'curpath'} eq 'BitKeeper/deleted/.del-file2~7a40a14b3cb5ac42');

	# And these don't
	$self->assert(!defined($bk->getfileinfo('/file1', '@1.1')));
	$self->assert(!defined($bk->getfileinfo('/file2', '@1.3')));
}

# Some basic getfile tests
# Check for correct & incorrect pathnames and versions
sub test_getfile {
	my $self = shift;
	my $bk   = $self->{'bk'};

	my $data = $bk->getfile("/firstdir/file2", '@1.3');
	open(FILE, '<', $bkrefdir . 'firstdir^file2^@1.3')
	  || die "Can't open file to check contents firstdir^file2^\@1.3";
	local ($/) = undef;
	my $check = <FILE>;
	close FILE;
	$self->assert($check eq $data, "File read didn't match");

# Pathnames must start with a "/" for CVS/Plain but we'll accept without - for now!
	$data = $bk->getfile("firstdir/file2", '@1.3');
	$self->assert($check eq $data, "File read didn't match");
	$data = $bk->getfile("/an/impossible/path/that/doesn/t/exist", '@131');
	$self->assert(!defined($data));
	$data = '';
	$data = $bk->getfile("include/linux/jffs.h", '@1345');
	$self->assert(!defined($data));
}

# Detailed getfile tests
# Checking here that we can correctly recover:
#  - the same file at two different revisions
#  - a file that has been deleted
#  - a file that has been deleted and then reconstructed
#      (i.e. the new dir/file is different to dir/file at a previous revision
#  - a file that has been moved
sub test_getfile2 {
	my $self = shift;
	my $bk   = $self->{'bk'};

	# These are all valid versions with contents
	my @versions = (
		'/seconddir/file4',          '@1.4',     # rev 1
		'/seconddir/file4',          '@1.7',     # rev 2
		'/firstdir/file2',           '@1.4',     # before delete
		'/firstdir/file2',           '@1.8',     # after reconstruction
		'/seconddir/thirddir/file5', '@1.6',     # before move
		'/seconddir/thirddir/file6', '@1.9',     # after move
		'/seconddir/file7',          '@1.10',    # after move to new dir
	);

	while (scalar(@versions)) {
		my $file      = shift @versions;
		my $ver       = shift @versions;
		my $data      = $bk->getfile($file, $ver);
		my $checkfile = substr($file, 1);
		$checkfile =~ s{/}{^}g;
		$checkfile = $bkrefdir . $checkfile . '^' . $ver;
		open(X, '<', $checkfile) or die "Can't open file $checkfile";
		local ($/) = undef;
		my $check = <X>;
		close X;
		$self->assert_equals($data, $check, "Failed for $file, $ver");
	}
}

sub test_getfilehandle {
	my ($self) = shift;
	my $bk = $self->{'bk'};

	$self->assert(defined($bk->getfilehandle("/firstdir/file2",  '@1.3')));
	$self->assert(defined($bk->getfilehandle("/seconddir/file4", '@1.6')));
	$self->assert(defined($bk->getfilehandle('file1',            '@1.2')));
	$self->assert(
		!defined($bk->getfilehandle("/random/path/to/nowhere", '@1.1449')));
	$self->assert(!defined($bk->getfilehandle("/file1",          '1.1')));
	$self->assert(!defined($bk->getfilehandle("/firstdir/file3", '@1.8')));
	$self->assert(!defined($bk->getfilehandle("/seconddir/file7", '@1.8')));
	$self->assert(!defined($bk->getfilehandle("/seconddir/thirddir/file5", '@1.10')));
}

# Test filerev
#  Need to ensure that the filerevs are < 255 chars & sensible!
#  Oh, and they change when the file changes!
sub test_filerev {
	my ($self) = shift;
	my $bk = $self->{'bk'};
	
	# A file that has changed contents
	my $rev = $bk->filerev('/file1', '@1.3');
	$self->assert($rev);
	$self->assert_not_equals($rev, $bk->filerev('/file1', '@1.12'));
	
	# A file that hasn't changed
	$rev = $bk->filerev('/firstdir/file2', '@1.3');
	$self->assert_equals($rev, $bk->filerev('/firstdir/file2', '@1.5'));
	$self->assert(length($rev) < 255);
	
	# A file that has been deleted & recreated
	$rev = $bk->filerev('/firstdir/file2', '@1.5');
	$self->assert_not_equals($rev, $bk->filerev('/firstdir/file2', '@1.9'));
}

# Test isdir
#  Assuming that pathname will always end in / if it's a dir
#  - this may not be correct!
sub test_isdir {
	my ($self) = shift;
	my $bk = $self->{'bk'};
	
	$self->assert($bk->isdir('/firstdir/', '@1.3'));
	$self->assert($bk->isdir('/seconddir/thirddir/','@1.6'));
	$self->assert(!$bk->isdir('/not/a/dir/', '@1.3'));
	$self->assert(!$bk->isdir('/seconddir/file2/', '@1.4'));
	$self->assert(!$bk->isdir('/file1','@1.11'));
	$self->assert(!$bk->isdir('/sourcedir/main.c', '@1.12'));
	$self->assert(!$bk->isdir('/sourcedir/', '@1.10')); 
}

sub test_isfile {
	my ($self) = shift;
	my $bk = $self->{'bk'};
	
	$self->assert($bk->isfile('/file1', '@1.12'));
	$self->assert($bk->isfile('/sourcedir/main.c', '@1.12'));
	$self->assert(!$bk->isfile('/sourcedir/main.c', '@1.9'));
	$self->assert(!$bk->isfile('/seconddir/thirddir/', '@1.9'));
}

# Test the getfiletime function
#  tests are assuming that undef is OK for a directory
sub test_getfiletime {
	my ($self) = shift;
	my $bk = $self->{'bk'};
	
	$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')));
}

# Test the getfilesize
sub test_getfilesize {
	my ($self) = shift;
	my $bk = $self->{'bk'};
	
	$self->assert_equals($bk->getfilesize('/file1', '@1.3'), 60);
	$self->assert_equals($bk->getfilesize('/file1', '@1.3'), $bk->getfilesize('file1', '@1.11'));
	$self->assert(!defined($bk->getfilesize('/sourcedir/main.c', '@1.9')));
}

# Test getauthor

sub test_getauthor {
	my ($self) = shift;
	my $bk = $self->{'bk'};

	$self->assert_equals('malcolm', $bk->getauthor('/file1', '@1.3'));
	$self->assert_equals('malcolm', $bk->getauthor('/sourcedir/cobol.c', '@1.13'));
	$self->assert_null($bk->getauthor('/sourcedir/cobol.c', '@1.3'));
}

# Test getannotations
#  Only problem is that I don't have a clue what this function should return - so
#  for now we're stubbing it out a la Plain.pm

sub test_getannotations {
	my ($self) = shift;
	my $bk = $self->{'bk'};

	$self->assert_deep_equals([], [ $bk->getannotations('/file1', '@1.3') ]);
}

# Tests of helper functions in BK.pm
sub test_canonise {
	my ($self) = shift;
	my $bk = $self->{'bk'};
	$self->assert(
		LXR::Files::BK::canonise('/path/to/somewhere') eq 'path/to/somewhere');
	$self->assert(LXR::Files::BK::canonise('/') eq '');
}

# set_up and tear_down are used to
# prepare and release resources need for testing

# Prepare a config object
sub set_up {
	my $self = shift;
	$self->{'bk'} = new LXR::Files("bk:$bkpath", {'cachepath' => $bkcache});
	$self->{'config'}->{'dir'} = "$bkpath";
}

sub tear_down {
	my $self = shift;

	#	$self->{config} = undef;
}

1;

--- NEW FILE: CVSTest.pm ---
# Test cases for the LXR::Files::CVS module
# Uses the associated lxr.conf file

package CVSTest;
use strict;

use Test::Unit;
use lib "..";
use lib "../lib";

use LXR::Files;
use LXR::Config;
use LXR::Common;
use Cwd;
use File::Spec;

use base qw(Test::Unit::TestCase);

use vars qw($root);

$config = new LXR::Config("http://test/lxr", "./lxr.conf");

sub new {
	my $self = shift()->SUPER::new(@_);
#	$self->{config} = {};
	return $self;
}

# define tests

# test that a files object can be created
sub test_creation {
	my $self = shift;
	$self->assert(defined($self->{'cvs'}), "Failed to create Files::CVS");
	$self->assert($self->{'cvs'}->isa("LXR::Files::CVS"), "Not a CVS object");
}

# Access some of the values to check what is found
sub test_root {
	my $self = shift;
	$self->assert($self->{'cvs'}->{rootpath} eq $self->{'config'}->{'dir'},
		   "rootpath failed $self->{cvs}->{rootpath} $self->{'config'}->{'dir'}");
}

# Test for failure when co is not found on path
# Bug [ 1111786 ] Failure to open file not detected

sub test_no_co_bug_1111786 {
	my $self =shift;
	
	$self->{'cvs'}->{'path'} = '';
	my $t;
	my $ret = eval($t = $self->{'cvs'}->getfilehandle('INSTALL','release'));
	$self->assert(!defined($ret) or !defined($t), 'Getfilehandle should die');
	
}

# set_up and tear_down are used to
# prepare and release resources need for testing

# Prepare a CVS object
 sub set_up {
	my $self = shift;

	# This test module relies on the CVSROOT env variable pointing to a test CVS repository
	$self->assert(defined($ENV{'CVSROOT'}), 'CVSROOT must be defined');
	
	$self->{'cvs'} = new LXR::Files("cvs:$ENV{'CVSROOT'}");
 	$self->{'config'}->{'dir'} = "$ENV{'CVSROOT'}/";
 	}

 sub tear_down {
	my $self = shift;
#	$self->{config} = undef;
 }




1;

--- NEW FILE: ConfigTest.pm ---
# Test cases for the LXR::Config module
# Uses the associated lxr.conf file

package ConfigTest;
use strict;

use Test::Unit;
use lib "..";
use lib "../lib";

use LXR::Config;

use base qw(Test::Unit::TestCase);

sub new {
	my $self = shift()->SUPER::new(@_);
	$self->{config} = 0;
	return $self;
}

# define tests

# test that the config object was created successfully
sub test_creation {
	my $self = shift;
	$self->assert(defined($self->{config}), "Config init failed");
}

# Access some of the values to check what is found
sub test_access {
	my $self = shift;
	$self->assert($self->{config}->swishindex eq '/test/lxr/bin/swish-e',
		   "swishindex read failed");
	$self->assert($self->{config}->baseurl eq 'http://test/lxr/',
		   "Config accessed wrong baseurl " . $self->{config}->baseurl);
}

# test access to the variables section
sub test_variables {
	my $self = shift;
	$self->assert($self->{config}->variable('v') eq '1.0.6',
		   "Variable default not correct");
	$self->assert(($self->{config}->varrange('v'))[1] =~ /hi hippy/,
		   "Variable value missing");
}

sub test_allvariables {
	my $self = shift;
	my @vars = $self->{config}->allvariables();
    $self->assert(grep {$_ eq 'v'} @vars, "allvariables didn't return v");
	$self->assert(grep {$_ eq 'a'} @vars, "allvariables didn't return a");
	$self->assert($#vars == 1, "Too many variables returned got @vars");
}

sub test_config_error {
	my $self = shift;
	my $t;
	
	eval {new LXR::Config("/a/path", "./lxr.conf")};
	$t = $@;
	$self->assert(defined($t), "Didn't fail to find config");
	$self->assert_matches(qr/--url parameter should be a URL \(e\.g\. http:/, $t);
}

# Test access to the sourceparams section

sub test_sourceparams {
	my $self = shift;
	my $config = $self->{'config'};
	
	my $params = $config->sourceparams;
	$self->assert_equals($$params{'cachepath'}, '/a/path/to/cache');
	$self->assert_equals($$params{'param2'}, 'secondparam');
}

# Test multiple config block with common substrings work
# Bug 525825
sub test_multi_config {
	my $self = shift;
	my $test = eval {new LXR::Config("http://test/lxr-wibble", "./lxr.conf");};
	$self->assert(!defined($test), "Should not have matched");
	}

# set_up and tear_down are used to
# prepare and release resources need for testing

# Prepare a config object
 sub set_up {
	my $self = shift;
	$self->{config} = new LXR::Config("http://test/lxr", "./lxr.conf");
 	}

 sub tear_down {
	my $self = shift;
	$self->{config} = undef;
 }




1;

--- NEW FILE: PlainTest.pm ---
# Test cases for the LXR::Files::Plain module
# Uses the associated lxr.conf file

package PlainTest;
use strict;

use FindBin;

use Test::Unit;
use lib "..";
use lib "../lib";

use LXR::Files;
use LXR::Config;
use LXR::Common;

use base qw(Test::Unit::TestCase);

use vars qw($root);

$root = "$FindBin::Bin/test-src/";

$config = new LXR::Config("http://test/lxr", "./lxr.conf");

sub new {
	my $self = shift()->SUPER::new(@_);
#	$self->{config} = {};
	return $self;
}

# define tests

# test that a files object can be created
sub test_creation {
	my $self = shift;
	$self->assert(defined($self->{'plain'}), "Failed to create Files::Plain");
	$self->assert($self->{'plain'}->isa("LXR::Files::Plain"), "Not a Plain object");
}

# Access some of the values to check what is found
sub test_root {
	my $self = shift;
	$self->assert($self->{'plain'}->{rootpath} eq $self->{'config'}->{'dir'},
		   "rootpath failed $self->{plain}->{rootpath} $self->{'config'}->{'dir'}");
}

# Test the get_dir function.  Depends on the ctags 5.5.4 release being in place

sub test_getdir {
	my $self = shift;
	my $f = $self->{'plain'};
	
	my @files = sort($f->getdir("/",'5.5.4'));  # use different releases to disambiguate
	my @files2 = sort($f->getdir("", '5.5.4')); # should now produce same result
	$self->assert_deep_equals(\@files, \@files2);
	
	# Check for invalid behaviours
	@files = $f->getdir("/aFile.txt", '5.5.4');
	$self->assert($#files == -1);
	@files = $f->getdir("tests", '5.5.4');
	$self->assert($#files == -1);
	@files = $f->getdir("notthere/", '5.5.4');
	$self->assert($#files == -1);
}

# Test the get_file method.

sub test_getfile {
	my $self = shift;
	my $f = $self->{'plain'};
	
	my $file = $f->getfile("/aFile.txt", '5.5.4');
	local ($/) = undef;
	open FILE, "<". "$root/5.5.4/aFile.txt" || die "Can't open file";
	my $ref = <FILE>;
	$self->assert($file eq $ref, "Files not matching");
}

# set_up and tear_down are used to
# prepare and release resources need for testing

# Prepare a config object
 sub set_up {
	my $self = shift;
	$self->{'plain'} = new LXR::Files("$root");
 	$self->{'config'}->{'dir'} = "$root";
 	}

 sub tear_down {
	my $self = shift;
#	$self->{config} = undef;
 }




1;

--- NEW FILE: README ---
To run these tests:

- Make sure Test::Unit is installed
- Execute TestRunner.pl AllTests

Note: If you wish to run the Bitkeeper tests you will need to:
- Grab the lxr-tools module from CVS to the same top-level as the lxr tree
(so you have /mydir/lxr and /mydir/lxr-tools)
- untar the bk-test-repository.tgz file in lxr-tools/test-data
- uncomment the BKTest line in AllTests.pm



--- NEW FILE: SecurityTest.pm ---
# Test cases for the various security exploits.
# 
# Uses the associated lxr.conf file

package SecurityTest;
use strict;

use Test::Unit;
use lib "..";
use lib "../lib";

use LXR::Files;
use LXR::Config;
use LXR::Common qw(:html);
use Cwd;
use File::Spec;

use base qw(Test::Unit::TestCase);

use vars qw($root);

$config = new LXR::Config("http://test/lxr", "./lxr.conf");

sub new {
	my $self = shift()->SUPER::new(@_);
#	$self->{config} = {};
	return $self;
}

# define tests
sub test_fixpaths {
	my $self = shift;

	$ENV{'SERVER_NAME'} = 'test';
	$ENV{'SERVER_PORT'} = 80;
	$ENV{'SCRIPT_NAME'} = '/lxr/source';
	$ENV{'PATH_INFO'} = '/a/test/path';

	# Need to preserve signal handlers round call to httpinit as
	# it sets up the LXR signal handlers.
	
	my $die = $SIG{'__DIE__'};
	my $warn = $SIG{'__WARN__'};
	
	httpinit;
	my $node = "/../test/..//abit/./../././../........././";
	$node = LXR::Common::fixpaths($node);
	
	$SIG{'__DIE__'} = $die;
	$SIG{'__WARN__'} = $warn;
	
	$self->assert($node eq '/abit/./........././', "fixpaths is $node");	
}

sub test_version_path_exploit {
	# Check that the version string is properly scrubbed
	# Should only be able to set version to the values
	# defined in lxr.conf
	my $self = shift;

	$ENV{'SERVER_NAME'} = 'test';
	$ENV{'SERVER_PORT'} = 80;
	$ENV{'SCRIPT_NAME'} = '/lxr/source';
	$ENV{'PATH_INFO'} = '/a/test/path';
	$ENV{'QUERY_STRING'} = 'v=../../;virtroot=testpath;dbname=notapath';

	# Need to preserve signal handlers round call to httpinit as
	# it sets up the LXR signal handlers.
	
	my $die = $SIG{'__DIE__'};
	my $warn = $SIG{'__WARN__'};
	
	httpinit;
	
	$SIG{'__DIE__'} = $die;
	$SIG{'__WARN__'} = $warn;

	$self->assert($release eq '1.0.6', '$release not washed');
	$self->assert($config->variable('v') eq '1.0.6', '$config->variable(v) not washed');	
	
	$ENV{'QUERY_STRING'} = '?v=hi%20hippy/../..;file=/some/path;version=../..';
	$die = $SIG{'__DIE__'};
	$warn = $SIG{'__WARN__'};
	
	httpinit;
	
	$SIG{'__DIE__'} = $die;
	$SIG{'__WARN__'} = $warn;
	$self->assert($release eq '1.0.6', '$release not washed');
	$self->assert($config->variable('v') eq $release, '$release not washed');

	$ENV{'QUERY_STRING'} = '?version=hi../..';
	$die = $SIG{'__DIE__'};
	$warn = $SIG{'__WARN__'};
	
	httpinit;
	
	$SIG{'__DIE__'} = $die;
	$SIG{'__WARN__'} = $warn;
	$self->assert($release eq '1.0.6', "release not washed, was $release");
	$self->assert($config->variable('v') eq $release, "release not washed, was $release");

}

sub test_filename_wash {
	# Check that filenames are washed
	my $self = shift;

	$ENV{'SERVER_NAME'} = 'test';
	$ENV{'SERVER_PORT'} = 80;
	$ENV{'SCRIPT_NAME'} = '/lxr/source';
	$ENV{'PATH_INFO'} = '/a/test/path/../../../';
	$ENV{'QUERY_STRING'} = 'v=../../;virtroot=testpath;dbname=notapath';

	# Need to preserve signal handlers round call to httpinit as
	# it sets up the LXR signal handlers.
	
	my $die = $SIG{'__DIE__'};
	my $warn = $SIG{'__WARN__'};
	
	httpinit;
	
	$SIG{'__DIE__'} = $die;
	$SIG{'__WARN__'} = $warn;

	$self->assert($pathname eq '/a/test/path/', "pathname not washed, got $pathname");
	
	$ENV{'PATH_INFO'} = '';
	$ENV{'QUERY_STRING'} = 'file=/a/test/path++many';
	$die = $SIG{'__DIE__'};
	$warn = $SIG{'__WARN__'};
	httpinit;
	$SIG{'__DIE__'} = $die;
	$SIG{'__WARN__'} = $warn;
	$self->assert($pathname eq '/a/test/path++many', "pathname not washed, got $pathname");

	$ENV{'PATH_INFO'} = '/../.././.././a/test/path+!/some/%chars,v';
	$ENV{'QUERY_STRING'} = '';
	$die = $SIG{'__DIE__'};
	$warn = $SIG{'__WARN__'};
	httpinit;
	$SIG{'__DIE__'} = $die;
	$SIG{'__WARN__'} = $warn;
	$self->assert($pathname eq '/a/test/path+!/some/%chars,v', "pathname not washed, got $pathname");
	
	$ENV{'PATH_INFO'} = '/ab/-/path+!/some/%chars,v';
	$ENV{'QUERY_STRING'} = '';
	$die = $SIG{'__DIE__'};
	$warn = $SIG{'__WARN__'};
	httpinit;
	$SIG{'__DIE__'} = $die;
	$SIG{'__WARN__'} = $warn;
	$self->assert($pathname eq '/ab/-/path+!/some/%chars,v', "pathname not washed, got $pathname");
}

sub test_filename_compat {
	# Checking for ability to deal with ++ in the filename
	my $self = shift;

	$ENV{'SERVER_NAME'} = 'test';
	$ENV{'SERVER_PORT'} = 80;
	$ENV{'SCRIPT_NAME'} = '/lxr/source';
	$ENV{'PATH_INFO'} = '/a/test/file++name';
	$ENV{'QUERY_STRING'} = '';

	# Need to preserve signal handlers round call to httpinit as
	# it sets up the LXR signal handlers.
	
	my $die = $SIG{'__DIE__'};
	my $warn = $SIG{'__WARN__'};
	
	httpinit;
	
	$SIG{'__DIE__'} = $die;
	$SIG{'__WARN__'} = $warn;

	$self->assert($pathname eq '/a/test/file++name', "pathname corrupted, got $pathname");
}
	

sub test_config {
	# Check that parameters in URL cannot alter config variables
	
	my $self = shift;

	$ENV{'SERVER_NAME'} = 'test';
	$ENV{'SERVER_PORT'} = 80;
	$ENV{'SCRIPT_NAME'} = '/lxr/source';
	$ENV{'PATH_INFO'} = '/a/test/path';
	$ENV{'QUERY_STRING'} = 'v=../../;virtroot=testpath;dbname=notapath';

	# Need to preserve signal handlers round call to httpinit as
	# it sets up the LXR signal handlers.
	
	my $die = $SIG{'__DIE__'};
	my $warn = $SIG{'__WARN__'};
	
	httpinit;
	
	$SIG{'__DIE__'} = $die;
	$SIG{'__WARN__'} = $warn;
	$self->assert($config->{'dbname'} ne 'notapath', 'dbname messed');
	$self->assert($config->{'virtroot'} eq '/lxr', 'virtroot set');
}	
1;

--- NEW FILE: TestRunner.pl ---
#!perl -w

use strict;

use Test::Unit::Debug qw(debug_pkgs);
use Test::Unit::TestRunner;

# Uncomment and edit to debug individual packages.
#debug_pkgs(qw/Test::Unit::TestCase/);

my $testrunner = Test::Unit::TestRunner->new();
$testrunner->start(@ARGV);


--- NEW FILE: lxr.conf ---
# -*- mode: perl -*-
# Configuration file for Test suite
#
(
 {
  # Global configuration

  # Path to glimpse executable.
  # Define this OR the swish-e variables depending which search engine you want to use.
  'glimpsebin'	=> '/test/lxr/bin/glimpse',

  # Location of SWISH-E indexer binary
  'swishindex' => '/test/lxr/bin/swish-e',

  # Location of SWISH-E search binary
  'swishsearch' => '/test/lxr/bin/swish-e',

  # Path to Exuberant Ctags executable
  'ectagsbin'	=> '/test/lxr/bin/ctags',

  # Place where lxr can write temporary files
  'tmpdir'		=> '/tmp',

  # Location of the Generic.pm config file
  'genericconf' => '../lib/LXR/Lang/generic.conf',
  
  # Paths for CVS module
  'cvspath' => '/bin:/usr/local/bin:/usr/bin:/usr/sbin',

 },

 {
     # Configuration for http://192.168.1.3/lxr.
     # baseurl is used to select configuration block.

     'baseurl'		=> 'http://test/lxr',  # Put your URL here
     'virtroot'		=> '/lxr',                    # The bit after the / above
     
     'variables' => {
					 # Define typed variable "v".  This is the list of versions to index.
					 'v' => {'name'    => 'Version',
							 # This can come from a file, a function or be explicitly
							 # ennumerated.
							 # From a file:
							 'range'   => [ readfile('test-versions') ], 
							 # Explicitly:
							 # 'range' => [qw(v1 v2 v3.1 v4 experimental)],
							 # If files within a tree can have different versions,
							 # e.g in a CVS tree, 'range' can be specified as a
							 # function to call for each file:
							 #'range'   => sub { return 
							 #			($files->allreleases($LXR::Common::pathname),
							 #			 $files->allrevisions($LXR::Common::pathname))
							 #			}, # deferred function call.

							 # The default version to display
							 'default' => '1.0.6'},
	 
					 # Define typed variable "a".  First value is default.
					 'a' => {'name'    => 'Architecture',
							 'range'   => [qw(i386 alpha arm m68k mips ppc sparc sparc64)]},
					},

  # These do funky things to paths in the system - you probably don't need them.
  'maps' => {
			 '/include/asm[^\/]*/' => '/include/asm-$a/',
			 '/arch/[^\/]+/'       => '/arch/$a/',
			},
  
  
  # Templates used for headers and footers
  'htmlhead'		=> 'html-head.html',
  'htmltail'		=> 'html-tail.html',
  'htmldir'		=> 'html-dir.html',
  'htmlident'        => 'html-ident.html',
  
  'sourcehead'	=> 'html-head.html',
  'sourcedirhead'	=> 'html-head.html',
  'stylesheet'       => 'lxr.css',
  
  # sourceroot - where to get the source files from

  # For ordinary directories, this specifies a directory which has each version as a
  # subdirectory e.g.
  #  indexed-src/version1/...
  #  indexed-src/version2/...
  # The names of the version directories must match the values for the Version
  # variable above.
  'sourceroot'	=> '/home/malcolm/indexed-src',
  # Alternatively, this can specify a CVS repository by setting the value to "cvs:"
  # followed by the path to the repository.  Note this must be file accessible - remote
  # server access does NOT work.
  #     'sourceroot'	=> 'cvs:/hom/karsk/a/CVSROOT/linux',

  # The name to display for this source tree
  'sourcerootname'	=> 'Example',

  'sourceparams' => {'cachepath' => '/a/path/to/cache', 'param2' => 'secondparam'},
  # The DBI identifier for the database to use
  # For mysql, the format is dbi:mysql:dbname=<name>
  # for Postgres, it is dbi:Pg:dbname=<name>
  # for Oracle, it is dbi:Oracle:host=localhost;sid=DEVMMS;port=1521
  'dbname'		=> 'dbi:mysql:dbname=lxr',

  # If you need to specify the username or password for the database connection,
  # uncomment the following two lines
  #  'dbpass'		=> 'foo',
  #  'dbuser'		=> 'lxr',

  # For using glimpse, the directory to store the .glimpse files in is required
  'glimpsedir' => '/path/to/glimpse/databases',

  # Location of swish-e index database files if using swish-e
  'swishdir' => '/a/directory/here/',

  
  # where to look for include files inside the sourcetree.  This is used to hyperlink
  # to included files.
  'incprefix'	=> ['/include', '/include/linux'],
  
  # Which extensions to treat as images when browsing.  If a file is an image,
  # it is displayed.
  'graphicfile' => '(?i)\.(gif|jpg|jpeg|pjpg|pjpeg|xbm|png)$',  #'

  # How to map files to languages
  # Note that the string for the key and the first entry in the
  # array MUST match
  'filetype' => {
				 # Format is
				 # Language name, filepatten regexp, module to invoke,
                 # (optional )tabwidth
				 # Note that to have another language supported by Generic.pm,
				 # you must ensure that:
				 # a) exuberant ctags supports it
				 # b) generic.conf is updated to specify information about the language
				 # c) the name of the language given here matches the entry in generic.conf
				 'C' => ['C', '\.c$' #'
				  , 'LXR::Lang::Generic', '8'],
				 'C++' => ['C++', '\.C$|((?i)\.c\+\+$|\.cc$|\.cpp$|\.cxx$|\.h$|\.hh$|\.hpp$|\.hxx$|\.h\+\+$)' #'
				  , 'LXR::Lang::Generic', '8'],

# Some languages are commented out until the relevant entries in generic.conf are made
# The list here is the set supported by ctags 5.0.1
# 				 ['Beta', '(?i)\.bet$' #'
# 				  , 'LXR::Lang::Generic'],
# 				 ['Cobol', '(?i)\.cob$'  #'
# 				  , 'LXR::Lang::Generic'],
# 				 ['Eiffel', '(?i)\.e$'   #'
# 				  , 'LXR::Lang::Generic'],
# 				 ['Fortran', '(?i)\.f$|\.for$|\.ftn$|\.f77$|\.f90$|\.f95$'   #'
# 				  , 'LXR::Lang::Generic'],
				 'Java' => ['Java', '(?i)\.java$'   #'
				  , 'LXR::Lang::Java', '4'],
# 				 ['Lisp', '(?i)\.cl$|\.clisp$|\.el$|\.l$|\.lisp$|\.lsp$|\.ml$'   #'
 # 				  , 'LXR::Lang::Generic'],
                  # No tabwidth specified here as an example
 				 'Make' => ['Make', '(?i)\.mak$|makefile*' #'
							, 'LXR::Lang::Generic'],
# 				 ['Pascal', '(?i)\.p$|\.pas$'   #'
# 				  , 'LXR::Lang::Generic'],
				 'Perl' => ['Perl', '(?i)\.pl$|\.pm$|\.perl$'   #'
				  , 'LXR::Lang::Generic', '4'],
 				 'php' => ['php', '(?i)\.php$|\.php3$|\.phtml$'   #'
 				  , 'LXR::Lang::Generic', '2'],
				 'Python' => ['Python', '(?i)\.py$|\.python$'   #'
				  , 'LXR::Lang::Generic', '4'],
# 				 ['rexx', '(?i)\.cmd$|\.rexx$|\.rx$'   #'
# 				  , 'LXR::Lang::Generic'],
# 				 ['ruby', '(?i)\.rb$'   #'
# 				  , 'LXR::Lang::Generic'],
# 				 ['scheme', '(?i)\.sch$|\.scheme$|\.scm$|\.sm$'   #'
# 				  , 'LXR::Lang::Generic'],
# 				 ['shell', '(?i)\.sh$|\.bsh$|\.bash$|\.ksh$|\.zsh$'   #'
# 				  , 'LXR::Lang::Generic'],
# 				 ['s-Lang', '(?i)\.sl$'   #'
# 				  , 'LXR::Lang::Generic'],
# 				 ['tcl', '(?i)\.tcl$|\.wish$'   #'
# 				  , 'LXR::Lang::Generic'],
				},
				
	'ignoredirs' => [],
  # Maps interpreter names to languages.  The format is:
  #  regexp => langname
  #   regexp is matched against the part after #! on the first line of a file
  #   langname must match one of the keys in filetype above.
  #
  # This mapping is only used if the filename doesn't match a pattern above, so
  # a shell script called shell.c will be recognised as a C file, not a shell file.
  
  'interpreters' => {
					 'perl' => 'Perl',
#					 'bash' => 'shell',
#					 'csh' => 'shell',
					 'python' => 'Python',
					},
  

})

--- NEW FILE: test-versions ---
1.0.6
hi hippy
wibble

[Lxr-commits] CVS: lxr-tools/tests - New directory

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

Update of /cvsroot/lxr/lxr-tools/tests
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv4363/tests

Log Message:
Directory /cvsroot/lxr/lxr-tools/tests added to the repository

[Lxr-commits] CVS: lxr INSTALL,1.26,1.27 RELEASING,1.2,1.3

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

Update of /cvsroot/lxr/lxr
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv915

Modified Files:
	INSTALL RELEASING 
Log Message:
Updated instructions for Apache 1.x & 2.x
Refer to makerelease.pl script for releasing


Index: INSTALL
===================================================================
RCS file: /cvsroot/lxr/lxr/INSTALL,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- INSTALL	26 Mar 2009 17:11:57 -0000	1.26
+++ INSTALL	21 Apr 2009 14:48:58 -0000	1.27
@@ -180,8 +180,8 @@
 days. However, on future runs it will only index changed files, thus
 speeding the process.
 
-Set up webserver
-----------------
+Set up the webserver
+--------------------
 
 The web front end for LXR can run as CGI scripts or using Apache's
 mod_perl.  Since there are differences between mod_perl for Apache 1.x
@@ -266,6 +266,31 @@
 /icons/image2.gif
 /icons/generic.gif
 
+
+Site-specific customisation
+---------------------------
+
+LXR has a large amount of flexibility in behaviour, allowing control
+over many aspects of behaviour.
+
+The places to look for customisation are:
+
+- lxr.conf: controls most basic settings, including how filenames are
+  mapped to languages, tab settings etc.
+
+- templates/html*, templates/lxr.css: Templates and CSS for the HTML
+  display.  This is where you can change how the website looks,
+  e.g. by adding site logos, links, or changing colours, fonts etc.
+
+- lib/LXR/Lang/ectags.conf: Advanced configuration for ectags when
+  parsing various language files - this is one place to look if you
+  want to add support for another language.
+
+- lib/LXR/Lang/generic.conf: Configures the generic language support
+  module that handles most of the languages LXR recognises.
+  Configuration here enables support for new languages.
+
+
 Getting help if it doesn't work:
 --------------------------------
 If you can't get LXR to work then you can try asking on the mailing

Index: RELEASING
===================================================================
RCS file: /cvsroot/lxr/lxr/RELEASING,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- RELEASING	14 Apr 2007 22:33:01 -0000	1.2
+++ RELEASING	21 Apr 2009 14:48:58 -0000	1.3
@@ -1,5 +1,10 @@
 Instructions for releasing LXR
 
+The easiest way to make a release is to use the makerelease.pl script
+from the lxr-tools package.
+
+The steps are:
+
 - Run all the tests & ensure they pass
 - Tag the release in CVS with a tag of the form release-x-y-z (e.g. release-0-9-4)
 - Export the tagged files to a new directory lxr-x-y-z

[Lxr-commits] CVS: lxr/lib/LXR/Lang Generic.pm,1.22,1.23

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/lib/LXR/Lang
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv22353/lib/LXR/Lang

Modified Files:
	Generic.pm 
Log Message:
Feature 1691378 (Rearchitect the DB backends) Part II
* Standardising the LXR::Index interface

Index: Generic.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Lang/Generic.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- Generic.pm	12 Apr 2009 16:55:42 -0000	1.22
+++ Generic.pm	19 Apr 2009 16:52:40 -0000	1.23
@@ -227,7 +227,7 @@
 					$string = $_;
 
 					#		  print "considering $string\n";
-					if (!$self->isreserved($string) && $index->issymbol($string))
+					if (!$self->isreserved($string) && $index->issymbol($string, $$self{'release'}))
 					{
 
 						#			print "adding $string to references\n";

[Lxr-commits] CVS: lxr/lib/LXR/Index Mysql.pm, 1.23, 1.24 DB.pm, 1.14, 1.15 Postgres.pm, 1.23, 1.24 Oracle.pm, 1.12, 1.13 DBI.pm, 1.21, 1.22

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/lib/LXR/Index
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv22353/lib/LXR/Index

Modified Files:
	Mysql.pm DB.pm Postgres.pm Oracle.pm DBI.pm 
Log Message:
Feature 1691378 (Rearchitect the DB backends) Part II
* Standardising the LXR::Index interface

Index: Mysql.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Index/Mysql.pm,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- Mysql.pm	19 Apr 2009 09:51:18 -0000	1.23
+++ Mysql.pm	19 Apr 2009 16:52:40 -0000	1.24
@@ -251,7 +251,7 @@
 }
 
 sub issymbol {
-	my ($self, $symname) = @_;
+	my ($self, $symname, $release) = @_; # TODO make use of $release
 	my ($symid);
 
 	$symid = $symcache{$symname};

Index: DB.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Index/DB.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- DB.pm	19 Apr 2009 16:12:28 -0000	1.14
+++ DB.pm	19 Apr 2009 16:52:40 -0000	1.15
@@ -43,12 +43,12 @@
 }
 
 sub index {
-	my ($self, $symname, $fileid, $line, $type, $rel) = @_;
+	my ($self, $symname, $fileid, $line, $langid, $type, $relsym) = @_;
 	my $symid = $self->symid($symname);
 
-	$self->{'indexes'}{$symid} .= join("\t", $fileid, $line, $type, $rel) . "\0";
+	$self->{'indexes'}{$symid} .= join("\t", $fileid, $line, $type, $relsym) . "\0";
 
-	#	$$self{'index'}{$self->symid($symname, $release)} =
+	#	$$self{'index'}{$self->symid($symname)} =
 	#		join("\t", $filename, $line, $type, '');
 }
 
@@ -57,7 +57,7 @@
 	my ($self, $symname, $release) = @_;
 
 	my (@d, $f);
-	foreach $f (split(/\0/, $$self{'indexes'}{ $self->symid($symname, $release) })) {
+	foreach $f (split(/\0/, $$self{'indexes'}{ $self->symid($symname) })) {
 		my ($fi, $l, $t, $s) = split(/\t/, $f);
 
 		my %r = map { ($_ => 1) } split(/;/, $self->{'releases'}{$fi});
@@ -69,13 +69,14 @@
 }
 
 sub getreference {
+  my ($self, $symname, $release) = @_;
 	return ();
 }
 
 sub fileid {
-	my ($self, $filename, $release) = @_;
+	my ($self, $filename, $revision) = @_;
 
-	return $filename . ';' . $release;
+	return $filename . ';' . $revision;
 }
 
 # Convert from fileid to filename
@@ -105,7 +106,7 @@
 }
 
 sub symid {
-	my ($self, $symname, $release) = @_;
+	my ($self, $symname) = @_;
 	my ($symid);
 
 	return $symname;
@@ -114,7 +115,7 @@
 sub issymbol {
 	my ($self, $symname, $release) = @_;
 
-	return $$self{'indexes'}{ $self->symid($symname, $release) };
+	return $$self{'indexes'}{ $self->symid($symname) };
 }
 
 sub empty_cache {

Index: Postgres.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Index/Postgres.pm,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- Postgres.pm	19 Apr 2009 16:12:29 -0000	1.23
+++ Postgres.pm	19 Apr 2009 16:52:40 -0000	1.24
@@ -258,7 +258,7 @@
 }
 
 sub issymbol {
-	my ($self, $symname) = @_;
+	my ($self, $symname, $release) = @_; # TODO make use of $release
 
 	unless (exists($symcache{$symname})) {
 		$symbols_byname->execute($symname);

Index: Oracle.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Index/Oracle.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- Oracle.pm	19 Apr 2009 09:51:18 -0000	1.12
+++ Oracle.pm	19 Apr 2009 16:52:40 -0000	1.13
@@ -252,15 +252,15 @@
 }
 
 sub issymbol {
-	my ($self, $symname, $release, $lang) = @_;
+	my ($self, $symname, $release) = @_; # TODO make use of $release
 	my ($symid);
 
-	$symid = $symcache{$release}{$lang}{$symname};
+	$symid = $symcache{$release}{$symname};
 	unless (defined($symid)) {
 		$self->{symbols_byname}->execute($symname);
 		($symid) = $self->{symbols_byname}->fetchrow_array();
 		$self->{symbols_byname}->finish();
-		$symcache{$release}{$lang}{$symname} = $symid;
+		$symcache{$release}{$symname} = $symid;
 	}
 
 	return $symid;

Index: DBI.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Index/DBI.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- DBI.pm	21 Jul 2004 20:44:31 -0000	1.21
+++ DBI.pm	19 Apr 2009 16:52:40 -0000	1.22
@@ -39,4 +39,92 @@
 	return $index;
 }
 
+sub getindex {
+  my ($self, $symname, $release) = @_;
+  my @indexes;
+  return @indexes;
+}
+
+sub index {
+  my ($self, $symname, $fileid, $line, $langid, $type, $relsym) = @_;
+  return;
+}
+
+sub toindex {
+  my ($self, $fileid) = @_;
+  my $filefoundboolean;
+  return $filefoundboolean;
+}
+
+sub setindexed {
+  my ($self, $fileid) = @_;
+  return;
+}
+
+sub fileid {
+  my ($self, $filename, $revision) = @_;
+  my $fileid;
+  return $fileid;
+}
+
+sub getreference {
+  my ($self, $symname, $release) = @_;
+  my @references;
+  return @references;
+}
+
+sub reference {
+  my ($self, $symname, $fileid, $line) = @_;
+  return;
+}
+
+sub toreference {
+  my ($self, $fileid) = @_;
+  my $referencefoundboolean;
+  return $referencefoundboolean;
+}
+
+sub setreferenced {
+  my ($self, $fileid) = @_;
+  return;
+}
+
+sub release {
+  my ($self, $fileid, $release) = @_;
+  return;
+}
+
+sub symid {
+  my ($self, $symname) = @_;
+  my $symid;
+  return $symid;
+}
+
+sub symname {
+  my ($self, $symid) = @_;
+  my $symname;
+  return $symname;
+}
+
+sub issymbol {
+	my ($self, $symname, $release) = @_;
+  my $symbolfoundboolean;
+  return $symbolfoundboolean;
+}
+
+sub getdecid {
+  my ($self, $lang, $string) = @_;
+  my $decid;
+  return $decid;
+}
+
+sub empty_cache {
+  return;
+}
+
+sub purge {
+  my ($self, $version) = @_;
+  return;
+}
+
 1;

[Lxr-commits] CVS: lxr/lib/LXR/Index DB.pm, 1.13, 1.14 Postgres.pm, 1.22, 1.23

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/lib/LXR/Index
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv18041/lib/LXR/Index

Modified Files:
	DB.pm Postgres.pm 
Log Message:
Feature 1691378 (Rearchitect the DB backends) Part I
* Removing unused subroutines relate() and getrelations()

Index: DB.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Index/DB.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- DB.pm	21 Jul 2004 20:44:31 -0000	1.13
+++ DB.pm	19 Apr 2009 16:12:28 -0000	1.14
@@ -72,19 +72,6 @@
 	return ();
 }
 
-sub relate {
-	my ($self, $symname, $release, $rsymname, $reltype) = @_;
-	my $symid = $self->symid($symname, $release);
-
-	$$self{''}{$symid} = join("",
-		$$self{'relation'}{ $self->symid($symname, $release) },
-		join("\t", $self->symid($rsymname, $release), $reltype, ''));
-}
-
-sub getrelations {
-	my ($self, $symname, $release) = @_;
-}
-
 sub fileid {
 	my ($self, $filename, $release) = @_;
 

Index: Postgres.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Index/Postgres.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- Postgres.pm	19 Apr 2009 10:18:00 -0000	1.22
+++ Postgres.pm	19 Apr 2009 16:12:29 -0000	1.23
@@ -194,17 +194,6 @@
 	return @ret;
 }
 
-sub relate {
-	my ($self, $symname, $release, $rsymname, $reltype) = @_;
-
-	#	$relation{$self->symid($symname, $release)} .=
-	#		join("\t", $self->symid($rsymname, $release), $reltype, '');
-}
-
-sub getrelations {
-	my ($self, $symname, $release) = @_;
-}
-
 sub fileid {
 	my ($self, $filename, $revision) = @_;
 	my ($fileid);

[Lxr-commits] CVS: lxr/lib/LXR/Index Postgres.pm,1.21,1.22

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/lib/LXR/Index
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv8830/lib/LXR/Index

Modified Files:
	Postgres.pm 
Log Message:
Fix for bug 2774061 (Using PostGreSql Results in Malformed HTML in Ident Pages)
* The problem was that PostGreSql return the type with an extra space on the end (which hadn't been inserted into the db) so the LXR::Index::PostGreSql now removes trailing white space from a type when returning the index for a particular symbol

Index: Postgres.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Index/Postgres.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- Postgres.pm	19 Apr 2009 09:51:18 -0000	1.21
+++ Postgres.pm	19 Apr 2009 10:18:00 -0000	1.22
@@ -157,20 +157,26 @@
 }
 
 sub getindex {
-	my ($self, $symname, $release) = @_;
-	my ($rows, @ret);
+  my ($self, $symname, $release) = @_;
+  my ($rows, @ret);
 
-	$rows = $indexes_select->execute("$symname", "$release");
+  $rows = $indexes_select->execute("$symname", "$release");
 
-	while ($rows-- > 0) {
-		push(@ret, [ $indexes_select->fetchrow_array ]);
-	}
+  while ($rows-- > 0) {
+    my @row = $indexes_select->fetchrow_array;
 
-	$indexes_select->finish();
+    $row[3] = $self->symname($row[3]); # convert the symid
 
-	map { $$_[3] &&= $self->symname($$_[3]) } @ret;
+    # Also need to remove trailing whitespace erroneously added by the db 
+    # interface that isn't actually stored in the underlying db
+    $row[2] =~ s/^(.+?)\s+$/$1/;
 
-	return @ret;
+    push(@ret, \@row);
+  }
+
+  $indexes_select->finish();
+
+  return @ret;
 }
 
 sub getreference {

[Lxr-commits] CVS: lxr/lib/LXR/Index Mysql.pm, 1.22, 1.23 Postgres.pm, 1.20, 1.21 Oracle.pm, 1.11, 1.12

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/lib/LXR/Index
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv5309/lib/LXR/Index

Modified Files:
	Mysql.pm Postgres.pm Oracle.pm 
Log Message:
Fix for bug 2773982 (Identifer Search Results Are Not Sorted When Shown)
* MySql, Oracle and Postgres databases now sort the results in the same way. * Declarations are sorted by filename, line and then by type
* References are sorted by filename and then by line

Index: Mysql.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Index/Mysql.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- Mysql.pm	23 Mar 2009 13:29:15 -0000	1.22
+++ Mysql.pm	19 Apr 2009 09:51:18 -0000	1.23
@@ -71,7 +71,8 @@
 		  . "where s.symid = i.symid and i.fileid = f.fileid "
 		  . "and f.fileid = r.fileid "
 		  . "and i.langid = d.langid and i.type = d.declid "
-		  . "and  s.symname = ? and  r.rel = ?");
+		  . "and s.symname = ? and r.rel = ? "
+		  . "order by f.filename, i.line, d.declaration");
 	$self->{indexes_insert} =
 	  $self->{dbh}->prepare(
 		"insert into ${prefix}indexes (symid, fileid, line, langid, type, relsym) values (?, ?, ?, ?, ?, ?)"
@@ -103,7 +104,7 @@
 		  . "and f.fileid = u.fileid "
 		  . "and u.fileid = r.fileid "
 		  . "and s.symname = ? and  r.rel = ? "
-		  . "order by f.filename");
+		  . "order by f.filename, u.line");
 	$self->{decl_select} =
 	  $self->{dbh}->prepare(
 		"select declid from ${prefix}declarations where langid = ? and " . "declaration = ?");

Index: Postgres.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Index/Postgres.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- Postgres.pm	30 Apr 2005 01:35:54 -0000	1.20
+++ Postgres.pm	19 Apr 2009 09:51:18 -0000	1.21
@@ -72,7 +72,8 @@
 		  . "where s.symid = i.symid and i.fileid = f.fileid "
 		  . "and f.fileid = r.fileid "
 		  . "and i.langid = d.langid and i.type = d.declid "
-		  . "and s.symname = ? and r.release = ?");
+		  . "and s.symname = ? and r.release = ? "
+		  . "order by f.filename, i.line, d.declaration");
 	$indexes_insert =
 	  $dbh->prepare("insert into ${prefix}indexes (symid, fileid, line, langid, type, relsym) "
 		  . "values (?, ?, ?, ?, ?, ?)");
@@ -97,7 +98,8 @@
 		  . "where s.symid = u.symid "
 		  . "and f.fileid = u.fileid "
 		  . "and f.fileid = r.fileid and "
-		  . "s.symname = ? and r.release = ?");
+		  . "s.symname = ? and r.release = ? "
+		  . "order by f.filename, u.line");
 
 	$declid_nextnum = $dbh->prepare("select nextval('${prefix}declnum')");
 

Index: Oracle.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Index/Oracle.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- Oracle.pm	18 Oct 2004 22:19:29 -0000	1.11
+++ Oracle.pm	19 Apr 2009 09:51:18 -0000	1.12
@@ -68,7 +68,8 @@
 		  . "where s.symid = i.symid and i.fileid = f.fileid "
 		  . "and f.fileid = r.fileid "
 		  . "and i.langid = d.langid and i.type = d.declid "
-		  . "and  s.symname = ? and  r.release = ? ");
+		  . "and s.symname = ? and r.release = ? "
+		  . "order by f.filename, i.line, d.declaration");
 	$self->{indexes_insert} =
 	  $self->{dbh}->prepare(
 		"insert into ${prefix}indexes (symid, fileid, line, langid, type, relsym) values (?, ?, ?, ?, ?, ?)"
@@ -100,7 +101,7 @@
 		  . "and f.fileid = u.fileid "
 		  . "and u.fileid = r.fileid "
 		  . "and s.symname = ? and  r.release = ? "
-		  . "order by f.filename");
+		  . "order by f.filename, u.line");
 	$self->{decl_select} =
 	  $self->{dbh}->prepare(
 		"select declid from ${prefix}declarations where langid = ? and declaration = ?");

[Lxr-commits] CVS: lxr initdb-oracle.sql,1.4,1.5

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv2085

Modified Files:
	initdb-oracle.sql 
Log Message:
Fix for bug 2773972 (initdb-oracle.sql doesn't work with 10.2 of Oracle Express)
* Changed invalid C++ style comment to SQL comment

Also added a "quit" statement to the end of the initdb-oracle.sql script so that when it is be run from the command line it returns control to the command line rather than leaving it with sqlplus.

Index: initdb-oracle.sql
===================================================================
RCS file: /cvsroot/lxr/lxr/initdb-oracle.sql,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- initdb-oracle.sql	25 Oct 2004 20:18:50 -0000	1.4
+++ initdb-oracle.sql	19 Apr 2009 09:16:55 -0000	1.5
@@ -80,9 +80,7 @@
 	relsym		number,
 	constraint fk_lxr_indexes_symid foreign key (symid) references lxr_symbols(symid),
 	constraint fk_lxr_indexes_fileid foreign key (fileid) references lxr_files(fileid),
-	/*constraint fk_lxr_indexes_langid foreign key (langid, type) references lxr_declarations(langid, declid),
-	*/
-	
+	--constraint fk_lxr_indexes_langid foreign key (langid, type) references lxr_declarations(langid, declid),
 	constraint fk_lxr_indexes_relsym foreign key (relsym) references lxr_symbols(symid)
 );
 
@@ -121,7 +119,6 @@
 
 --grants
 
-
 grant select                         on lxr_filenum        to lxr;
 grant select                         on lxr_symnum         to lxr;
 grant select                         on lxr_declnum         to lxr;
@@ -133,4 +130,6 @@
 grant select, insert, update, delete on lxr_files          to lxr;
 grant select, insert, update, delete on lxr_declarations   to lxr;
 
-commit;
\ No newline at end of file
+commit;
+
+quit

[Lxr-commits] CVS: lxr/lib/LXR/Lang generic.conf,1.21,1.22

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/lib/LXR/Lang
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv7820/lib/LXR/Lang

Modified Files:
	generic.conf 
Log Message:
Fix for bug 2758373 (Invalid Perl Identifier References)
* Removed 'atom'    => ('\$\W?',        '') from perl lang spec as it was severly breaking the perl parsing.
* I'm not sure why it was there in the first place but having it there is definitely doing more harm than good.

Index: generic.conf
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Lang/generic.conf,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- generic.conf	12 Apr 2009 16:55:42 -0000	1.21
+++ generic.conf	13 Apr 2009 10:09:09 -0000	1.22
@@ -554,6 +554,7 @@
 			},
 			'langid' => '6',
 		},
+
 		'Perl' => {
 		    # The following have been derived from the perlfunc and perlsyn documentation
 		    # for perl v5.10.0
@@ -623,7 +624,6 @@
                            '-x',           '-X',            'y',               '-z',
 			],
 			'spec'     => [
-				'atom'    => ('\$\W?',        ''),
 				'atom'    => ('\\\\.',        ''),
 				'include' => ('\buse\s+',     ';'),
 				'include' => ('\brequire\s+', ';'),
@@ -640,6 +640,7 @@
 			'langid' => '7',
 
 		},
+
 		'Python' => {
 			'reserved' => [
 				'def',    'print',  'del',     'pass',  'break',  'continue',
@@ -663,6 +664,7 @@
 			},
 			'langid' => '8',
 		},
+
 		'php' => {
 			'reserved' => [
 				'and',             '$argv',            '$argc',            'break',
@@ -698,6 +700,7 @@
 			},
 			'langid' => '9',
 		},
+
 		'Make' => {
 			'reserved' => [],
 			'spec'     => [
@@ -709,6 +712,7 @@
 			'typemap' => { 'm' => 'macro', },
 			'langid'  => '10',
 		},
+
 		'SQL' => {
 			'reserved' => [
 
@@ -1078,6 +1082,7 @@
 			},
 			'langid' => '11',
 		},
+
 		'VB' => {
 			'reserved' => [
 				'AddHandler',  'AddressOf',      'Alias',          'And',
@@ -1133,6 +1138,7 @@
 			},
 			'langid' => '12',
 		},
+
 		'shell' => {
 			'reserved' => [
 				'for',  'do',   'done', 'case', 'esac', 'while', 'in', 'if',
@@ -1142,4 +1148,5 @@
 			'typemap' => { 'f' => 'function', },
 			'langid'  => '13',
 		},
-	  } }
+	  }
+}

[Lxr-commits] CVS: lxr/lib/LXR/Lang Generic.pm, 1.21, 1.22 generic.conf, 1.20, 1.21

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/lib/LXR/Lang
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv14601/lib/LXR/Lang

Modified Files:
	Generic.pm generic.conf 
Log Message:
Fix for bug 2755776 (Perl Reserved Words Needs Updating)
* Added reserved words derived from the perlfunc and perlsyn documentation for perl v5.10.0
* Updated the regular expression in LXR::Lang::Generic to allow reserved words / symbols to start with - and not be proceeded by $

Index: Generic.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Lang/Generic.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- Generic.pm	12 Apr 2009 16:10:36 -0000	1.21
+++ Generic.pm	12 Apr 2009 16:55:42 -0000	1.22
@@ -157,13 +157,11 @@
 	# Replace identifier by link unless it's a reserved word
 	$$code =~ 
 	  s{ 
-	     (^|[^\w\#])([\w~\#][\w]*)\b 
+	     (^|[^\$\w\#])([-\w~\#][\w]*)\b 
 	   }
 	   {
 	     $1.
-		   (
-		     $index->issymbol($2, $$self{'release'}) ? join($2, @{$$self{'itag'}}) : $2
-		   );
+		   ( $index->issymbol($2, $$self{'release'}) ? join($2, @{$$self{'itag'}}) : $2 );
   	 }gex;
 }
 
@@ -182,12 +180,11 @@
   # Replace reserved words
   $$frag =~ 
     s{
-       (^|[^\w\#])([\w~\#][\w]*)\b
+       (^|[^\$\w\#])([-\w~\#][\w]*)\b 
      }
      {
        $1.
-       ( $self->isreserved($2) ? "<span class='reserved'>$2</span>" : $2 ).
-       $3;
+       ( $self->isreserved($2) ? "<span class='reserved'>$2</span>" : $2 );
      }gex;
 }
 

Index: generic.conf
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Lang/generic.conf,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- generic.conf	11 Apr 2009 11:23:43 -0000	1.20
+++ generic.conf	12 Apr 2009 16:55:42 -0000	1.21
@@ -555,7 +555,73 @@
 			'langid' => '6',
 		},
 		'Perl' => {
-			'reserved' => [ 'sub', ],
+		    # The following have been derived from the perlfunc and perlsyn documentation
+		    # for perl v5.10.0
+			'reserved' => ['-A',           'abs',           'accept',          'alarm',
+                           'and',          'atan2',         '-b',              '-B',
+                           'bind',         'binmode',       'bless',           'break',
+                           '-c',           '-C',            'caller',          'chdir',
+                           'chmod',        'chop',          'chown',           'chr',
+                           'chroot',       'close',         'closedir',        'connect',
+                           'continue',     'cos',           'crypt',           '-d',
+                           'dbmclose',     'dbmopen',       'default',         'defined',
+                           'delete',       'die',           'do',              'dump',
+                           '-e',           'each',          'else',            'elsif',
+                           'endgrent',     'endhostent',    'endnetent',       'endprotoent',
+                           'endpwent',     'endservent',    'eof',             'eval',
+                           'exec',         'exists',        'exit',            'exp',
+                           '-f',           'fcntl',         'fileno',          'flock',
+                           'for',          'foreach',       'fork',            'format',
+                           'formline',     '-g',            'getc',            'getgrent',
+                           'getgrgid',     'getgrnam',      'gethostbyaddr',   'gethostbyname',
+                           'gethostent',   'getlogin',      'getnetbyaddr',    'getnetbyname',
+                           'getnetent',    'getpeername',   'getpgrp',         'getppid',
+                           'getpriority',  'getprotobyname','getprotobynumber','getprotoent',
+                           'getpwent',     'getpwnam',      'getpwuid',        'getservbyname',
+                           'getservbyport','getservent',    'getsockname',     'getsockopt',
+                           'given',        'glob',          'gmtime',          'goto',
+                           'grep',         'hex',           'if',              'import',
+                           'index',        'int',           'ioctl',           'join',
+                           '-k',           'keys',          'kill',            '-l',
+                           'last',         'lc',            'lcfirst',         'length',
+                           'link',         'listen',        'local',           'localtime',
+                           'lock',         'log',           'lstat',           'm',
+                           '-M',           'map',           'mkdir',           'msgctl',
+                           'msgget',       'msgrcv',        'msgsnd',          'my',
+                           'next',         'no',            '-o',              '-O',
+                           'oct',          'open',          'opendir',         'or',
+                           'ord',          'our',           '-p',              'pack',
+                           'package',      'pipe',          'pop',             'pos',
+                           'print',        'printf',        'prototype',       'push',
+                           'q',            'qq',            'qr',              'quotemeta',
+                           'qw',           'qx',            '-r',              '-R',
+                           'rand',         'read',          'readdir',         'readline',
+                           'readlink',     'readpipe',      'recv',            'redo',
+                           'ref',          'rename',        'require',         'reset',
+                           'return',       'reverse',       'rewinddir',       'rindex',
+                           'rmdir',        's',             '-s',              '-S',
+                           'say',          'scalar',        'seek',            'seekdir',
+                           'select',       'semctl',        'semget',          'semop',
+                           'send',         'setgrent',      'sethostent',      'setnetent',
+                           'setpgrp',      'setpriority',   'setprotoent',     'setpwent',
+                           'setservent',   'setsockopt',    'shift',           'shmctl',
+                           'shmget',       'shmread',       'shmwrite',        'shutdown',
+                           'sin',          'sleep',         'socket',          'socketpair',
+                           'sort',         'splice',        'split',           'sprintf',
+                           'sqrt',         'srand',         'stat',            'state',
+                           'study',        'sub',           'substr',          'symlink',
+                           'syscall',      'sysopen',       'sysread',         'sysseek',
+                           'system',       'syswrite',      '-t',              '-T',
+                           'tell',         'telldir',       'tie',             'tied',
+                           'time',         'times',         'tr',              'truncate',
+                           '-u',           'uc',            'ucfirst',         'umask',
+                           'undef',        'unless',        'unlink',          'unpack',
+                           'unshift',      'untie',         'until',           'use',
+                           'utime',        'values',        'vec',             '-w',
+                           '-W',           'wait',          'waitpid',         'wantarray',
+                           'warn',         'when',          'while',           'write',
+                           '-x',           '-X',            'y',               '-z',
+			],
 			'spec'     => [
 				'atom'    => ('\$\W?',        ''),
 				'atom'    => ('\\\\.',        ''),

[Lxr-commits] CVS: lxr/lib/LXR/Lang Generic.pm,1.20,1.21

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/lib/LXR/Lang
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv10214/lib/LXR/Lang

Modified Files:
	Generic.pm 
Log Message:
* Removed invalid dependency from LXR::Lang -> LXR::Lang::Generic introduced in fix for bug 2752690 (C / C++ pre-processor keywords aren't marked as reserved)
* Clarified LXR::Lang interface by giving a dummy implementation for all required subroutines


Index: Generic.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Lang/Generic.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- Generic.pm	11 Apr 2009 11:23:43 -0000	1.20
+++ Generic.pm	12 Apr 2009 16:10:36 -0000	1.21
@@ -134,7 +134,6 @@
 # This method returns the regexps used by SimpleParse to break the
 # code into different blocks such as code, string, include, comment etc.
 # Since this depends on the language, it's configured via generic.conf
-
 sub parsespec {
 	my ($self) = @_;
 	my @spec = $self->langinfo('spec');
@@ -153,6 +152,8 @@
 	my ($self, $code) = @_;
 	my ($start, $id);
 
+  $self->processreserved($code);
+
 	# Replace identifier by link unless it's a reserved word
 	$$code =~ 
 	  s{ 
@@ -161,12 +162,35 @@
 	   {
 	     $1.
 		   (
-		     $self->isreserved($2) ? "<span class='reserved'>$2</span>" : 
-		     ($index->issymbol($2, $$self{'release'}) ? join($2, @{$$self{'itag'}}) : $2)
+		     $index->issymbol($2, $$self{'release'}) ? join($2, @{$$self{'itag'}}) : $2
 		   );
   	 }gex;
 }
 
+sub isreserved {
+  my ($self, $frag) = @_;
+  
+  foreach my $word (@{$self->langinfo('reserved')}) {
+    return 1 if $frag eq $word;
+  }
+  return 0;
+}
+
+sub processreserved {
+	my ($self, $frag) = @_;
+
+  # Replace reserved words
+  $$frag =~ 
+    s{
+       (^|[^\w\#])([\w~\#][\w]*)\b
+     }
+     {
+       $1.
+       ( $self->isreserved($2) ? "<span class='reserved'>$2</span>" : $2 ).
+       $3;
+     }gex;
+}
+
 #
 # Find references to symbols in the file
 #
@@ -274,6 +298,11 @@
 	}
 }
 
+sub language {
+	my ($self) = @_;
+	return $self->{'language'};
+}
+
 sub langinfo {
 	my ($self, $item) = @_;
 

[Lxr-commits] CVS: lxr/lib/LXR Lang.pm,1.33,1.34

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/lib/LXR
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv10214/lib/LXR

Modified Files:
	Lang.pm 
Log Message:
* Removed invalid dependency from LXR::Lang -> LXR::Lang::Generic introduced in fix for bug 2752690 (C / C++ pre-processor keywords aren't marked as reserved)
* Clarified LXR::Lang interface by giving a dummy implementation for all required subroutines


Index: Lang.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Lang.pm,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- Lang.pm	11 Apr 2009 11:23:43 -0000	1.33
+++ Lang.pm	12 Apr 2009 16:10:37 -0000	1.34
@@ -74,16 +74,7 @@
 sub processinclude {
 	my ($self, $frag, $dir) = @_;
 
-  # Replace reserved words
-  $$frag =~ 
-    s{
-       (^|[^\w\#])([\w~\#][\w]*)\b
-     }
-     {
-       $1.
-       ( $self->isreserved($2) ? "<span class='reserved'>$2</span>" : $2 ).
-       $3;
-     }gex;
+  $self->processreserved($frag);
 
 	$$frag =~ s#(\")(.*?)(\")#$1.&LXR::Common::incref($2, "include", $2, $dir).$3 #e;
 	$$frag =~ s#(\0<)(.*?)(\0>)#$1.&LXR::Common::incref($2, "include", $2).$3 #e;
@@ -96,19 +87,24 @@
 	$$frag =~ s#\n#</span>\n<span class=\"comment\">#g;
 }
 
-sub referencefile {
+sub processcode {
+	my ($self) = @_;
+	print(STDERR ref($self), "->processcode not implemented.\n");
+}
+
+sub processreserved {
 	my ($self) = @_;
+	print(STDERR ref($self), "->processreserved not implemented.\n");
+}
 
+sub referencefile {
+	my ($self) = @_;
 	print(STDERR ref($self), "->referencefile not implemented.\n");
 }
 
-sub isreserved {
-  my ($self, $frag) = @_;
-  
-  foreach my $word (@{$self->langinfo('reserved')}) {
-    return 1 if $frag eq $word;
-  }
-  return 0;
+sub language {
+	my ($self) = @_;
+	print(STDERR ref($self), "->language not implemented.\n");
 }
 
 1;

[Lxr-commits] CVS: lxr/lib/LXR/Lang Cobol.pm, 1.1, 1.2 Generic.pm, 1.19, 1.20 generic.conf, 1.19, 1.20

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/lib/LXR/Lang
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv8880/lib/LXR/Lang

Modified Files:
	Cobol.pm Generic.pm generic.conf 
Log Message:
Fix for bug 2752690 (C / C++ pre-processor keywords aren't marked as reserved):
* Updated LXR::Lang::Generic::processcode()'s pattern to allow a # to start off a keyword
* LXR::Lang::processinclude() now checks for reserved words
* Added isreserved() subroutine to LXR::Lang and refactored derived modules to use it (e.g. LXR::Lang::Cobol)
* Added pre-processor keywords to the C and C++ lists of reserved words
* Fixed Make's reserved words to be an empty list not and empty hash

Index: Cobol.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Lang/Cobol.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Cobol.pm	10 Aug 2004 16:14:25 -0000	1.1
+++ Cobol.pm	11 Apr 2009 11:23:43 -0000	1.2
@@ -39,7 +39,7 @@
 	{
 	  $1.
 		( $2 eq "" ? $2 :
-		(grep(/^$2$/, $self->langinfo('reserved')) ? "<span class='reserved'>$2</span>" : 
+		($self->isreserved($2) ? "<span class='reserved'>$2</span>" : 
 		(
 		  $index->issymbol($2, $$self{'release'})) ?
 		 join($2, @{$$self{'itag'}}) :

Index: Generic.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Lang/Generic.pm,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- Generic.pm	4 Apr 2006 22:23:44 -0000	1.19
+++ Generic.pm	11 Apr 2009 11:23:43 -0000	1.20
@@ -152,15 +152,19 @@
 sub processcode {
 	my ($self, $code) = @_;
 	my ($start, $id);
-	$$code =~ s {(^|[^\w\#])([\w~][\w]*)\b}
+
 	# Replace identifier by link unless it's a reserved word
-	{
-	  $1.
-		(
-		  grep(/^$2$/, $self->langinfo('reserved')) ? "<span class='reserved'>$2</span>" : 
-		  ($index->issymbol($2, $$self{'release'}) ? join($2, @{$$self{'itag'}}) : $2)
-		);
-	}ge;
+	$$code =~ 
+	  s{ 
+	     (^|[^\w\#])([\w~\#][\w]*)\b 
+	   }
+	   {
+	     $1.
+		   (
+		     $self->isreserved($2) ? "<span class='reserved'>$2</span>" : 
+		     ($index->issymbol($2, $$self{'release'}) ? join($2, @{$$self{'itag'}}) : $2)
+		   );
+  	 }gex;
 }
 
 #
@@ -202,8 +206,7 @@
 					$string = $_;
 
 					#		  print "considering $string\n";
-					if (!grep(/^$string$/, $self->langinfo('reserved'))
-						&& $index->issymbol($string))
+					if (!$self->isreserved($string) && $index->issymbol($string))
 					{
 
 						#			print "adding $string to references\n";

Index: generic.conf
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Lang/generic.conf,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- generic.conf	8 Apr 2006 13:37:58 -0000	1.19
+++ generic.conf	11 Apr 2009 11:23:43 -0000	1.20
@@ -29,7 +29,9 @@
 				'float',    'for',    'goto',    'if',     'int',      'long',
 				'register', 'return', 'short',   'signed', 'sizeof',   'static',
 				'struct',   'switch', 'typedef', 'union',  'unsigned', 'void',
-				'volatile', 'while',
+                'volatile', 'while',  '#include','#define','#ifdef',   '#else',
+                '#elsif',   '#ifndef','#endif',  '#if',    '#undef',   '#error',
+                '#pragma', 'defined',               
 			],
 
 			'spec' => [
@@ -77,7 +79,10 @@
 				'typedef',     'typeid',     'typename',         'union',
 				'unsigned',    'using',      'virtual',          'void',
 				'volatile',    'wchar_t',    'while',            'xor',
-				'xor_eq'
+                'xor_eq',      '#include',   '#define',          '#ifdef',
+                '#else',       '#elsif',     '#ifndef',          '#endif',
+                '#if',         '#undef',     '#error',           '#pragma',
+                'defined',
 			],
 
 			'spec' => [
@@ -628,7 +633,7 @@
 			'langid' => '9',
 		},
 		'Make' => {
-			'reserved' => {},
+			'reserved' => [],
 			'spec'     => [
 				'comment' => ('#',            "\$"),
 				'string'  => ('"',            '"'),

[Lxr-commits] CVS: lxr/lib/LXR Lang.pm,1.32,1.33

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/lib/LXR
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv8880/lib/LXR

Modified Files:
	Lang.pm 
Log Message:
Fix for bug 2752690 (C / C++ pre-processor keywords aren't marked as reserved):
* Updated LXR::Lang::Generic::processcode()'s pattern to allow a # to start off a keyword
* LXR::Lang::processinclude() now checks for reserved words
* Added isreserved() subroutine to LXR::Lang and refactored derived modules to use it (e.g. LXR::Lang::Cobol)
* Added pre-processor keywords to the C and C++ lists of reserved words
* Fixed Make's reserved words to be an empty list not and empty hash

Index: Lang.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/lib/LXR/Lang.pm,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -d -r1.32 -r1.33
--- Lang.pm	21 Jul 2004 20:44:30 -0000	1.32
+++ Lang.pm	11 Apr 2009 11:23:43 -0000	1.33
@@ -74,10 +74,19 @@
 sub processinclude {
 	my ($self, $frag, $dir) = @_;
 
-	$$frag =~ s#(\")(.*?)(\")#	 
-	  $1.&LXR::Common::incref($2, "include", $2, $dir).$3 #e;
-	$$frag =~ s#(\0<)(.*?)(\0>)#  
-		  $1.&LXR::Common::incref($2, "include", $2).$3 #e;
+  # Replace reserved words
+  $$frag =~ 
+    s{
+       (^|[^\w\#])([\w~\#][\w]*)\b
+     }
+     {
+       $1.
+       ( $self->isreserved($2) ? "<span class='reserved'>$2</span>" : $2 ).
+       $3;
+     }gex;
+
+	$$frag =~ s#(\")(.*?)(\")#$1.&LXR::Common::incref($2, "include", $2, $dir).$3 #e;
+	$$frag =~ s#(\0<)(.*?)(\0>)#$1.&LXR::Common::incref($2, "include", $2).$3 #e;
 }
 
 sub processcomment {
@@ -93,4 +102,13 @@
 	print(STDERR ref($self), "->referencefile not implemented.\n");
 }
 
+sub isreserved {
+  my ($self, $frag) = @_;
+  
+  foreach my $word (@{$self->langinfo('reserved')}) {
+    return 1 if $frag eq $word;
+  }
+  return 0;
+}
+
 1;

[Lxr-commits] CVS: lxr/tests/test-src/5.5.4/aDir anOtherFile.txt, NONE, 1.1

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/tests/test-src/5.5.4/aDir
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv10711/tests/test-src/5.5.4/aDir

Added Files:
	anOtherFile.txt 
Log Message:
Part II of Bug 2750080 (Running the Tests Outputs Warnings) - added test src files and updated PlainTest::test_getfile() to use them so that this test now works properly

--- NEW FILE: anOtherFile.txt ---
Prince of Morocco:
"All that glisters is not gold."

The Merchant of Venice (II, vii) 

[Lxr-commits] CVS: lxr/tests/test-src - New directory

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/tests/test-src
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv10674/tests/test-src

Log Message:
Directory /cvsroot/lxr/lxr/tests/test-src added to the repository

[Lxr-commits] CVS: lxr/tests/test-src/5.5.3 - New directory

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/tests/test-src/5.5.3
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv10674/tests/test-src/5.5.3

Log Message:
Directory /cvsroot/lxr/lxr/tests/test-src/5.5.3 added to the repository

[Lxr-commits] CVS: lxr/tests PlainTest.pm,1.2,1.3

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/tests
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv10711/tests

Modified Files:
	PlainTest.pm 
Log Message:
Part II of Bug 2750080 (Running the Tests Outputs Warnings) - added test src files and updated PlainTest::test_getfile() to use them so that this test now works properly

Index: PlainTest.pm
===================================================================
RCS file: /cvsroot/lxr/lxr/tests/PlainTest.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- PlainTest.pm	2 Nov 2005 23:39:55 -0000	1.2
+++ PlainTest.pm	10 Apr 2009 20:29:59 -0000	1.3
@@ -4,6 +4,8 @@
 package PlainTest;
 use strict;
 
+use FindBin;
+
 use Test::Unit;
 use lib "..";
 use lib "../lib";
@@ -16,7 +18,7 @@
 
 use vars qw($root);
 
-$root = "/Users/malcolmbox/dev/lxr-src/";
+$root = "$FindBin::Bin/test-src/";
 
 $config = new LXR::Config("http://test/lxr", "./lxr.conf");
 
@@ -53,7 +55,7 @@
 	$self->assert_deep_equals(\@files, \@files2);
 	
 	# Check for invalid behaviours
-	@files = $f->getdir("/COPYING", '5.5.4');
+	@files = $f->getdir("/aFile.txt", '5.5.4');
 	$self->assert($#files == -1);
 	@files = $f->getdir("tests", '5.5.4');
 	$self->assert($#files == -1);
@@ -67,9 +69,9 @@
 	my $self = shift;
 	my $f = $self->{'plain'};
 	
-	my $file = $f->getfile("/COPYING", '5.5.4');
+	my $file = $f->getfile("/aFile.txt", '5.5.4');
 	local ($/) = undef;
-	open FILE, "<". "$root/5.5.4/COPYING" || die "Can't open file";
+	open FILE, "<". "$root/5.5.4/aFile.txt" || die "Can't open file";
 	my $ref = <FILE>;
 	$self->assert($file eq $ref, "Files not matching");
 }

[Lxr-commits] CVS: lxr/tests/test-src/5.5.3 aFile.txt,NONE,1.1

[AdrianIssott <adr...@us...>]

Update of /cvsroot/lxr/lxr/tests/test-src/5.5.3
In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv10711/tests/test-src/5.5.3

Added Files:
	aFile.txt 
Log Message:
Part II of Bug 2750080 (Running the Tests Outputs Warnings) - added test src files and updated PlainTest::test_getfile() to use them so that this test now works properly

--- NEW FILE: aFile.txt ---