[PATCH v8] gitweb: add test suite with Test::WWW::Mechanize::CGI

[Lea Wiemann <lewiemann@gmail.com>]

This test uses Test::WWW::Mechanize::CGI to check gitweb's output.  It
also uses HTML::Lint, XML::Parser, and Archive::Tar (if present, each)
to validate the HTML/XML/tgz output, and checks all links on the
tested pages if --long-tests is given.

Signed-off-by: Jakub Narebski <jnareb@gmail.com>
Signed-off-by: Lea Wiemann <LeWiemann@gmail.com>
---
[Resent with correct subject.]

This patch applies on next.

Changes since v7:

- In Makefile, dump $PERL_PATH to GIT-BUILD-OPTIONS (which gets
  source'd by test-lib.sh), and use it in t9710-perl-git-repo.sh.

- .git/description in the test repository no longer depends on $0
  (this would e.g. cause 'cd t; make' to fail).

- Add test_link subroutine and use it everywhere in place of
  ok(find_link...) so that links whose presence get tested get checked
  and spidered in --long-tests mode.

- Add simple page caching (reduces execution time without --long-tests
  by 25%).  That's *really* helpful when you have to run those tests
  on a regular basis. ;)  (WWW::Mechanize::Cached won't work with
  TWM::CGI, so we have to implement it ourselves; but it's easier
  anyway.)

- Follow redirects rather than failing.

- Test subdirectories in tree view.

- Test error handling for non-existent hashes or hashes of wrong type.

- Test commitdiff_plain view.

- Expand test for history view.

- Test tag objects (not just symbolic tags) in tag list.

- Test a specific bug (under "diff formatting", marked TODO).

- Do not test correctness of line number fragments (#l[0-9]+); they're
  broken too often right now.

- Probably some more minor improvements I've forgotten about. :)

 Makefile                    |    1 +
 t/t9503-gitweb-Mechanize.sh |  138 +++++++++++
 t/t9503/test.pl             |  553 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 692 insertions(+), 0 deletions(-)
 create mode 100755 t/t9503-gitweb-Mechanize.sh
 create mode 100755 t/t9503/test.pl

diff --git a/Makefile b/Makefile
index a129491..3bf4f14 100644
--- a/Makefile
+++ b/Makefile
@@ -1251,6 +1251,7 @@ GIT-CFLAGS: .FORCE-GIT-CFLAGS
 
 GIT-BUILD-OPTIONS: .FORCE-GIT-BUILD-OPTIONS
 	@echo SHELL_PATH=\''$(SHELL_PATH_SQ)'\' >$@
+	@echo PERL_PATH=\''$(PERL_PATH_SQ)'\' >>$@
 
 ### Detect Tck/Tk interpreter path changes
 ifndef NO_TCLTK
diff --git a/t/t9503-gitweb-Mechanize.sh b/t/t9503-gitweb-Mechanize.sh
new file mode 100755
index 0000000..4585cea
--- /dev/null
+++ b/t/t9503-gitweb-Mechanize.sh
@@ -0,0 +1,138 @@
+#!/bin/sh
+#
+# Copyright (c) 2008 Jakub Narebski
+# Copyright (c) 2008 Lea Wiemann
+#
+
+# This test supports the --long-tests option.
+
+# This test only runs on Perl 5.8 and later versions, since
+# Test::WWW::Mechanize::CGI requires Perl 5.8.
+
+test_description='gitweb tests (using WWW::Mechanize)
+
+This test uses Test::WWW::Mechanize::CGI to test gitweb.'
+
+# helper functions
+
+safe_chmod () {
+	chmod "$1" "$2" &&
+	if [ "$(git config --get core.filemode)" = false ]
+	then
+		git update-index --chmod="$1" "$2"
+	fi
+}
+
+. ./test-lib.sh
+
+# check if test can be run
+"$PERL_PATH" -MEncode -e 'decode_utf8("", Encode::FB_CROAK)' >/dev/null 2>&1 || {
+	test_expect_success \
+		'skipping gitweb tests, perl version is too old' :
+	test_done
+	exit
+}
+
+"$PERL_PATH" -MTest::WWW::Mechanize::CGI -e '' >/dev/null 2>&1 || {
+	test_expect_success \
+		'skipping gitweb tests, Test::WWW::Mechanize::CGI not found' :
+	test_done
+	exit
+}
+
+# set up test repository
+test_expect_success 'set up test repository' '
+
+	echo "Not an empty file." > file &&
+	git add file &&
+	test_tick && git commit -a -m "Initial commit." &&
+	git branch b &&
+
+	echo "New file" > new_file &&
+	git add new_file &&
+	test_tick && git commit -a -m "File added." &&
+
+	safe_chmod +x new_file &&
+	test_tick && git commit -a -m "Mode changed." &&
+
+	git mv new_file renamed_file &&
+	test_tick && git commit -a -m "File renamed." &&
+
+	rm renamed_file &&
+	ln -s file renamed_file &&
+	test_tick && git commit -a -m "File to symlink." &&
+	git tag with-symlink &&
+
+	git rm renamed_file &&
+	rm -f renamed_file &&
+	test_tick && git commit -a -m "File removed." &&
+
+	cp file file2 &&
+	git add file2 &&
+	test_tick && git commit -a -m "File copied." &&
+
+	echo "New line" >> file2 &&
+	safe_chmod +x file2 &&
+	test_tick && git commit -a -m "Mode change and modification." &&
+
+	mkdir dir1 &&
+	echo "New file" >> dir1/file1 &&
+	git add dir1/file1 &&
+	test_tick && git commit -a -m "File added in subdirectory." &&
+	git tag -m "creating a tag object" tag-object
+
+	git checkout b &&
+	echo "Branch" >> b &&
+	git add b &&
+	test_tick && git commit -a -m "On branch" &&
+	git checkout master &&
+	test_tick && git pull . b
+'
+
+# set up empty repository
+# TODO!
+
+# set up repositories for gitweb
+# TODO!
+
+# set up gitweb configuration
+safe_pwd="$("$PERL_PATH" -MPOSIX=getcwd -e 'print quotemeta(getcwd)')"
+cat >gitweb_config.perl <<EOF
+# gitweb configuration for tests
+
+our \$version = "current";
+our \$GIT = "$GIT_EXEC_PATH/git";
+our \$projectroot = "$safe_pwd";
+our \$project_maxdepth = 8;
+our \$home_link_str = "projects";
+our \$site_name = "[localhost]";
+our \$site_header = "";
+our \$site_footer = "";
+our \$home_text = "indextext.html";
+our @stylesheets = ("file:///$safe_pwd/../../gitweb/gitweb.css");
+our \$logo = "file:///$safe_pwd/../../gitweb/git-logo.png";
+our \$favicon = "file:///$safe_pwd/../../gitweb/git-favicon.png";
+our \$projects_list = "";
+our \$export_ok = "";
+our \$strict_export = "";
+our %feature;
+\$feature{'blame'}{'default'} = [1];
+
+1;
+__END__
+EOF
+
+cat >.git/description <<EOF
+gitweb test repository
+EOF
+
+GITWEB_CONFIG="$(pwd)/gitweb_config.perl"
+export GITWEB_CONFIG
+
+# run tests
+
+test_external \
+	'test gitweb output' \
+	"$PERL_PATH" ../t9503/test.pl
+
+test_done
diff --git a/t/t9503/test.pl b/t/t9503/test.pl
new file mode 100755
index 0000000..43ad062
--- /dev/null
+++ b/t/t9503/test.pl
@@ -0,0 +1,553 @@
+#!/usr/bin/perl
+use lib (split(/:/, $ENV{GITPERLLIB}));
+
+# This test supports the --long-tests option.
+
+use warnings;
+use strict;
+
+use Cwd qw( abs_path );
+use File::Spec;
+use File::Temp;
+use Storable;
+
+use Test::More qw(no_plan);
+
+die "this must be run by calling the t/t*.sh shell script(s)\n"
+    if Cwd->cwd !~ /trash directory$/;
+
+our $long_tests = $ENV{GIT_TEST_LONG}; # "our" so we can use "local $long_tests"
+
+eval { require Archive::Tar; };
+my $archive_tar_installed = !$@
+    or diag('Archive::Tar is not installed; no tests for valid snapshots');
+
+eval { require HTML::Lint; };
+my $html_lint_installed = !$@
+    or diag('HTML::Lint is not installed; no HTML validation tests');
+
+eval { require XML::Parser; };
+my $xml_parser_installed = !$@
+    or diag('XML::Parser is not installed; no tests for well-formed XML');
+
+sub rev_parse {
+	my $name = shift;
+	chomp(my $hash = `git rev-parse $name 2> /dev/null`);
+	$hash or undef;
+}
+
+sub get_type {
+	my $name = shift;
+	chomp(my $type = `git cat-file -t $name 2> /dev/null`);
+	$type or undef;
+}
+
+
+package OurMechanize;
+
+use base qw( Test::WWW::Mechanize::CGI );
+
+my %page_cache;
+# Cache requests.
+sub _make_request {
+	my ($self, $request) = (shift, shift);
+
+	my $response;
+	unless ($response = Storable::thaw($page_cache{$request->uri})) {
+		$response = $self->SUPER::_make_request($request, @_);
+		$page_cache{$request->uri} = Storable::freeze($response);
+	}
+	return $response;
+}
+
+# Fix whitespace problem.
+sub cgi_application {
+	my ($self, $application) = @_;
+
+	# This subroutine was copied (and modified) from
+	# WWW::Mechanize::CGI 0.3, which is licensed 'under the same
+	# terms as perl itself' and thus GPL compatible.
+	my $cgi = sub {
+		# Use exec, not the shell, to support embedded
+		# whitespace in the path to $application.
+		# http://rt.cpan.org/Ticket/Display.html?id=36654
+		my $status = system $application $application;
+		my $value  = $status >> 8;
+
+		croak( qq/Failed to execute application '$application'. Reason: '$!'/ )
+		    if ( $status == -1 );
+		croak( qq/Application '$application' exited with value: $value/ )
+		    if ( $value > 0 );
+	};
+
+	$self->cgi($cgi);
+}
+
+package main;
+
+
+my @revisions = split /\s/, `git-rev-list --first-parent HEAD`;
+chomp(my @heads = map { (split('/', $_))[2] } `git-for-each-ref --sort=-committerdate refs/heads`);
+chomp(my @tags = map { (split('/', $_))[2] } `git-for-each-ref --sort=-committerdate refs/tags`);
+my @tag_objects = grep { get_type($_) eq 'tag' } @tags;
+chomp(my @root_entries = `git-ls-tree --name-only HEAD`);
+my @files = grep { get_type("HEAD:$_") eq 'blob' } @root_entries or die;
+my @directories = grep { get_type("HEAD:$_") eq 'tree' } @root_entries or die;
+# Only test one file and directory each.
+@files = $files[0] unless $long_tests;
+@directories = $directories[0] unless $long_tests;
+
+my $gitweb = abs_path(File::Spec->catfile('..', '..', 'gitweb', 'gitweb.cgi'));
+
+my $mech = OurMechanize->new;
+$mech->cgi_application($gitweb);
+# On some systems(?) it's necessary to have %ENV here, otherwise the
+# CGI process won't get *any* of the current environment variables
+# (not even PATH, etc.)
+$mech->env(%ENV,
+	   GITWEB_CONFIG => $ENV{'GITWEB_CONFIG'},
+	   SCRIPT_FILENAME => $gitweb,
+	   $mech->env);
+
+# import config, predeclaring config variables
+our $site_name;
+require_ok($ENV{'GITWEB_CONFIG'})
+	or diag('Could not load gitweb config; some tests would fail');
+
+# Perform non-recursive checks on the current page, but do not check
+# the status code.
+my %verified_uris;
+sub _verify_page {
+	my ($uri, $fragment) = split '#', $mech->uri;
+	TODO: {
+		local $TODO = 'line number fragments can be broken for diffs and blames'
+		    if $fragment && $fragment =~ /^l[0-9]+$/;
+		$mech->content_like(qr/(name|id)="$fragment"/,
+				    "[auto] fragment #$fragment exists ($uri)")
+		    if $fragment;
+	}
+
+	return 1 if $verified_uris{$uri};
+	$verified_uris{$uri} = 1;
+
+	# Internal errors yield 200 but cause gitweb.cgi to exit with
+	# non-zero exit code, which Mechanize::CGI translates to 500,
+	# so we don't really need to check for "Software error" here,
+	# provided that the test cases always check the status code.
+	#$mech->content_lacks('<h1>Software error:</h1>') or return 0;
+
+	# Validate.  This is fast, so we can do it even without
+	# $long_tests.
+	$mech->html_lint_ok('[auto] validate HTML') or return 0
+	    if $html_lint_installed && $mech->is_html;
+	my $content_type = $mech->response->header('Content-Type')
+	    or die "$uri does not have a Content-Type header";
+	if ($xml_parser_installed && $content_type =~ /xml/) {
+		eval { XML::Parser->new->parse($mech->content); };
+		ok(!$@, "[auto] check for XML well-formedness ($uri)") or diag($@);
+	}
+	if ($archive_tar_installed && $uri =~ /sf=tgz/) {
+		my $snapshot_file = File::Temp->new;
+		print $snapshot_file $mech->content;
+		close $snapshot_file;
+		my $t = Archive::Tar->new;
+		$t->read($snapshot_file->filename, 1);
+		ok($t->get_files, "[auto] valid tgz snapshot ($uri)");
+	}
+	# WebService::Validator::Feed::W3C would be nice to
+	# use, but it doesn't support direct input (as opposed
+	# to URIs) long enough for our feeds.
+
+	return 1;
+}
+
+# Verify and spider the current page, the latter only if --long-tests
+# (-l) is given.  Do not check the status code of the current page.
+my %spidered_uris;  # pages whose links have been checked
+my %status_checked_uris;  # verified pages whose status is known to be 2xx
+sub check_page {
+	_verify_page or return 0;
+	if ($long_tests && !$spidered_uris{$mech->uri} ) {
+		$spidered_uris{$mech->uri} = 1;
+		my $orig_url = $mech->uri;
+		TODO: {
+			local $TODO = "blame links can be broken sometimes"
+			    if $orig_url =~ /a=blame/;
+			for my $url (map { $_->url_abs } $mech->followable_links) {
+				if (!$status_checked_uris{$url}) {
+					$status_checked_uris{$url} = 1;
+					local $long_tests = 0;  # stop recursing
+					test_page($url, "[auto] check link ($url)")
+					    or diag("broken link to $url on $orig_url");
+					$mech->back;
+				}
+			}
+		}
+	}
+	return 1;
+}
+
+my $baseurl = "http://localhost";
+my ($params, $url, $pagedesc, $status);
+
+# test_page ( <params>, <page_description>, <expected_status> )
+# Example:
+# if (test_page('?p=.git;a=summary', 'repository summary')) {
+#     $mech->...;
+#     $mech->...;
+# }
+#
+# Test that the page can be opened, call _verify_page on it, and
+# return true if there was no test failure.  Also set the global
+# variables $params, $pagedesc, and $url for use in the if block.
+# Optionally pass a third parameter $status to test the HTTP status
+# code of the page (useful for error pages).  You can also pass a full
+# URL instead of just parameters as the first parameter.
+sub test_page {
+	($params, $pagedesc, $status) = @_;
+	# missing $pagedesc is usually accidental
+	die "$params: no pagedesc given" unless defined $pagedesc;
+	if($params =~ /^$baseurl/) {
+		$url = "$params";
+	} else {
+		$url = "$baseurl$params";
+	}
+	$mech->get($url);
+	like($mech->status, $status ? qr/$status/ : qr/^[23][0-9][0-9]$/,
+	     "$pagedesc: $url" . ($status ? " -- yields $status" : ""))
+	    or return 0;
+	if ($mech->status =~ /^3/) {
+		# Don't check 3xx, they tend to look funny.
+		my $location = $mech->response->header('Location');
+		$mech->back;  # compensate for history
+		return test_page($location, "follow redirect from $url");
+	} else {
+		return check_page;
+	}
+}
+
+# follow_link ( \%parms, $pagedesc )
+# Example:
+# if (follow_link( { text => 'commit' }, 'first commit link')) {
+#     $mech->...;
+#     $mech->back;
+# }
+# Like test_page, but does not support status code testing, and
+# returns true if there was a link at all, regardless of whether it
+# was [23]xx or not.
+sub follow_link {
+	(my $parms, $pagedesc) = @_;
+	my $link = $mech->find_link(%$parms);
+	my $current_url = $mech->uri;
+	ok($link, "link exists: $pagedesc (on page $current_url)") or return 0;
+	test_page($link->url, "follow link: $pagedesc (on page $current_url)");
+	return 1;
+}
+
+# like follow_link, except that only checks and goes back immediately;
+# use this instead of ok(find_link...).
+sub test_link {
+	my ($parms, $pagedesc) = @_;
+	my $current_url = $mech->uri;
+	if($long_tests) {
+		# Check status, validate, spider.
+		return follow_link($parms, $pagedesc) && $mech->back;
+	} else {
+		# Only check presence of the link (much faster).
+		return ok($mech->find_link(%$parms),
+			  "link exists: $pagedesc (on page $current_url)");
+	}
+}
+
+sub get_summary {
+	test_page('?p=.git', 'repository summary')
+}
+
+if (test_page '', 'project list (implicit)') {
+	$mech->title_like(qr!$site_name!,
+		"title contains $site_name");
+	$mech->content_contains('gitweb test repository',
+		'lists test repository (by description)');
+}
+
+# Test repository summary: implicit, implicit with pathinfo, explicit.
+for my $sumparams ('?p=.git', '/.git', '?p=.git;a=summary') {
+	if (test_page $sumparams, 'repository summary') {
+		$mech->title_like(qr!$site_name.*\.git/summary!,
+				  "title contains $site_name and \".git/summary\"");
+	}
+}
+
+# Search form (on summary page).
+if (get_summary && $mech->submit_form_ok(
+	    { form_number => 1, fields => { 's' => 'Initial' } },
+	    'submit search form (default)')) {
+	check_page;
+	$mech->content_contains('Initial commit',
+				'content contains commit we searched for');
+}
+
+test_page('?p=non-existent.git', 'non-existent project', 404);
+test_page('?p=.git;a=commit;h=non-existent', 'non-existent commit', 404);
+
+
+# Summary view
+
+get_summary or die 'summary page failed; no point in running the remaining tests';
+
+# Check short log.  To do: Extract into separate test_short_log
+# function since the short log occurs on several pages.
+for my $revision (@revisions) {
+	for my $link_text qw( commit commitdiff tree snapshot ) {
+		test_link( { url_abs_regex => qr/h=$revision/, text => $link_text },
+			   "$link_text link for $revision");
+	}
+}
+
+# Check that branches and tags are highlighted in green and yellow in
+# the shortlog.  We assume here that we are on master, so it should be
+# at the top.
+$mech->content_like(qr{<span [^>]*class="head"[^>]*>master</span>},
+		    'master branch is highlighted in shortlog');
+$mech->content_like(qr{<span [^>]*class="tag"[^>]*>$tags[0]</span>},
+		    "$tags[0] (most recent tag) is highlighted in shortlog");
+
+# Check heads.  (This should be extracted as well.)
+for my $head (@heads) {
+	for my $link_text qw( shortlog log tree ) {
+		test_link( { url_abs_regex => qr{h=refs/heads/$head}, text => $link_text },
+			   "$link_text link for head '$head'");
+	}
+}
+
+# Check tags (assume we only have tags referring to commits, not to
+# blobs or trees).
+for my $tag (@tags) {
+	my $commit = rev_parse("$tag^{commit}");
+	test_link( { url_abs_regex => qr{h=refs/tags/$tag}, text => 'shortlog' },
+		   "shortlog link for tag '$tag'");
+	test_link( { url_abs_regex => qr{h=refs/tags/$tag}, text => 'log' },
+		   "log link for tag '$tag'");
+	test_link( { url_abs_regex => qr{h=$commit}, text => 'commit' },
+		   "commit link for tag '$tag'");
+	test_link( { url_abs_regex => qr{h=$commit}, text => $tag },
+	   "'$tag' links to the commit as well");
+	# To do: Test tag link for tag objects.
+	# Why don't we have tree + snapshot links?
+}
+for my $tag (@tag_objects) {
+	my $tag_sha1 = rev_parse($tag);
+	test_link( { url_abs_regex => qr{h=$tag_sha1}, text => 'tag' },
+		   "tag link for tag object '$tag'" );
+}
+
+
+# RSS/Atom/OPML view
+# Simply retrieve and verify well-formedness, but don't spider.
+$mech->get_ok('?p=.git;a=atom', 'Atom feed') and _verify_page;
+$mech->get_ok('?p=.git;a=rss', 'RSS feed') and _verify_page;
+TODO: {
+	# Now spider -- but there are broken links.
+	# http://mid.gmane.org/485EB333.5070108@gmail.com
+	local $TODO = "fix broken links in Atom/RSS feeds";
+	test_page('?p=.git;a=atom', 'Atom feed');
+	test_page('?p=.git;a=rss', 'RSS feed');
+}
+test_page('?a=opml', 'OPML outline');
+
+
+# Commit view
+if (test_page('?p=.git;a=commit;h=master', 'view HEAD commit')) {
+	my $tree_sha1 = rev_parse('master:');
+	test_link( { url_abs_regex => qr/a=tree/, text => rev_parse('master:') },
+		   "SHA1 link to tree on commit page ($url)");
+	test_link( { url_abs_regex => qr/h=$tree_sha1/, text => 'tree' },
+		   "'tree' link to tree on commit page ($url)");
+	$mech->content_like(qr/A U Thor/, "author mentioned on commit page ($url)");
+}
+
+
+# Commitdiff view
+if (get_summary &&
+    follow_link( { text_regex => qr/file added/i }, 'commit with added file') &&
+    follow_link( { text => 'commitdiff' }, 'commitdiff')) {
+	$mech->content_like(qr/new file with mode/, "commitdiff has diffstat ($url)");
+	$mech->content_like(qr/new file mode/, "commitdiff has diff ($url)");
+}
+test_page("?p=.git;a=commitdiff;h=$revisions[-1]",
+	  'commitdiff without parent');
+
+# Diff formattting problem.
+if (get_summary &&
+    follow_link( { text_regex => qr/renamed/ }, 'commit with rename') &&
+    follow_link( { text => 'commitdiff' }, 'commitdiff')) {
+	TODO: {
+		local $TODO = "bad a/* link in diff";
+		if (follow_link( { text_regex => qr!^a/! },
+				 'a/* link (probably wrong)')) {
+			# The page we land on here is broken already.
+			follow_link( { url_abs_regex => qr/a=blob_plain/ },
+				     'linked file name');  # bang
+		}
+	}
+}
+
+
+# Raw commitdiff (commitdiff_plain) view
+if (test_page('?p=.git;a=commit;h=refs/tags/tag-object',
+	      'commit view of tags/tag-object') &&
+    follow_link( { text => 'commitdiff' }, "'commitdiff'") &&
+    follow_link( { text => 'raw' }, "'raw' (commitdiff_plain)")) {
+	$mech->content_like(qr/^From: A U Thor <author\@example.com>$/m,
+			    'commitdiff_plain: From header');
+	TODO: {
+		local $TODO = 'date header mangles timezone';
+		$mech->content_like(qr/^Date: Thu, 7 Apr 2005 15:..:13 -0700$/m,
+				    'commitdiff_plain: Date header (correct)');
+	}
+	$mech->content_like(qr/^Date: Thu, 7 Apr 2005 22:..:13 \+0000 \(-0700\)$/m,
+			    'commitdiff_plain: Date header (UTC, wrong)');
+	$mech->content_like(qr/^Subject: .+$/m,
+			    'commitdiff_plain: Subject header');
+	# $ markers inexplicably don't work here if we use like(...)
+	# or $mech->content_like().
+	ok($mech->content =~ /^X-Git-Tag: tag-object\^0$/m,
+	   'commitdiff_plain: X-Git-Tag header');
+	ok($mech->content =~ /^X-Git-Url: $baseurl\?p=\.git;a=commitdiff_plain;h=refs%2Ftags%2Ftag-object$/m,
+	   'commitdiff_plain: X-Git-Url header');
+	ok($mech->content =~ /^---$/m, 'commitdiff_plain: separator$');
+	$mech->content_like(qr/^diff --git /m, 'commitdiff_plain: diff$');
+}
+
+
+# Tree view
+if (get_summary && follow_link( { text => 'tree' }, 'first tree link')) {
+	for my $file (@files) {
+		my $sha1 = rev_parse("HEAD:$file");
+		test_link( { text => $file, url_abs_regex => qr/h=$sha1/ },
+			   "'$file' is listed and linked");
+		test_link({ url_abs_regex => qr/f=$file/, text => $_ },
+			  "'$_' link") foreach qw( blame blob history raw );
+	}
+	for my $directory (@directories) {
+		my $sha1 = rev_parse("HEAD:$directory");
+		test_link({ url_abs_regex => qr/f=$directory/, text => $_ },
+			  "'$_' link") foreach qw( tree history );
+		if(follow_link( { text => $directory, url_abs_regex => qr/h=$sha1/ },
+				"'$directory is listed and linked" )) {
+			if(follow_link( { text => '..' }, 'parent directory')) {
+				test_link({ url_abs_regex => qr/h=$sha1/,
+					    text => $directory },
+					  'back to original tree view');
+				$mech->back;
+			}
+			$mech->back;
+		}
+	}
+}
+
+
+# Blame view
+if (get_summary && follow_link( { text => 'tree' }, 'first tree link')) {
+	for my $blame_link ($mech->find_all_links(text => 'blame')) {
+		my $url = $blame_link->url;
+		$mech->get_ok($url, "get $url -- blame link on tree view")
+		    and _verify_page;
+		$mech->content_like(qr/A U Thor/,
+				    "author mentioned on blame page");
+		TODO: {
+			# Now spider -- but there are broken links.
+			# http://mid.gmane.org/485EC621.7090101@gmail.com
+			local $TODO = "fix broken links in certain blame views";
+			check_page;
+		}
+		last unless $long_tests; # only test first blame link
+	}
+}
+
+
+# History view
+if (get_summary && follow_link( { text => 'tree' }, 'first tree link')) {
+	for my $file (@files, @directories) {
+		my $type = get_type("HEAD:$file");  # blob or tree
+		if (follow_link( { text => 'history', url_abs_regex => qr/f=$file/ },
+				 "history link for '$file'")) {
+			# There is at least one commit, so A U Thor is mentioned.
+			$mech->content_contains('A U Thor', 'A U Thor mentioned');
+			# The following tests test for at least *one*
+			# link of each type and are weak since we
+			# don't have any knowledge of commit hashes.
+			test_link( { text => $type, url_abs_regex => qr/f=$file/ },
+				   "$type");
+			test_link( { text => 'commitdiff' },
+				   "commitdiff");
+			test_link( { url_abs_regex => qr/a=commit;.*h=[a-f0-9]{40}/ },
+				   "subject links to commit"); # weak, brittle
+			$mech->back;
+		}
+	}
+}
+
+
+# Blob view
+if (get_summary && follow_link( { text => 'tree' }, 'first tree link')) {
+	for my $file (@files) {
+		if (follow_link( { text => $file, url_abs_regex => qr/a=blob/ },
+				 "\"$file\" (blob) entry on tree view")) {
+			chomp(my $first_line_regex = (`cat "$file"`)[0]);
+			$first_line_regex =~ s/ / |&nbsp;/g;
+			# Hope that the first line doesn't contain any
+			# HTML-escapable character.
+			$mech->content_like(qr/$first_line_regex/,
+					    "blob view contains first line of file ($url)");
+			$mech->back;
+		}
+	}
+}
+
+
+# Raw (blob_plain) view
+if (get_summary && follow_link( { text => 'tree' }, 'first tree link')) {
+	for my $file (@files) {
+		if (follow_link( { text => 'raw', url_abs_regex => qr/f=$file/ },
+				 "raw (blob_plain) entry for \"$file\" in tree view")) {
+			chomp(my $first_line = (`cat "$file"`)[0]);
+			$mech->content_contains(
+				$first_line, "blob_plain view contains first line of file");
+			$mech->back;
+		}
+	}
+}
+
+
+# Error handling
+# Pass valid and invalid paths to various file-based actions
+for my $action qw( blame blob blob_plain blame ) {
+	test_page("?p=.git;a=$action;f=$files[0];hb=HEAD",
+		  "$action: look up existent file");
+	test_page("?p=.git;a=$action;f=does_not_exist;hb=HEAD",
+		  "$action: look up non-existent file", 404);
+	TODO: {
+		local $TODO = 'wrong error code (but using Git::Repo will fix this)';
+		test_page("?p=.git;a=$action;f=$directories[0];hb=HEAD",
+			  "$action: look up directory", 400);
+	}
+}
+TODO: {
+	local $TODO = 'wrong error code (but using Git::Repo will fix this)';
+	test_page("?p=.git;a=tree;f=$files[0];hb=HEAD",
+		  'tree: look up existent file', 400);
+}
+# Pass valid and invalid paths to tree action
+test_page("?p=.git;a=tree;f=does_not_exist;hb=HEAD",
+	  'tree: look up non-existent file', 404);
+test_page("?p=.git;a=tree;f=$directories[0];hb=HEAD",
+	  'tree: look up directory');
+TODO: {
+	local $TODO = 'cannot use f=/ or f= for trees';
+	test_page("?p=.git;a=tree;f=/;hb=HEAD", 'tree: look up directory');
+}
+
+
+1;
+__END__
-- 
1.5.6.109.g33ded.dirty