bless {
parser => $parser,
buff => $s,
+ lineno => 1,
heretags => []
} => $class;
}
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";
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 {
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;
}
die("internal error scanning dq-string '$c'\n");
}
+ $self->{lineno} += () = $s =~ /\n/sg;
return $s;
}
$depth--;
last if $depth == 0;
}
+ $self->{lineno} += () = $s =~ /\n/sg;
return $s;
}
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.
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;
}
}
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
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 ();
}
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;
my @tokens;
while (defined(my $token = $self->next_token())) {
push(@tokens, $token);
- last if $token eq ')';
+ last if $token->[0] eq ')';
}
return @tokens;
}
$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());
$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());
$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(),
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;
}
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;
}
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;
}
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;
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;
}
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);
# 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);
# 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/;
$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");
}
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;
# 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;
}
projects / thirdparty / git.git / blobdiff