chainlint.pl: add POSIX shell lexical analyzer

Begin fleshing out chainlint.pl by adding a lexical analyzer for the
POSIX shell command language. The sole entry point Lexer::scan_token()
returns the next token from the input. It will be called by the upcoming
shell language parser.

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 e8ab95c7858e95c56514012057bb2f176dee2165..81ffbf28bf3dc5d85fbb0c11bc52435b24840967 100755 (executable)
--- a/t/chainlint.pl
+++ b/t/chainlint.pl
@@ -21,6 +21,183 @@ use Getopt::Long;
 my $show_stats;
 my $emit_all;
 
+# Lexer tokenizes POSIX shell scripts. It is roughly modeled after section 2.3
+# "Token Recognition" of POSIX chapter 2 "Shell Command Language". Although
+# similar to lexical analyzers for other languages, this one differs in a few
+# substantial ways due to quirks of the shell command language.
+#
+# For instance, in many languages, newline is just whitespace like space or
+# TAB, but in shell a newline is a command separator, thus a distinct lexical
+# token. A newline is significant and returned as a distinct token even at the
+# end of a shell comment.
+#
+# In other languages, `1+2` would typically be scanned as three tokens
+# (`1`, `+`, and `2`), but in shell it is a single token. However, the similar
+# `1 + 2`, which embeds whitepace, is scanned as three token in shell, as well.
+# In shell, several characters with special meaning lose that meaning when not
+# surrounded by whitespace. For instance, the negation operator `!` is special
+# when standing alone surrounded by whitespace; whereas in `foo!uucp` it is
+# just a plain character in the longer token "foo!uucp". In many other
+# languages, `"string"/foo:'string'` might be scanned as five tokens ("string",
+# `/`, `foo`, `:`, and 'string'), but in shell, it is just a single token.
+#
+# The lexical analyzer for the shell command language is also somewhat unusual
+# in that it recursively invokes the parser to handle the body of `$(...)`
+# expressions which can contain arbitrary shell code. Such expressions may be
+# encountered both inside and outside of double-quoted strings.
+#
+# The lexical analyzer is responsible for consuming shell here-doc bodies which
+# extend from the line following a `<<TAG` operator until a line consisting
+# solely of `TAG`. Here-doc consumption begins when a newline is encountered.
+# It is legal for multiple here-doc `<<TAG` operators to be present on a single
+# line, in which case their bodies must be present one following the next, and
+# are consumed in the (left-to-right) order the `<<TAG` operators appear on the
+# line. A special complication is that the bodies of all here-docs must be
+# consumed when the newline is encountered even if the parse context depth has
+# changed. For instance, in `cat <<A && x=$(cat <<B &&\n`, bodies of here-docs
+# "A" and "B" must be consumed even though "A" was introduced outside the
+# recursive parse context in which "B" was introduced and in which the newline
+# is encountered.
+package Lexer;
+
+sub new {
+       my ($class, $parser, $s) = @_;
+       bless {
+               parser => $parser,
+               buff => $s,
+               heretags => []
+       } => $class;
+}
+
+sub scan_heredoc_tag {
+       my $self = shift @_;
+       ${$self->{buff}} =~ /\G(-?)/gc;
+       my $indented = $1;
+       my $tag = $self->scan_token();
+       $tag =~ s/['"\\]//g;
+       push(@{$self->{heretags}}, $indented ? "\t$tag" : "$tag");
+       return "<<$indented$tag";
+}
+
+sub scan_op {
+       my ($self, $c) = @_;
+       my $b = $self->{buff};
+       return $c unless $$b =~ /\G(.)/sgc;
+       my $cc = $c . $1;
+       return scan_heredoc_tag($self) if $cc eq '<<';
+       return $cc if $cc =~ /^(?:&&|\|\||>>|;;|<&|>&|<>|>\|)$/;
+       pos($$b)--;
+       return $c;
+}
+
+sub scan_sqstring {
+       my $self = shift @_;
+       ${$self->{buff}} =~ /\G([^']*'|.*\z)/sgc;
+       return "'" . $1;
+}
+
+sub scan_dqstring {
+       my $self = shift @_;
+       my $b = $self->{buff};
+       my $s = '"';
+       while (1) {
+               # slurp up non-special characters
+               $s .= $1 if $$b =~ /\G([^"\$\\]+)/gc;
+               # handle special characters
+               last unless $$b =~ /\G(.)/sgc;
+               my $c = $1;
+               $s .= '"', last if $c eq '"';
+               $s .= '$' . $self->scan_dollar(), next if $c eq '$';
+               if ($c eq '\\') {
+                       $s .= '\\', last unless $$b =~ /\G(.)/sgc;
+                       $c = $1;
+                       next if $c eq "\n"; # line splice
+                       # backslash escapes only $, `, ", \ in dq-string
+                       $s .= '\\' unless $c =~ /^[\$`"\\]$/;
+                       $s .= $c;
+                       next;
+               }
+               die("internal error scanning dq-string '$c'\n");
+       }
+       return $s;
+}
+
+sub scan_balanced {
+       my ($self, $c1, $c2) = @_;
+       my $b = $self->{buff};
+       my $depth = 1;
+       my $s = $c1;
+       while ($$b =~ /\G([^\Q$c1$c2\E]*(?:[\Q$c1$c2\E]|\z))/gc) {
+               $s .= $1;
+               $depth++, next if $s =~ /\Q$c1\E$/;
+               $depth--;
+               last if $depth == 0;
+       }
+       return $s;
+}
+
+sub scan_subst {
+       my $self = shift @_;
+       my @tokens = $self->{parser}->parse(qr/^\)$/);
+       $self->{parser}->next_token(); # closing ")"
+       return @tokens;
+}
+
+sub scan_dollar {
+       my $self = shift @_;
+       my $b = $self->{buff};
+       return $self->scan_balanced('(', ')') if $$b =~ /\G\((?=\()/gc; # $((...))
+       return '(' . join(' ', $self->scan_subst()) . ')' if $$b =~ /\G\(/gc; # $(...)
+       return $self->scan_balanced('{', '}') if $$b =~ /\G\{/gc; # ${...}
+       return $1 if $$b =~ /\G(\w+)/gc; # $var
+       return $1 if $$b =~ /\G([@*#?$!0-9-])/gc; # $*, $1, $$, etc.
+       return '';
+}
+
+sub swallow_heredocs {
+       my $self = shift @_;
+       my $b = $self->{buff};
+       my $tags = $self->{heretags};
+       while (my $tag = shift @$tags) {
+               my $indent = $tag =~ s/^\t// ? '\\s*' : '';
+               $$b =~ /(?:\G|\n)$indent\Q$tag\E(?:\n|\z)/gc;
+       }
+}
+
+sub scan_token {
+       my $self = shift @_;
+       my $b = $self->{buff};
+       my $token = '';
+RESTART:
+       $$b =~ /\G[ \t]+/gc; # skip whitespace (but not newline)
+       return "\n" if $$b =~ /\G#[^\n]*(?:\n|\z)/gc; # comment
+       while (1) {
+               # slurp up non-special characters
+               $token .= $1 if $$b =~ /\G([^\\;&|<>(){}'"\$\s]+)/gc;
+               # handle special characters
+               last unless $$b =~ /\G(.)/sgc;
+               my $c = $1;
+               last if $c =~ /^[ \t]$/; # whitespace ends token
+               pos($$b)--, last if length($token) && $c =~ /^[;&|<>(){}\n]$/;
+               $token .= $self->scan_sqstring(), next if $c eq "'";
+               $token .= $self->scan_dqstring(), next if $c eq '"';
+               $token .= $c . $self->scan_dollar(), next if $c eq '$';
+               $self->swallow_heredocs(), $token = $c, last if $c eq "\n";
+               $token = $self->scan_op($c), last if $c =~ /^[;&|<>]$/;
+               $token = $c, last if $c =~ /^[(){}]$/;
+               if ($c eq '\\') {
+                       $token .= '\\', last unless $$b =~ /\G(.)/sgc;
+                       $c = $1;
+                       next if $c eq "\n" && length($token); # line splice
+                       goto RESTART if $c eq "\n"; # line splice
+                       $token .= '\\' . $c;
+                       next;
+               }
+               die("internal error scanning character '$c'\n");
+       }
+       return length($token) ? $token : undef;
+}
+
 package ScriptParser;
 
 sub new {