chainlint.pl: add parser to identify test definitions

Finish fleshing out chainlint.pl by adding ScriptParser, a parser which
scans shell scripts for tests defined by test_expect_success() and
test_expect_failure(), plucks the test body from each definition, and
passes it to TestParser for validation. It recognizes test definitions
not only at the top-level of test scripts but also tests synthesized
within compound commands such as loops and function.

Signed-off-by: Eric Sunshine <sunshine@sunshineco.com>
Signed-off-by: Junio C Hamano <gitster@pobox.com>

diff --git a/t/chainlint.pl b/t/chainlint.pl
index ad257106e56826bdb1cda8580eb3938f880b8a71..d526723ac003173c02d7fa4803927c6914029227 100755 (executable)
--- a/t/chainlint.pl
+++ b/t/chainlint.pl
@@ -487,18 +487,75 @@ DONE:
        $self->SUPER::accumulate($tokens, $cmd);
 }
 
+# ScriptParser is a subclass of ShellParser which identifies individual test
+# definitions within test scripts, and passes each test body through TestParser
+# to identify possible problems. ShellParser detects test definitions not only
+# at the top-level of test scripts but also within compound commands such as
+# loops and function definitions.
 package ScriptParser;
 
+use base 'ShellParser';
+
 sub new {
        my $class = shift @_;
-       my $self = bless {} => $class;
-       $self->{output} = [];
+       my $self = $class->SUPER::new(@_);
        $self->{ntests} = 0;
        return $self;
 }
 
+# extract the raw content of a token, which may be a single string or a
+# composition of multiple strings and non-string character runs; for instance,
+# `"test body"` unwraps to `test body`; `word"a b"42'c d'` to `worda b42c d`
+sub unwrap {
+       my $token = @_ ? shift @_ : $_;
+       # simple case: 'sqstring' or "dqstring"
+       return $token if $token =~ s/^'([^']*)'$/$1/;
+       return $token if $token =~ s/^"([^"]*)"$/$1/;
+
+       # composite case
+       my ($s, $q, $escaped);
+       while (1) {
+               # slurp up non-special characters
+               $s .= $1 if $token =~ /\G([^\\'"]*)/gc;
+               # handle special characters
+               last unless $token =~ /\G(.)/sgc;
+               my $c = $1;
+               $q = undef, next if defined($q) && $c eq $q;
+               $q = $c, next if !defined($q) && $c =~ /^['"]$/;
+               if ($c eq '\\') {
+                       last unless $token =~ /\G(.)/sgc;
+                       $c = $1;
+                       $s .= '\\' if $c eq "\n"; # preserve line splice
+               }
+               $s .= $c;
+       }
+       return $s
+}
+
+sub check_test {
+       my $self = shift @_;
+       my ($title, $body) = map(unwrap, @_);
+       $self->{ntests}++;
+       my $parser = TestParser->new(\$body);
+       my @tokens = $parser->parse();
+       return unless $emit_all || grep(/\?![^?]+\?!/, @tokens);
+       my $checked = join(' ', @tokens);
+       $checked =~ s/^\n//;
+       $checked =~ s/^ //mg;
+       $checked =~ s/ $//mg;
+       $checked .= "\n" unless $checked =~ /\n$/;
+       push(@{$self->{output}}, "# chainlint: $title\n$checked");
+}
+
 sub parse_cmd {
-       return undef;
+       my $self = shift @_;
+       my @tokens = $self->SUPER::parse_cmd();
+       return @tokens unless @tokens && $tokens[0] =~ /^test_expect_(?:success|failure)$/;
+       my $n = $#tokens;
+       $n-- while $n >= 0 && $tokens[$n] =~ /^(?:[;&\n|]|&&|\|\|)$/;
+       $self->check_test($tokens[1], $tokens[2]) if $n == 2; # title body
+       $self->check_test($tokens[2], $tokens[3]) if $n > 2;  # prereq title body
+       return @tokens;
 }
 
 # main contains high-level functionality for processing command-line switches,