diff options
Diffstat (limited to 't/chainlint.pl')
-rwxr-xr-x | t/chainlint.pl | 171 |
1 files changed, 112 insertions, 59 deletions
diff --git a/t/chainlint.pl b/t/chainlint.pl index 976db4b8a0..4e47e808d0 100755 --- a/t/chainlint.pl +++ b/t/chainlint.pl @@ -67,6 +67,7 @@ sub new { bless { parser => $parser, buff => $s, + lineno => 1, heretags => [] } => $class; } @@ -75,7 +76,9 @@ sub scan_heredoc_tag { my $self = shift @_; ${$self->{buff}} =~ /\G(-?)/gc; my $indented = $1; - my $tag = $self->scan_token(); + my $token = $self->scan_token(); + return "<<$indented" unless $token; + my $tag = $token->[0]; $tag =~ s/['"\\]//g; push(@{$self->{heretags}}, $indented ? "\t$tag" : "$tag"); return "<<$indented$tag"; @@ -95,7 +98,9 @@ sub scan_op { sub scan_sqstring { my $self = shift @_; ${$self->{buff}} =~ /\G([^']*'|.*\z)/sgc; - return "'" . $1; + my $s = $1; + $self->{lineno} += () = $s =~ /\n/sg; + return "'" . $s; } sub scan_dqstring { @@ -113,7 +118,7 @@ sub scan_dqstring { if ($c eq '\\') { $s .= '\\', last unless $$b =~ /\G(.)/sgc; $c = $1; - next if $c eq "\n"; # line splice + $self->{lineno}++, next if $c eq "\n"; # line splice # backslash escapes only $, `, ", \ in dq-string $s .= '\\' unless $c =~ /^[\$`"\\]$/; $s .= $c; @@ -121,6 +126,7 @@ sub scan_dqstring { } die("internal error scanning dq-string '$c'\n"); } + $self->{lineno} += () = $s =~ /\n/sg; return $s; } @@ -135,6 +141,7 @@ sub scan_balanced { $depth--; last if $depth == 0; } + $self->{lineno} += () = $s =~ /\n/sg; return $s; } @@ -149,7 +156,7 @@ 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 '(' . join(' ', map {$_->[0]} $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. @@ -161,8 +168,11 @@ sub swallow_heredocs { my $b = $self->{buff}; my $tags = $self->{heretags}; while (my $tag = shift @$tags) { + my $start = pos($$b); my $indent = $tag =~ s/^\t// ? '\\s*' : ''; $$b =~ /(?:\G|\n)$indent\Q$tag\E(?:\n|\z)/gc; + my $body = substr($$b, $start, pos($$b) - $start); + $self->{lineno} += () = $body =~ /\n/sg; } } @@ -170,34 +180,37 @@ sub scan_token { my $self = shift @_; my $b = $self->{buff}; my $token = ''; + my ($start, $startln); RESTART: + $startln = $self->{lineno}; $$b =~ /\G[ \t]+/gc; # skip whitespace (but not newline) - return "\n" if $$b =~ /\G#[^\n]*(?:\n|\z)/gc; # comment + $start = pos($$b) || 0; + $self->{lineno}++, return ["\n", $start, pos($$b), $startln, $startln] 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 $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"; + $self->{lineno}++, $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 + $self->{lineno}++, next if $c eq "\n" && length($token); # line splice + $self->{lineno}++, goto RESTART if $c eq "\n"; # line splice $token .= '\\' . $c; next; } die("internal error scanning character '$c'\n"); } - return length($token) ? $token : undef; + return length($token) ? [$token, $start, pos($$b), $startln, $self->{lineno}] : undef; } # ShellParser parses POSIX shell scripts (with minor extensions for Bash). It @@ -239,14 +252,14 @@ sub stop_at { my ($self, $token) = @_; return 1 unless defined($token); my $stop = ${$self->{stop}}[-1] if @{$self->{stop}}; - return defined($stop) && $token =~ $stop; + return defined($stop) && $token->[0] =~ $stop; } sub expect { my ($self, $expect) = @_; my $token = $self->next_token(); - return $token if defined($token) && $token eq $expect; - push(@{$self->{output}}, "?!ERR?! expected '$expect' but found '" . (defined($token) ? $token : "<end-of-input>") . "'\n"); + return $token if defined($token) && $token->[0] eq $expect; + push(@{$self->{output}}, "?!ERR?! expected '$expect' but found '" . (defined($token) ? $token->[0] : "<end-of-input>") . "'\n"); $self->untoken($token) if defined($token); return (); } @@ -255,7 +268,7 @@ sub optional_newlines { my $self = shift @_; my @tokens; while (my $token = $self->peek()) { - last unless $token eq "\n"; + last unless $token->[0] eq "\n"; push(@tokens, $self->next_token()); } return @tokens; @@ -278,7 +291,7 @@ sub parse_case_pattern { my @tokens; while (defined(my $token = $self->next_token())) { push(@tokens, $token); - last if $token eq ')'; + last if $token->[0] eq ')'; } return @tokens; } @@ -293,13 +306,13 @@ sub parse_case { $self->optional_newlines()); while (1) { my $token = $self->peek(); - last unless defined($token) && $token ne 'esac'; + last unless defined($token) && $token->[0] ne 'esac'; push(@tokens, $self->parse_case_pattern(), $self->optional_newlines(), $self->parse(qr/^(?:;;|esac)$/)); # item body $token = $self->peek(); - last unless defined($token) && $token ne 'esac'; + last unless defined($token) && $token->[0] ne 'esac'; push(@tokens, $self->expect(';;'), $self->optional_newlines()); @@ -315,7 +328,7 @@ sub parse_for { $self->next_token(), # variable $self->optional_newlines()); my $token = $self->peek(); - if (defined($token) && $token eq 'in') { + if (defined($token) && $token->[0] eq 'in') { push(@tokens, $self->expect('in'), $self->optional_newlines()); @@ -339,11 +352,11 @@ sub parse_if { $self->optional_newlines(), $self->parse(qr/^(?:elif|else|fi)$/)); # if/elif body my $token = $self->peek(); - last unless defined($token) && $token eq 'elif'; + last unless defined($token) && $token->[0] eq 'elif'; push(@tokens, $self->expect('elif')); } my $token = $self->peek(); - if (defined($token) && $token eq 'else') { + if (defined($token) && $token->[0] eq 'else') { push(@tokens, $self->expect('else'), $self->optional_newlines(), @@ -380,7 +393,7 @@ sub parse_bash_array_assignment { my @tokens = $self->expect('('); while (defined(my $token = $self->next_token())) { push(@tokens, $token); - last if $token eq ')'; + last if $token->[0] eq ')'; } return @tokens; } @@ -398,29 +411,31 @@ sub parse_cmd { my $self = shift @_; my $cmd = $self->next_token(); return () unless defined($cmd); - return $cmd if $cmd eq "\n"; + return $cmd if $cmd->[0] eq "\n"; my $token; my @tokens = $cmd; - if ($cmd eq '!') { + if ($cmd->[0] eq '!') { push(@tokens, $self->parse_cmd()); return @tokens; - } elsif (my $f = $compound{$cmd}) { + } elsif (my $f = $compound{$cmd->[0]}) { push(@tokens, $self->$f()); - } elsif (defined($token = $self->peek()) && $token eq '(') { - if ($cmd !~ /\w=$/) { + } elsif (defined($token = $self->peek()) && $token->[0] eq '(') { + if ($cmd->[0] !~ /\w=$/) { push(@tokens, $self->parse_func()); return @tokens; } - $tokens[-1] .= join(' ', $self->parse_bash_array_assignment()); + my @array = $self->parse_bash_array_assignment(); + $tokens[-1]->[0] .= join(' ', map {$_->[0]} @array); + $tokens[-1]->[2] = $array[$#array][2] if @array; } while (defined(my $token = $self->next_token())) { $self->untoken($token), last if $self->stop_at($token); push(@tokens, $token); - last if $token =~ /^(?:[;&\n|]|&&|\|\|)$/; + last if $token->[0] =~ /^(?:[;&\n|]|&&|\|\|)$/; } - push(@tokens, $self->next_token()) if $tokens[-1] ne "\n" && defined($token = $self->peek()) && $token eq "\n"; + push(@tokens, $self->next_token()) if $tokens[-1]->[0] ne "\n" && defined($token = $self->peek()) && $token->[0] eq "\n"; return @tokens; } @@ -453,11 +468,18 @@ package TestParser; use base 'ShellParser'; +sub new { + my $class = shift @_; + my $self = $class->SUPER::new(@_); + $self->{problems} = []; + return $self; +} + sub find_non_nl { my $tokens = shift @_; my $n = shift @_; $n = $#$tokens if !defined($n); - $n-- while $n >= 0 && $$tokens[$n] eq "\n"; + $n-- while $n >= 0 && $$tokens[$n]->[0] eq "\n"; return $n; } @@ -467,7 +489,7 @@ sub ends_with { for my $needle (reverse(@$needles)) { return undef if $n < 0; $n = find_non_nl($tokens, $n), next if $needle eq "\n"; - return undef if $$tokens[$n] !~ $needle; + return undef if $$tokens[$n]->[0] !~ $needle; $n--; } return 1; @@ -486,13 +508,13 @@ sub parse_loop_body { my $self = shift @_; my @tokens = $self->SUPER::parse_loop_body(@_); # did loop signal failure via "|| return" or "|| exit"? - return @tokens if !@tokens || grep(/^(?:return|exit|\$\?)$/, @tokens); + return @tokens if !@tokens || grep {$_->[0] =~ /^(?:return|exit|\$\?)$/} @tokens; # did loop upstream of a pipe signal failure via "|| echo 'impossible # text'" as the final command in the loop body? return @tokens if ends_with(\@tokens, [qr/^\|\|$/, "\n", qr/^echo$/, qr/^.+$/]); # flag missing "return/exit" handling explicit failure in loop body my $n = find_non_nl(\@tokens); - splice(@tokens, $n + 1, 0, '?!LOOP?!'); + push(@{$self->{problems}}, ['LOOP', $tokens[$n]]); return @tokens; } @@ -505,8 +527,13 @@ my @safe_endings = ( sub accumulate { my ($self, $tokens, $cmd) = @_; + my $problems = $self->{problems}; + + # no previous command to check for missing "&&" goto DONE unless @$tokens; - goto DONE if @$cmd == 1 && $$cmd[0] eq "\n"; + + # new command is empty line; can't yet check if previous is missing "&&" + goto DONE if @$cmd == 1 && $$cmd[0]->[0] eq "\n"; # did previous command end with "&&", "|", "|| return" or similar? goto DONE if match_ending($tokens, \@safe_endings); @@ -514,20 +541,20 @@ sub accumulate { # if this command handles "$?" specially, then okay for previous # command to be missing "&&" for my $token (@$cmd) { - goto DONE if $token =~ /\$\?/; + goto DONE if $token->[0] =~ /\$\?/; } # if this command is "false", "return 1", or "exit 1" (which signal # failure explicitly), then okay for all preceding commands to be # missing "&&" - if ($$cmd[0] =~ /^(?:false|return|exit)$/) { - @$tokens = grep(!/^\?!AMP\?!$/, @$tokens); + if ($$cmd[0]->[0] =~ /^(?:false|return|exit)$/) { + @$problems = grep {$_->[0] ne 'AMP'} @$problems; goto DONE; } # flag missing "&&" at end of previous command my $n = find_non_nl($tokens); - splice(@$tokens, $n + 1, 0, '?!AMP?!') unless $n < 0; + push(@$problems, ['AMP', $tokens->[$n]]) unless $n < 0; DONE: $self->SUPER::accumulate($tokens, $cmd); @@ -553,7 +580,7 @@ sub new { # 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 @_ : $_; + my $token = (@_ ? shift @_ : $_)->[0]; # simple case: 'sqstring' or "dqstring" return $token if $token =~ s/^'([^']*)'$/$1/; return $token if $token =~ s/^"([^"]*)"$/$1/; @@ -584,13 +611,25 @@ sub check_test { $self->{ntests}++; my $parser = TestParser->new(\$body); my @tokens = $parser->parse(); - return unless $emit_all || grep(/\?![^?]+\?!/, @tokens); + my $problems = $parser->{problems}; + return unless $emit_all || @$problems; my $c = main::fd_colors(1); - my $checked = join(' ', @tokens); - $checked =~ s/^\n//; - $checked =~ s/^ //mg; - $checked =~ s/ $//mg; + my $lineno = $_[1]->[3]; + my $start = 0; + my $checked = ''; + for (sort {$a->[1]->[2] <=> $b->[1]->[2]} @$problems) { + my ($label, $token) = @$_; + my $pos = $token->[2]; + $checked .= substr($body, $start, $pos - $start) . " ?!$label?! "; + $start = $pos; + } + $checked .= substr($body, $start); + $checked =~ s/^/$lineno++ . ' '/mge; + $checked =~ s/^\d+ \n//; + $checked =~ s/(\s) \?!/$1?!/mg; + $checked =~ s/\?! (\s)/?!$1/mg; $checked =~ s/(\?![^?]+\?!)/$c->{rev}$c->{red}$1$c->{reset}/mg; + $checked =~ s/^\d+/$c->{dim}$&$c->{reset}/mg; $checked .= "\n" unless $checked =~ /\n$/; push(@{$self->{output}}, "$c->{blue}# chainlint: $title$c->{reset}\n$checked"); } @@ -598,9 +637,9 @@ sub check_test { sub parse_cmd { my $self = shift @_; my @tokens = $self->SUPER::parse_cmd(); - return @tokens unless @tokens && $tokens[0] =~ /^test_expect_(?:success|failure)$/; + return @tokens unless @tokens && $tokens[0]->[0] =~ /^test_expect_(?:success|failure)$/; my $n = $#tokens; - $n-- while $n >= 0 && $tokens[$n] =~ /^(?:[;&\n|]|&&|\|\|)$/; + $n-- while $n >= 0 && $tokens[$n]->[0] =~ /^(?:[;&\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; @@ -622,25 +661,39 @@ if (eval {require Time::HiRes; Time::HiRes->import(); 1;}) { # thread and ignore %ENV changes in subthreads. $ENV{TERM} = $ENV{USER_TERM} if $ENV{USER_TERM}; -my @NOCOLORS = (bold => '', rev => '', reset => '', blue => '', green => '', red => ''); +my @NOCOLORS = (bold => '', rev => '', dim => '', reset => '', blue => '', green => '', red => ''); my %COLORS = (); sub get_colors { return \%COLORS if %COLORS; - if (exists($ENV{NO_COLOR}) || - system("tput sgr0 >/dev/null 2>&1") != 0 || - system("tput bold >/dev/null 2>&1") != 0 || - system("tput rev >/dev/null 2>&1") != 0 || - system("tput setaf 1 >/dev/null 2>&1") != 0) { + if (exists($ENV{NO_COLOR})) { %COLORS = @NOCOLORS; return \%COLORS; } - %COLORS = (bold => `tput bold`, - rev => `tput rev`, - reset => `tput sgr0`, - blue => `tput setaf 4`, - green => `tput setaf 2`, - red => `tput setaf 1`); - chomp(%COLORS); + if ($ENV{TERM} =~ /xterm|xterm-\d+color|xterm-new|xterm-direct|nsterm|nsterm-\d+color|nsterm-direct/) { + %COLORS = (bold => "\e[1m", + rev => "\e[7m", + dim => "\e[2m", + reset => "\e[0m", + blue => "\e[34m", + green => "\e[32m", + red => "\e[31m"); + return \%COLORS; + } + if (system("tput sgr0 >/dev/null 2>&1") == 0 && + system("tput bold >/dev/null 2>&1") == 0 && + system("tput rev >/dev/null 2>&1") == 0 && + system("tput dim >/dev/null 2>&1") == 0 && + system("tput setaf 1 >/dev/null 2>&1") == 0) { + %COLORS = (bold => `tput bold`, + rev => `tput rev`, + dim => `tput dim`, + reset => `tput sgr0`, + blue => `tput setaf 4`, + green => `tput setaf 2`, + red => `tput setaf 1`); + return \%COLORS; + } + %COLORS = @NOCOLORS; return \%COLORS; } |