diff --git a/http/web.py b/http/web.py index 8b985db..320d8ba 100755 --- a/http/web.py +++ b/http/web.py @@ -1,4 +1,4 @@ -#!/usr/bin/python3 +#!/usr/bin/env python3 # This file is part of Elixir, a source code cross-referencer. # diff --git a/t/050-testhelpers.t b/t/050-testhelpers.t new file mode 100644 index 0000000..0840085 --- /dev/null +++ b/t/050-testhelpers.t @@ -0,0 +1,57 @@ +#!/usr/bin/env perl +# t/50-testhelpers.t: test TestHelpers.pm +# +# Copyright (c) 2020 Christopher White, . +# Copyright (c) 2020 D3 Engineering, LLC. +# +# Elixir is free software; you can redistribute it and/or modify +# it under the terms of the GNU Affero General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# Elixir is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU Affero General Public License for more details. +# # You should have received a copy of the GNU Affero General Public License +# along with Elixir. If not, see . +# +# SPDX-License-Identifier: AGPL-3.0-or-later +# +# This file uses core Perl modules only. + +use FindBin '$Bin'; +use lib $Bin; + +use Test::More; + +use TestEnvironment; +use TestHelpers qw(:all); + +# === line_mark_string ======================================================= + +our ($fn, $refln, $ln); + +sub level1 { + eval line_mark_string 1, '$fn = __FILE__; $ln = __LINE__'; + ok !$@, 'level1 no errors'; +} + +$refln = __LINE__; level1; +is $fn, __FILE__, 'level1 file'; +cmp_ok $ln, '==', $refln, 'level1 line'; + +sub level2 { + level2_inner(); +} + +sub level2_inner { + eval line_mark_string 2, '$fn = __FILE__; $ln = __LINE__'; + ok !$@, 'level2_inner no errors'; +} + +$refln = __LINE__; level2; +is $fn, __FILE__, 'level2 file'; +cmp_ok $ln, '==', $refln, 'level2 line'; + +done_testing; diff --git a/t/400-web.t b/t/400-web.t new file mode 100644 index 0000000..a5b8f09 --- /dev/null +++ b/t/400-web.t @@ -0,0 +1,52 @@ +#!/usr/bin/env perl +# t/400-web.pl: Test web.py +# +# Copyright (c) 2020 Christopher White, . +# +# Elixir is free software; you can redistribute it and/or modify +# it under the terms of the GNU Affero General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# Elixir is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU Affero General Public License for more details. +# # You should have received a copy of the GNU Affero General Public License +# along with Elixir. If not, see . +# +# SPDX-License-Identifier: AGPL-3.0-or-later +# +# This file uses core Perl modules only. + +use FindBin '$Bin'; +use lib $Bin; + +use Test::More; + +use TestEnvironment; +use TestHelpers; + +# =========================================================================== +# Main + +# Set up for the tests +my $tenv = TestEnvironment->new; +$tenv->build_repo(sibling_abs_path('tree')); # dies on error +$tenv->build_db; +$tenv->update_env; + +diag $tenv->report; + +http_request_ok 'index query', $tenv, '/testproj/latest/source', + [ qr{^Content-Type:\s*text/html}, qr{href="latest/source/issue102.c"}, + qr{href="latest/source/arch"} ]; + +http_request_ok 'identifier query', $tenv, '/testproj/v5.4/ident/gsb_buffer', + [ qr{^Content-Type:\s*text/html}, qr{\bgsb_buffer\b}, + qr{"v5.4/source/drivers/i2c/i2c-core-acpi.c\#L23".+? + drivers/i2c/i2c-core-acpi.c.+? + line[ ]23.+? + \bstruct\b}x ]; + +done_testing; diff --git a/t/TestEnvironment.pm b/t/TestEnvironment.pm index 8a03d6c..8237671 100644 --- a/t/TestEnvironment.pm +++ b/t/TestEnvironment.pm @@ -246,6 +246,7 @@ sub make_web_request { $self->update_env; # just in case local $ENV{REQUEST_URI} = $url; + diag "Requesting `$url'"; my ($exit_status, $lrStdout, $lrStderr) = run_program($self->web_py); if(!wantarray) { diff --git a/t/TestHelpers.pm b/t/TestHelpers.pm index f9c04f8..fb196fc 100644 --- a/t/TestHelpers.pm +++ b/t/TestHelpers.pm @@ -43,7 +43,7 @@ use parent 'Exporter'; our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS); BEGIN { @EXPORT = qw(sibling_abs_path find_program run_program ok_or_die - run_produces_ok MUST_SUCCEED); + run_produces_ok http_request_ok MUST_SUCCEED); @EXPORT_OK = qw(line_mark_string); %EXPORT_TAGS = ( all => [@EXPORT, @EXPORT_OK], @@ -142,9 +142,9 @@ for consistency with bash (L). =cut sub _run_and_capture; # forward +sub _check_queries; # forward sub run_program { - diag "Running @_"; if(wantarray) { goto &_run_and_capture; @@ -152,6 +152,7 @@ sub run_program { my $errmsg; + diag "Running @_"; my $status = system(@_); if ($status == -1) { @@ -199,7 +200,7 @@ EOT Run a program and check whether it produces expected output. Usage: - run_produces_ok($desc, \@program_and_args, \@expected_regexes, + run_produces_ok($desc, \@program_and_args, \@conditions, $mustSucceed, $printOutput) The test passes if each condition in C<@conditions> is true. @@ -286,11 +287,18 @@ sub _run_and_capture { } #_run_and_capture() sub run_produces_ok { - my ($desc, $lrProgram, $lrRegexes, $mustSucceed, $printOutput) = @_; + my ($desc, $lrProgram, $lrConditions, $mustSucceed, $printOutput) = @_; my ($exit_status, $outlines, $errlines) = _run_and_capture(@$lrProgram); - my @outlines = @$outlines; - my @errlines = @$errlines; + + _check_queries($desc, $lrConditions, $mustSucceed, $printOutput, $exit_status, $outlines, $errlines); +} #run_produces_ok() + +sub _check_queries { + my ($desc, $lrConditions, $mustSucceed, $printOutput, $exit_status, $lrStdout, $lrStderr) = @_; + + my @outlines = @$lrStdout; + my @errlines = @$lrStderr; if ($printOutput) { diag "@outlines"; @@ -298,15 +306,16 @@ sub run_produces_ok { # Basic checks if($mustSucceed) { - eval line_mark_string 1, <<'EOT'; + eval line_mark_string 2, <<'EOT'; cmp_ok($exit_status, '==', 0, "$desc: exit status 0"); cmp_ok(@errlines, '==', 0, "$desc: stderr empty"); EOT + die $@ if $@; } # Check regexes my %query_py_output; # filled in only if we see a def/ref/doc - for my $entry (@$lrRegexes) { + for my $entry (@$lrConditions) { my ($re, $negated, $source) = _parse_condition($entry); # Parse query.py output if we need it and haven't done so @@ -327,11 +336,42 @@ EOT # Run it #diag "Running $test"; - eval line_mark_string 1, $test; + eval line_mark_string 2, $test; + die $@ if $@; } #foreach $entry } #run_produces_ok() +=head2 http_request_ok + +Run C against a given path and check whether it produces expected +output. Usage: + + http_request_ok($desc, $tenv, $path, \@conditions, $printOutput) + +The test passes if the HTTP request succeeds, and if each condition in +C<@conditions> is true of the result (headers and body). + +C<$tenv> is a L. + +C<$path> is the path part of the URL, e.g., C. + +See L for C<@conditions>. + +If C<$printOutput> is true, prints the output of C<@program_and_args>. + +=cut + +sub http_request_ok { + my ($desc, $tenv, $path, $lrConditions, $printOutput) = @_; + die "Invalid args" unless $desc && ref $tenv && eval { @$lrConditions }; + + my ($exit_status, $lrStdout, $lrStderr) = $tenv->make_web_request($path); + + _check_queries($desc, $lrConditions, MUST_SUCCEED, $printOutput, + $exit_status, $lrStdout, $lrStderr); +} #http_request_ok() + =head1 INTERNAL FUNCTIONS These are ones you probably won't need to call. @@ -349,16 +389,17 @@ sub _parseq { my $list; foreach(@_) { chomp; - if($_ eq 'Symbol Definitions:') { + if(/(?:^Symbol Definitions:$)|\bDefined in \d+/) { $list = 'def'; next; - } elsif($_ eq 'Symbol References:') { + } elsif(/(?:^Symbol References:$)|\bReferenced in \d+/) { $list = 'ref'; next; - } elsif($_ eq 'Documented in:') { + } elsif(/(?:^Documented in:$)|\bDocumented in \d+/) { $list = 'doc'; next; } + next unless $list; #diag "Adding `$_' to list $list"; push @{$retval{$list}}, $_;