chainlint: latch start/end position of each token
When chainlint detects problems in a test, such as a broken &&-chain, it prints out the test with "?!FOO?!" annotations inserted at each problem location. However, rather than annotating the original test definition, it instead dumps out a parsed token representation of the test. Since it lacks comments, indentations, here-doc bodies, and so forth, this tokenized representation can be difficult for the test author to digest and relate back to the original test definition. To address this shortcoming, an upcoming change will make it print out an annotated copy of the original test definition rather than the tokenized representation. In order to do so, it will need to know the start and end positions of each token in the original test definition. As preparation, upgrade TestParser::scan_token() to latch the start and end position of the token being scanned, and return that information along with the token itself. A subsequent change will take advantage of this positional information. In terms of implementation, TestParser::scan_token() is retrofitted to return a tuple consisting of the token's lexeme and its start and end positions, rather than returning just the lexeme. However, an alternative would be to define a class which represents a token: package Token; sub new { my ($class, $lexeme, $start, $end) = @_; bless [$lexeme, $start, $end] => $class; } sub as_string { my $self = shift @_; return $self->[0]; } sub compare { my ($x, $y) = @_; if (UNIVERSAL::isa($y, 'Token')) { return $x->[0] cmp $y->[0]; } return $x->[0] cmp $y; } use overload ( '""' => 'as_string', 'cmp' => 'compare' ); The major benefit of the class-based approach is that it is entirely non-invasive; it requires no additional changes to the rest of the script since a Token converts automatically to a string, which is what scan_token() historically returned. The big downside to the Token approach, however, is that it is _slow_; on this developer's (old) machine, it increases user-time by an unacceptable seven seconds when scanning all test scripts in the project. Hence, the simple tuple approach is employed instead since it adds only a fraction of a second user-time. Signed-off-by: Eric Sunshine <sunshine@sunshineco.com> Signed-off-by: Taylor Blau <me@ttaylorr.com>
Eric Sunshine committed
Nov 8, 2022 at 19:08 UTC
5f0321a9f25bd1366a6f13c2e2b51d6e1e2a5ded
1 file changed
+43
-37
t/chainlint.pl
+43
-37
@@ -75,7 +75,9 @@ sub scan_heredoc_tag {
75
my $self = shift @_;
76
${$self->{buff}} =~ /\G(-?)/gc;
77
my $indented = $1;
78
- my $tag = $self->scan_token();
78
+ my $token = $self->scan_token();
79
+ return "<<$indented" unless $token;
80
+ my $tag = $token->[0];
81
$tag =~ s/['"\\]//g;
82
push(@{$self->{heretags}}, $indented ? "\t$tag" : "$tag");
83
return "<<$indented$tag";
@@ -149,7 +151,7 @@ sub scan_dollar {
151
my $self = shift @_;
152
my $b = $self->{buff};
153
return $self->scan_balanced('(', ')') if $$b =~ /\G\((?=\()/gc; # $((...))
152
- return '(' . join(' ', $self->scan_subst()) . ')' if $$b =~ /\G\(/gc; # $(...)
154
+ return '(' . join(' ', map {$_->[0]} $self->scan_subst()) . ')' if $$b =~ /\G\(/gc; # $(...)
155
return $self->scan_balanced('{', '}') if $$b =~ /\G\{/gc; # ${...}
156
return $1 if $$b =~ /\G(\w+)/gc; # $var
157
return $1 if $$b =~ /\G([@*#?$!0-9-])/gc; # $*, $1, $$, etc.
@@ -170,9 +172,11 @@ sub scan_token {
172
my $self = shift @_;
173
my $b = $self->{buff};
174
my $token = '';
175
+ my $start;
176
RESTART:
177
$$b =~ /\G[ \t]+/gc; # skip whitespace (but not newline)
175
- return "\n" if $$b =~ /\G#[^\n]*(?:\n|\z)/gc; # comment
178
+ $start = pos($$b) || 0;
179
+ return ["\n", $start, pos($$b)] if $$b =~ /\G#[^\n]*(?:\n|\z)/gc; # comment
180
while (1) {
181
# slurp up non-special characters
182
$token .= $1 if $$b =~ /\G([^\\;&|<>(){}'"\$\s]+)/gc;
@@ -197,7 +201,7 @@ RESTART:
201
}
202
die("internal error scanning character '$c'\n");
203
}
200
- return length($token) ? $token : undef;
204
+ return length($token) ? [$token, $start, pos($$b)] : undef;
205
}
206
207
# ShellParser parses POSIX shell scripts (with minor extensions for Bash). It
@@ -239,14 +243,14 @@ sub stop_at {
243
my ($self, $token) = @_;
244
return 1 unless defined($token);
245
my $stop = ${$self->{stop}}[-1] if @{$self->{stop}};
242
- return defined($stop) && $token =~ $stop;
246
+ return defined($stop) && $token->[0] =~ $stop;
247
}
248
249
sub expect {
250
my ($self, $expect) = @_;
251
my $token = $self->next_token();
248
- return $token if defined($token) && $token eq $expect;
249
- push(@{$self->{output}}, "?!ERR?! expected '$expect' but found '" . (defined($token) ? $token : "<end-of-input>") . "'\n");
252
+ return $token if defined($token) && $token->[0] eq $expect;
253
+ push(@{$self->{output}}, "?!ERR?! expected '$expect' but found '" . (defined($token) ? $token->[0] : "<end-of-input>") . "'\n");
254
$self->untoken($token) if defined($token);
255
return ();
256
}
@@ -255,7 +259,7 @@ sub optional_newlines {
259
my $self = shift @_;
260
my @tokens;
261
while (my $token = $self->peek()) {
258
- last unless $token eq "\n";
262
+ last unless $token->[0] eq "\n";
263
push(@tokens, $self->next_token());
264
}
265
return @tokens;
@@ -278,7 +282,7 @@ sub parse_case_pattern {
282
my @tokens;
283
while (defined(my $token = $self->next_token())) {
284
push(@tokens, $token);
281
- last if $token eq ')';
285
+ last if $token->[0] eq ')';
286
}
287
return @tokens;
288
}
@@ -293,13 +297,13 @@ sub parse_case {
297
$self->optional_newlines());
298
while (1) {
299
my $token = $self->peek();
296
- last unless defined($token) && $token ne 'esac';
300
+ last unless defined($token) && $token->[0] ne 'esac';
301
push(@tokens,
302
$self->parse_case_pattern(),
303
$self->optional_newlines(),
304
$self->parse(qr/^(?:;;|esac)$/)); # item body
305
$token = $self->peek();
302
- last unless defined($token) && $token ne 'esac';
306
+ last unless defined($token) && $token->[0] ne 'esac';
307
push(@tokens,
308
$self->expect(';;'),
309
$self->optional_newlines());
@@ -315,7 +319,7 @@ sub parse_for {
319
$self->next_token(), # variable
320
$self->optional_newlines());
321
my $token = $self->peek();
318
- if (defined($token) && $token eq 'in') {
322
+ if (defined($token) && $token->[0] eq 'in') {
323
push(@tokens,
324
$self->expect('in'),
325
$self->optional_newlines());
@@ -339,11 +343,11 @@ sub parse_if {
343
$self->optional_newlines(),
344
$self->parse(qr/^(?:elif|else|fi)$/)); # if/elif body
345
my $token = $self->peek();
342
- last unless defined($token) && $token eq 'elif';
346
+ last unless defined($token) && $token->[0] eq 'elif';
347
push(@tokens, $self->expect('elif'));
348
}
349
my $token = $self->peek();
346
- if (defined($token) && $token eq 'else') {
350
+ if (defined($token) && $token->[0] eq 'else') {
351
push(@tokens,
352
$self->expect('else'),
353
$self->optional_newlines(),
@@ -380,7 +384,7 @@ sub parse_bash_array_assignment {
384
my @tokens = $self->expect('(');
385
while (defined(my $token = $self->next_token())) {
386
push(@tokens, $token);
383
- last if $token eq ')';
387
+ last if $token->[0] eq ')';
388
}
389
return @tokens;
390
}
@@ -398,29 +402,31 @@ sub parse_cmd {
402
my $self = shift @_;
403
my $cmd = $self->next_token();
404
return () unless defined($cmd);
401
- return $cmd if $cmd eq "\n";
405
+ return $cmd if $cmd->[0] eq "\n";
406
407
my $token;
408
my @tokens = $cmd;
405
- if ($cmd eq '!') {
409
+ if ($cmd->[0] eq '!') {
410
push(@tokens, $self->parse_cmd());
411
return @tokens;
408
- } elsif (my $f = $compound{$cmd}) {
412
+ } elsif (my $f = $compound{$cmd->[0]}) {
413
push(@tokens, $self->$f());
410
- } elsif (defined($token = $self->peek()) && $token eq '(') {
411
- if ($cmd !~ /\w=$/) {
414
+ } elsif (defined($token = $self->peek()) && $token->[0] eq '(') {
415
+ if ($cmd->[0] !~ /\w=$/) {
416
push(@tokens, $self->parse_func());
417
return @tokens;
418
}
415
- $tokens[-1] .= join(' ', $self->parse_bash_array_assignment());
419
+ my @array = $self->parse_bash_array_assignment();
420
+ $tokens[-1]->[0] .= join(' ', map {$_->[0]} @array);
421
+ $tokens[-1]->[2] = $array[$#array][2] if @array;
422
}
423
424
while (defined(my $token = $self->next_token())) {
425
$self->untoken($token), last if $self->stop_at($token);
426
push(@tokens, $token);
421
- last if $token =~ /^(?:[;&\n|]|&&|\|\|)$/;
427
+ last if $token->[0] =~ /^(?:[;&\n|]|&&|\|\|)$/;
428
}
423
- push(@tokens, $self->next_token()) if $tokens[-1] ne "\n" && defined($token = $self->peek()) && $token eq "\n";
429
+ push(@tokens, $self->next_token()) if $tokens[-1]->[0] ne "\n" && defined($token = $self->peek()) && $token->[0] eq "\n";
430
return @tokens;
431
}
432
@@ -457,7 +463,7 @@ sub find_non_nl {
463
my $tokens = shift @_;
464
my $n = shift @_;
465
$n = $#$tokens if !defined($n);
460
- $n-- while $n >= 0 && $$tokens[$n] eq "\n";
466
+ $n-- while $n >= 0 && $$tokens[$n]->[0] eq "\n";
467
return $n;
468
}
469
@@ -467,7 +473,7 @@ sub ends_with {
473
for my $needle (reverse(@$needles)) {
474
return undef if $n < 0;
475
$n = find_non_nl($tokens, $n), next if $needle eq "\n";
470
- return undef if $$tokens[$n] !~ $needle;
476
+ return undef if $$tokens[$n]->[0] !~ $needle;
477
$n--;
478
}
479
return 1;
@@ -486,13 +492,13 @@ sub parse_loop_body {
492
my $self = shift @_;
493
my @tokens = $self->SUPER::parse_loop_body(@_);
494
# did loop signal failure via "|| return" or "|| exit"?
489
- return @tokens if !@tokens || grep(/^(?:return|exit|\$\?)$/, @tokens);
495
+ return @tokens if !@tokens || grep {$_->[0] =~ /^(?:return|exit|\$\?)$/} @tokens;
496
# did loop upstream of a pipe signal failure via "|| echo 'impossible
497
# text'" as the final command in the loop body?
498
return @tokens if ends_with(\@tokens, [qr/^\|\|$/, "\n", qr/^echo$/, qr/^.+$/]);
499
# flag missing "return/exit" handling explicit failure in loop body
500
my $n = find_non_nl(\@tokens);
495
- splice(@tokens, $n + 1, 0, '?!LOOP?!');
501
+ splice(@tokens, $n + 1, 0, ['?!LOOP?!', $tokens[$n]->[1], $tokens[$n]->[2]]);
502
return @tokens;
503
}
504
@@ -510,7 +516,7 @@ sub accumulate {
516
goto DONE unless @$tokens;
517
518
# new command is empty line; can't yet check if previous is missing "&&"
513
- goto DONE if @$cmd == 1 && $$cmd[0] eq "\n";
519
+ goto DONE if @$cmd == 1 && $$cmd[0]->[0] eq "\n";
520
521
# did previous command end with "&&", "|", "|| return" or similar?
522
goto DONE if match_ending($tokens, \@safe_endings);
@@ -518,20 +524,20 @@ sub accumulate {
524
# if this command handles "$?" specially, then okay for previous
525
# command to be missing "&&"
526
for my $token (@$cmd) {
521
- goto DONE if $token =~ /\$\?/;
527
+ goto DONE if $token->[0] =~ /\$\?/;
528
}
529
530
# if this command is "false", "return 1", or "exit 1" (which signal
531
# failure explicitly), then okay for all preceding commands to be
532
# missing "&&"
527
- if ($$cmd[0] =~ /^(?:false|return|exit)$/) {
528
- @$tokens = grep(!/^\?!AMP\?!$/, @$tokens);
533
+ if ($$cmd[0]->[0] =~ /^(?:false|return|exit)$/) {
534
+ @$tokens = grep {$_->[0] !~ /^\?!AMP\?!$/} @$tokens;
535
goto DONE;
536
}
537
538
# flag missing "&&" at end of previous command
539
my $n = find_non_nl($tokens);
534
- splice(@$tokens, $n + 1, 0, '?!AMP?!') unless $n < 0;
540
+ splice(@$tokens, $n + 1, 0, ['?!AMP?!', $$tokens[$n]->[1], $$tokens[$n]->[2]]) unless $n < 0;
541
542
DONE:
543
$self->SUPER::accumulate($tokens, $cmd);
@@ -557,7 +563,7 @@ sub new {
563
# composition of multiple strings and non-string character runs; for instance,
564
# `"test body"` unwraps to `test body`; `word"a b"42'c d'` to `worda b42c d`
565
sub unwrap {
560
- my $token = @_ ? shift @_ : $_;
566
+ my $token = (@_ ? shift @_ : $_)->[0];
567
# simple case: 'sqstring' or "dqstring"
568
return $token if $token =~ s/^'([^']*)'$/$1/;
569
return $token if $token =~ s/^"([^"]*)"$/$1/;
@@ -588,9 +594,9 @@ sub check_test {
594
$self->{ntests}++;
595
my $parser = TestParser->new(\$body);
596
my @tokens = $parser->parse();
591
- return unless $emit_all || grep(/\?![^?]+\?!/, @tokens);
597
+ return unless $emit_all || grep {$_->[0] =~ /\?![^?]+\?!/} @tokens;
598
my $c = main::fd_colors(1);
593
- my $checked = join(' ', @tokens);
599
+ my $checked = join(' ', map {$_->[0]} @tokens);
600
$checked =~ s/^\n//;
601
$checked =~ s/^ //mg;
602
$checked =~ s/ $//mg;
@@ -602,9 +608,9 @@ sub check_test {
608
sub parse_cmd {
609
my $self = shift @_;
610
my @tokens = $self->SUPER::parse_cmd();
605
- return @tokens unless @tokens && $tokens[0] =~ /^test_expect_(?:success|failure)$/;
611
+ return @tokens unless @tokens && $tokens[0]->[0] =~ /^test_expect_(?:success|failure)$/;
612
my $n = $#tokens;
607
- $n-- while $n >= 0 && $tokens[$n] =~ /^(?:[;&\n|]|&&|\|\|)$/;
613
+ $n-- while $n >= 0 && $tokens[$n]->[0] =~ /^(?:[;&\n|]|&&|\|\|)$/;
614
$self->check_test($tokens[1], $tokens[2]) if $n == 2; # title body
615
$self->check_test($tokens[2], $tokens[3]) if $n > 2; # prereq title body
616
return @tokens;