gitweb: use new Git::Repo API, and add optional caching
[git/gitweb-caching.git] / t / t9503 / test.pl
blob7685352a1008dbc670bbc004d6ceba2eba75d24b
1 #!/usr/bin/perl
2 use lib (split(/:/, $ENV{GITPERLLIB}));
4 # This test supports the --long-tests option.
6 use warnings;
7 use strict;
9 use Cwd qw( abs_path );
10 use File::Spec;
11 use File::Temp;
12 use Storable;
14 use Test::More qw(no_plan);
16 our $long_tests = $ENV{GIT_TEST_LONG}; # "our" so we can use "local $long_tests"
18 eval { require Archive::Tar; };
19 my $archive_tar_installed = !$@
20 or diag('Archive::Tar is not installed; no tests for valid snapshots');
22 eval { require HTML::Lint; };
23 my $html_lint_installed = !$@
24 or diag('HTML::Lint is not installed; no HTML validation tests');
26 eval { require XML::Parser; };
27 my $xml_parser_installed = !$@
28 or diag('XML::Parser is not installed; no tests for well-formed XML');
30 sub rev_parse {
31 my $name = shift;
32 chomp(my $sha1 = `git rev-parse $name 2> /dev/null`);
33 $sha1 or die;
36 sub get_type {
37 my $name = shift;
38 chomp(my $type = `git cat-file -t $name 2> /dev/null`);
39 $type or die;
43 package OurMechanize;
45 use base qw( Test::WWW::Mechanize::CGI );
47 my %page_cache;
48 # Cache requests.
49 sub _make_request {
50 my ($self, $request) = (shift, shift);
52 my $response;
53 unless ($response = Storable::thaw($page_cache{$request->uri})) {
54 $response = $self->SUPER::_make_request($request, @_);
55 $page_cache{$request->uri} = Storable::freeze($response);
57 return $response;
60 # Fix whitespace problem.
61 sub cgi_application {
62 my ($self, $application) = @_;
64 # This subroutine was copied (and modified) from
65 # WWW::Mechanize::CGI 0.3, which is licensed 'under the same
66 # terms as perl itself' and thus GPL compatible.
67 my $cgi = sub {
68 # Use exec, not the shell, to support embedded
69 # whitespace in the path to $application.
70 # http://rt.cpan.org/Ticket/Display.html?id=36654
71 my $status = system $application $application;
72 my $exit_code = $status >> 8;
74 die "Failed to execute application '$application'. Reason: '$!'"
75 if ($status == -1);
76 die "Application '$application' exited with exit code $exit_code"
77 if ($exit_code > 0);
80 $self->cgi($cgi);
83 package main;
86 my @revisions = split /\s/, `git-rev-list --first-parent HEAD`;
87 chomp(my @heads = map { (split('/', $_))[2] } `git-for-each-ref --sort=-committerdate refs/heads`);
88 chomp(my @tags = map { (split('/', $_))[2] } `git-for-each-ref --sort=-committerdate refs/tags`);
89 my @tag_objects = grep { get_type($_) eq 'tag' } @tags;
90 chomp(my @root_entries = `git-ls-tree --name-only HEAD`);
91 my @files = grep { get_type("HEAD:$_") eq 'blob' } @root_entries or die;
92 my @directories = grep { get_type("HEAD:$_") eq 'tree' } @root_entries or die;
93 unless ($long_tests) {
94 # Only test one of each kind.
95 @files = $files[0];
96 @directories = $directories[0];
97 @tag_objects = $tag_objects[0];
100 my $gitweb = abs_path(File::Spec->catfile($ENV{TEST_DIRECTORY}, '..', 'gitweb', 'gitweb.cgi'));
102 my $mech = OurMechanize->new;
103 $mech->cgi_application($gitweb);
104 # On some systems(?) it's necessary to have %ENV here, otherwise the
105 # CGI process won't get *any* of the current environment variables
106 # (not even PATH, etc.)
107 $mech->env(%ENV,
108 GITWEB_CONFIG => $ENV{'GITWEB_CONFIG'},
109 SCRIPT_FILENAME => $gitweb,
110 $mech->env);
112 # import config, predeclaring config variables
113 our $site_name;
114 require_ok($ENV{'GITWEB_CONFIG'})
115 or diag('Could not load gitweb config; some tests would fail');
117 # Perform non-recursive checks on the current page, but do not check
118 # the status code.
119 my %verified_uris;
120 sub _verify_page {
121 my ($uri, $fragment) = split '#', $mech->uri;
122 TODO: {
123 local $TODO = 'line number fragments can be broken for diffs and blames'
124 if $fragment && $fragment =~ /^l[0-9]+$/;
125 $mech->content_like(qr/(name|id)="$fragment"/,
126 "[auto] fragment #$fragment exists ($uri)")
127 if $fragment;
130 return 1 if $verified_uris{$uri};
131 $verified_uris{$uri} = 1;
133 # Internal errors yield 200 but cause gitweb.cgi to exit with
134 # non-zero exit code, which Mechanize::CGI translates to 500,
135 # so we don't really need to check for "Software error" here,
136 # provided that the test cases always check the status code.
137 #$mech->content_lacks('<h1>Software error:</h1>') or return 0;
139 # Validate. This is fast, so we can do it even without
140 # $long_tests.
141 $mech->html_lint_ok('[auto] validate HTML') or return 0
142 if $html_lint_installed && $mech->is_html;
143 my $content_type = $mech->response->header('Content-Type')
144 or die "$uri does not have a Content-Type header";
145 if ($xml_parser_installed && $content_type =~ /xml/) {
146 eval { XML::Parser->new->parse($mech->content); };
147 ok(!$@, "[auto] check for XML well-formedness ($uri)") or diag($@);
149 if ($archive_tar_installed && $uri =~ /sf=tgz/) {
150 my $snapshot_file = File::Temp->new;
151 print $snapshot_file $mech->content;
152 close $snapshot_file;
153 my $t = Archive::Tar->new;
154 $t->read($snapshot_file->filename, 1);
155 ok($t->get_files, "[auto] valid tgz snapshot ($uri)");
157 # WebService::Validator::Feed::W3C would be nice to
158 # use, but it doesn't support direct input (as opposed
159 # to URIs) long enough for our feeds.
161 return 1;
164 # Verify and spider the current page, the latter only if --long-tests
165 # (-l) is given. Do not check the status code of the current page.
166 my %spidered_uris; # pages whose links have been checked
167 my %status_checked_uris; # verified pages whose status is known to be 2xx
168 sub check_page {
169 _verify_page or return 0;
170 if ($long_tests && !$spidered_uris{$mech->uri} ) {
171 $spidered_uris{$mech->uri} = 1;
172 my $orig_url = $mech->uri;
173 TODO: {
174 local $TODO = "blame links can be broken sometimes"
175 if $orig_url =~ /a=blame/;
176 for my $url (map { $_->url_abs } $mech->followable_links) {
177 if (!$status_checked_uris{$url}) {
178 $status_checked_uris{$url} = 1;
179 local $long_tests = 0; # stop recursing
180 test_page($url, "[auto] check link")
181 or diag("broken link to $url on $orig_url");
182 $mech->back;
187 return 1;
190 my $baseurl = "http://localhost";
191 my ($params, $url, $pagedesc, $status);
193 # test_page ( <params>, <page_description>, <expected_status> )
194 # Example:
195 # if (test_page('?p=.git;a=summary', 'repository summary')) {
196 # $mech->...;
197 # $mech->...;
200 # Test that the page can be opened, call _verify_page on it, and
201 # return true if there was no test failure. Also set the global
202 # variables $params, $pagedesc, and $url for use in the if block.
203 # Optionally pass a third parameter $status to test the HTTP status
204 # code of the page (useful for error pages). You can also pass a full
205 # URL instead of just parameters as the first parameter.
206 sub test_page {
207 ($params, $pagedesc, $status) = @_;
208 # missing $pagedesc is usually accidental
209 die "$params: no pagedesc given" unless defined $pagedesc;
210 if($params =~ /^$baseurl/) {
211 $url = "$params";
212 } else {
213 $url = "$baseurl$params";
215 $mech->get($url);
216 like($mech->status, $status ? qr/$status/ : qr/^[23][0-9][0-9]$/,
217 "$pagedesc: $url" . ($status ? " -- yields $status" : ""))
218 or return 0;
219 if ($mech->status =~ /^3/) {
220 # Don't check 3xx, they tend to look funny.
221 my $location = $mech->response->header('Location');
222 $mech->back; # compensate for history
223 return test_page($location, "follow redirect from $url");
224 } else {
225 return check_page;
229 # follow_link ( \%parms, $pagedesc )
230 # Example:
231 # if (follow_link( { text => 'commit' }, 'first commit link')) {
232 # $mech->...;
233 # $mech->back;
235 # Like test_page, but does not support status code testing, and
236 # returns true if there was a link at all, regardless of whether it
237 # was [23]xx or not.
238 sub follow_link {
239 (my $parms, $pagedesc) = @_;
240 my $link = $mech->find_link(%$parms);
241 my $current_url = $mech->uri;
242 ok($link, "link exists: $pagedesc (on page $current_url)") or return 0;
243 test_page($link->url, "follow link: $pagedesc (on page $current_url)");
244 return 1;
247 # like follow_link, except that only checks and goes back immediately;
248 # use this instead of ok(find_link...).
249 sub test_link {
250 my ($parms, $pagedesc) = @_;
251 my $current_url = $mech->uri;
252 if($long_tests) {
253 # Check status, validate, spider.
254 return follow_link($parms, $pagedesc) && $mech->back;
255 } else {
256 # Only check presence of the link (much faster).
257 return ok($mech->find_link(%$parms),
258 "link exists: $pagedesc (on page $current_url)");
262 sub get_summary {
263 test_page('?p=.git', 'repository summary');
266 get_summary or die 'summary page failed; aborting all tests';
269 if (test_page '', 'project list (implicit)') {
270 $mech->title_like(qr!$site_name!,
271 "title contains $site_name");
272 $mech->content_contains('t9503-gitweb-Mechanize test repository',
273 'lists test repository (by description)');
274 if (follow_link( { text => 'empty.git' }, 'empty git repository')) {
275 # Just check that the empty.git summary page is linked
276 # and doesn't die.
277 $mech->back;
282 # Test repository summary: implicit, implicit with pathinfo, explicit.
283 for my $sumparams ('?p=.git', '/.git', '?p=.git;a=summary') {
284 if (test_page $sumparams, 'repository summary') {
285 $mech->title_like(qr!$site_name.*\.git/summary!,
286 "title contains $site_name and \".git/summary\"");
291 # Search form
293 # Search commit
294 if (get_summary && $mech->submit_form_ok(
295 { form_number => 1, fields => { 's' => 'Initial' } },
296 'submit search form (default: commit search)')) {
297 check_page;
298 $mech->content_contains('Initial commit',
299 'content contains commit we searched for');
302 # Pickaxe
303 if (get_summary && $mech->submit_form_ok(
304 { form_number => 1, fields => { 's' => 'pickaxe test string',
305 'st' => 'pickaxe' } },
306 'submit search form (pickaxe)')) {
307 check_page;
308 test_link( { text => 'dir1/file1' }, 'file found with pickaxe' );
309 $mech->content_contains('A U Thor', 'commit author mentioned');
312 # Grep
313 # Let's hope the pickaxe test string is still present in HEAD.
314 if (get_summary && $mech->submit_form_ok(
315 { form_number => 1, fields => { 's' => 'pickaxe test string',
316 'st' => 'grep' } },
317 'submit search form (grep)')) {
318 check_page;
319 test_link( { text => 'dir1/file1' }, 'file found with grep' );
323 # Basic error handling
324 test_page('?p=non-existent.git', 'non-existent project', 404);
325 test_page('?p=.git;a=commit;h=non-existent', 'non-existent commit', 404);
328 # Summary view
329 get_summary;
331 # Check short log. To do: Extract into separate test_short_log
332 # function since the short log occurs on several pages.
333 for my $revision (@revisions) {
334 for my $link_text qw( commit commitdiff tree snapshot ) {
335 test_link( { url_abs_regex => qr/h=$revision/, text => $link_text },
336 "$link_text link for $revision");
340 # Check that branches and tags are highlighted in green and yellow in
341 # the shortlog. We assume here that we are on master, so it should be
342 # at the top.
343 $mech->content_like(qr{<span [^>]*class="head"[^>]*>master</span>},
344 'master branch is highlighted in shortlog');
345 $mech->content_like(qr{<span [^>]*class="tag"[^>]*>$tags[0]</span>},
346 "$tags[0] (most recent tag) is highlighted in shortlog");
348 # Check heads. (This should be extracted as well.)
349 for my $head (@heads) {
350 for my $link_text qw( shortlog log tree ) {
351 test_link( { url_abs_regex => qr{h=refs/heads/$head}, text => $link_text },
352 "$link_text link for head '$head'");
356 # Check tags (assume we only have tags referring to commits, not to
357 # blobs or trees).
358 for my $tag (@tags) {
359 my $commit = rev_parse("$tag^{commit}");
360 test_link( { url_abs_regex => qr{h=refs/tags/$tag}, text => 'shortlog' },
361 "shortlog link for tag '$tag'");
362 test_link( { url_abs_regex => qr{h=refs/tags/$tag}, text => 'log' },
363 "log link for tag '$tag'");
364 test_link( { url_abs_regex => qr{h=$commit}, text => 'commit' },
365 "commit link for tag '$tag'");
366 test_link( { url_abs_regex => qr{h=$commit}, text => $tag },
367 "'$tag' links to the commit as well");
368 # To do: Test tag link for tag objects.
369 # Why don't we have tree + snapshot links?
373 # RSS/Atom/OPML view
374 # Simply retrieve and verify well-formedness, but don't spider.
375 $mech->get_ok('?p=.git;a=atom', 'Atom feed') and _verify_page;
376 $mech->get_ok('?p=.git;a=rss', 'RSS feed') and _verify_page;
377 TODO: {
378 # Now spider -- but there are broken links.
379 # http://mid.gmane.org/485EB333.5070108@gmail.com
380 local $TODO = "fix broken links in Atom/RSS feeds";
381 test_page('?p=.git;a=atom', 'Atom feed');
382 test_page('?p=.git;a=rss', 'RSS feed');
384 test_page('?a=opml', 'OPML outline');
387 # Tag view
388 get_summary;
389 for my $tag (@tag_objects) {
390 my $tag_sha1 = rev_parse($tag);
391 my $object_sha1 = rev_parse("$tag^{}");
392 if(follow_link( { url_abs_regex => qr{h=$tag_sha1}, text => 'tag' },
393 "tag link for tag object '$tag'" )) {
394 $mech->content_contains('C O Mitter', 'tagger mentioned');
395 test_link( { url_abs_regex => qr/h=$object_sha1/ },
396 'link to referenced object');
397 $mech->back;
402 # Commit view
403 if (test_page('?p=.git;a=commit;h=master', 'view HEAD commit')) {
404 my $tree_sha1 = rev_parse('master:');
405 test_link( { url_abs_regex => qr/a=tree/, text => rev_parse('master:') },
406 "SHA1 link to tree on commit page ($url)");
407 test_link( { url_abs_regex => qr/h=$tree_sha1/, text => 'tree' },
408 "'tree' link to tree on commit page ($url)");
409 $mech->content_like(qr/A U Thor/, "author mentioned on commit page ($url)");
413 # Commitdiff view
414 if (get_summary &&
415 follow_link( { text_regex => qr/file added/i }, 'commit with added file') &&
416 follow_link( { text => 'commitdiff' }, 'commitdiff')) {
417 $mech->content_like(qr/new file with mode/, "commitdiff has diffstat ($url)");
418 $mech->content_like(qr/new file mode/, "commitdiff has diff ($url)");
420 test_page("?p=.git;a=commitdiff;h=$revisions[-1]",
421 'commitdiff without parent');
423 # Diff formatting problem.
424 if (get_summary &&
425 follow_link( { text_regex => qr/renamed/ }, 'commit with rename') &&
426 follow_link( { text => 'commitdiff' }, 'commitdiff')) {
427 TODO: {
428 local $TODO = "bad a/* link in diff";
429 if (follow_link( { text_regex => qr!^a/! },
430 'a/* link (probably wrong)')) {
431 # The page we land on here is broken already.
432 follow_link( { url_abs_regex => qr/a=blob_plain/ },
433 'linked file name'); # bang
439 # Raw commitdiff (commitdiff_plain) view
440 if (test_page('?p=.git;a=commit;h=refs/tags/tag-object',
441 'commit view of tags/tag-object') &&
442 follow_link( { text => 'commitdiff' }, "'commitdiff'") &&
443 follow_link( { text => 'raw' }, "'raw' (commitdiff_plain)")) {
444 $mech->content_like(qr/^From: A U Thor <author\@example.com>$/m,
445 'commitdiff_plain: From header');
446 TODO: {
447 local $TODO = 'date header mangles timezone';
448 $mech->content_like(qr/^Date: Thu, 7 Apr 2005 15:..:13 -0700$/m,
449 'commitdiff_plain: Date header (correct)');
451 $mech->content_like(qr/^Date: Thu, 7 Apr 2005 22:..:13 \+0000 \(-0700\)$/m,
452 'commitdiff_plain: Date header (UTC, wrong)');
453 $mech->content_like(qr/^Subject: .+$/m,
454 'commitdiff_plain: Subject header');
455 # '$' markers inexplicably don't work here if we use like(...)
456 # or $mech->content_like().
457 ok($mech->content =~ /^X-Git-Tag: tag-object\^0$/m,
458 'commitdiff_plain: X-Git-Tag header');
459 ok($mech->content =~ /^X-Git-Url: $baseurl\?p=\.git;a=commitdiff_plain;h=refs%2Ftags%2Ftag-object$/m,
460 'commitdiff_plain: X-Git-Url header');
461 ok($mech->content =~ /^---$/m, 'commitdiff_plain: separator');
462 ok($mech->content =~ /^diff --git /m, 'commitdiff_plain: diff');
466 # Blobdiff view
467 # This assumes file2 has changed at least once, so that there can be a
468 # blobdiff for it.
469 if (get_summary && follow_link( { text => 'tree' }, 'first tree link') &&
470 follow_link( { text => 'history', url_abs_regex => qr/f=file2/ },
471 'history of file2') &&
472 follow_link( { text => 'diff to current' },
473 'some "diff to current" (blobdiff)')) {
474 $mech->content_contains('diff --git', 'blobdiff: has diff header');
475 test_link( { text => 'raw', url_abs_regex => qr/a=blobdiff_plain/ },
476 '"raw" (blobdiff_plain) link');
479 # Tree view
480 if (get_summary && follow_link( { text => 'tree' }, 'first tree link')) {
481 for my $file (@files) {
482 my $sha1 = rev_parse("HEAD:$file");
483 test_link( { text => $file, url_abs_regex => qr/h=$sha1/ },
484 "'$file' is listed and linked");
485 test_link({ url_abs_regex => qr/f=$file/, text => $_ },
486 "'$_' link") foreach qw( blame blob history raw );
488 for my $directory (@directories) {
489 my $sha1 = rev_parse("HEAD:$directory");
490 test_link({ url_abs_regex => qr/f=$directory/, text => $_ },
491 "'$_' link") foreach qw( tree history );
492 if(follow_link( { text => $directory, url_abs_regex => qr/h=$sha1/ },
493 "'$directory is listed and linked" )) {
494 if(follow_link( { text => '..' }, 'parent directory')) {
495 test_link({ url_abs_regex => qr/h=$sha1/,
496 text => $directory },
497 'back to original tree view');
498 $mech->back;
500 $mech->back;
506 # Blame view
507 if (get_summary && follow_link( { text => 'tree' }, 'first tree link')) {
508 for my $blame_link ($mech->find_all_links(text => 'blame')) {
509 my $url = $blame_link->url;
510 $mech->get_ok($url, "get $url -- blame link on tree view")
511 and _verify_page;
512 $mech->content_like(qr/A U Thor/,
513 "author mentioned on blame page");
514 TODO: {
515 # Now spider -- but there are broken links.
516 # http://mid.gmane.org/485EC621.7090101@gmail.com
517 local $TODO = "fix broken links in certain blame views";
518 check_page;
520 last unless $long_tests; # only test first blame link
525 # History view
526 if (get_summary && follow_link( { text => 'tree' }, 'first tree link')) {
527 for my $file (@files, @directories) {
528 my $type = get_type("HEAD:$file"); # blob or tree
529 if (follow_link( { text => 'history', url_abs_regex => qr/f=$file/ },
530 "history link for '$file'")) {
531 # There is at least one commit, so A U Thor is mentioned.
532 $mech->content_contains('A U Thor', 'A U Thor mentioned');
533 # The following tests test for at least *one*
534 # link of each type and are weak since we
535 # don't have any knowledge of commit hashes.
536 test_link( { text => $type, url_abs_regex => qr/f=$file/ },
537 "$type");
538 test_link( { text => 'commitdiff' },
539 "commitdiff");
540 test_link( { url_abs_regex => qr/a=commit;.*h=[a-f0-9]{40}/ },
541 "subject links to commit"); # weak, brittle
542 $mech->back;
548 # Blob view
549 if (get_summary && follow_link( { text => 'tree' }, 'first tree link')) {
550 for my $file (@files) {
551 if (follow_link( { text => $file, url_abs_regex => qr/a=blob/ },
552 "\"$file\" (blob) entry on tree view")) {
553 chomp(my $first_line_regex = (`cat "$file"`)[0]);
554 $first_line_regex =~ s/ / |&nbsp;/g;
555 # Hope that the first line doesn't contain any
556 # HTML-escapable character.
557 $mech->content_like(qr/$first_line_regex/,
558 "blob view contains first line of file ($url)");
559 $mech->back;
565 # Raw (blob_plain) view
566 if (get_summary && follow_link( { text => 'tree' }, 'first tree link')) {
567 for my $file (@files) {
568 if (follow_link( { text => 'raw', url_abs_regex => qr/f=$file/ },
569 "raw (blob_plain) entry for \"$file\" in tree view")) {
570 chomp(my $first_line = (`cat "$file"`)[0]);
571 $mech->content_contains(
572 $first_line, "blob_plain view contains first line of file");
573 $mech->back;
579 # Error handling
580 # Pass valid and invalid paths to various file-based actions
581 for my $action qw( blame blob blob_plain ) {
582 test_page("?p=.git;a=$action;f=$files[0];hb=HEAD",
583 "$action: look up existent file");
584 test_page("?p=.git;a=$action;f=does_not_exist;hb=HEAD",
585 "$action: look up non-existent file", 404);
586 test_page("?p=.git;a=$action;f=$directories[0];hb=HEAD",
587 "$action: look up directory", 400);
589 # Pass valid and invalid paths to tree action
590 test_page("?p=.git;a=tree;f=$files[0];hb=HEAD",
591 'tree: look up existent file', 400);
592 test_page("?p=.git;a=tree;f=does_not_exist;hb=HEAD",
593 'tree: look up non-existent file', 404);
594 test_page("?p=.git;a=tree;f=$directories[0];hb=HEAD",
595 'tree: look up directory');
596 TODO: {
597 local $TODO = 'cannot use f=/ or f= for trees';
598 test_page("?p=.git;a=tree;f=/;hb=HEAD", 'tree: look up directory');
603 __END__