@@ -75,7 +75,9 @@ sub scan_heredoc_tag {
75
75
my $self = shift @_ ;
76
76
${$self -> {buff }} =~ / \G (-?)/gc ;
77
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];
79
81
$tag =~ s / ['"\\ ]// g ;
80
82
push (@{$self -> {heretags }}, $indented ? " \t $tag " : " $tag " );
81
83
return " <<$indented$tag " ;
@@ -149,7 +151,7 @@ sub scan_dollar {
149
151
my $self = shift @_ ;
150
152
my $b = $self -> {buff };
151
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 ; # $(...)
153
155
return $self -> scan_balanced(' {' , ' }' ) if $$b =~ / \G\{ /gc ; # ${...}
154
156
return $1 if $$b =~ / \G (\w +)/gc ; # $var
155
157
return $1 if $$b =~ / \G ([@*#?$!0-9-])/gc ; # $*, $1, $$, etc.
@@ -170,16 +172,18 @@ sub scan_token {
170
172
my $self = shift @_ ;
171
173
my $b = $self -> {buff };
172
174
my $token = ' ' ;
175
+ my $start ;
173
176
RESTART:
174
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
176
180
while (1) {
177
181
# slurp up non-special characters
178
182
$token .= $1 if $$b =~ / \G ([^\\ ;&|<>(){}'"\$\s ]+)/gc ;
179
183
# handle special characters
180
184
last unless $$b =~ / \G (.)/sgc ;
181
185
my $c = $1 ;
182
- last if $c =~ / ^[ \t ]$ / ; # whitespace ends token
186
+ pos ( $$b )--, last if $c =~ / ^[ \t ]$ / ; # whitespace ends token
183
187
pos ($$b )--, last if length ($token ) && $c =~ / ^[;&|<>(){}\n ]$ / ;
184
188
$token .= $self -> scan_sqstring(), next if $c eq " '" ;
185
189
$token .= $self -> scan_dqstring(), next if $c eq ' "' ;
@@ -197,7 +201,7 @@ sub scan_token {
197
201
}
198
202
die (" internal error scanning character '$c '\n " );
199
203
}
200
- return length ($token ) ? $token : undef ;
204
+ return length ($token ) ? [ $token , $start , pos ( $$b )] : undef ;
201
205
}
202
206
203
207
# ShellParser parses POSIX shell scripts (with minor extensions for Bash). It
@@ -239,14 +243,14 @@ sub stop_at {
239
243
my ($self , $token ) = @_ ;
240
244
return 1 unless defined ($token );
241
245
my $stop = ${$self -> {stop }}[-1] if @{$self -> {stop }};
242
- return defined ($stop ) && $token =~ $stop ;
246
+ return defined ($stop ) && $token -> [0] =~ $stop ;
243
247
}
244
248
245
249
sub expect {
246
250
my ($self , $expect ) = @_ ;
247
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 " );
250
254
$self -> untoken($token ) if defined ($token );
251
255
return ();
252
256
}
@@ -255,7 +259,7 @@ sub optional_newlines {
255
259
my $self = shift @_ ;
256
260
my @tokens ;
257
261
while (my $token = $self -> peek()) {
258
- last unless $token eq " \n " ;
262
+ last unless $token -> [0] eq " \n " ;
259
263
push (@tokens , $self -> next_token());
260
264
}
261
265
return @tokens ;
@@ -278,7 +282,7 @@ sub parse_case_pattern {
278
282
my @tokens ;
279
283
while (defined (my $token = $self -> next_token())) {
280
284
push (@tokens , $token );
281
- last if $token eq ' )' ;
285
+ last if $token -> [0] eq ' )' ;
282
286
}
283
287
return @tokens ;
284
288
}
@@ -293,13 +297,13 @@ sub parse_case {
293
297
$self -> optional_newlines());
294
298
while (1) {
295
299
my $token = $self -> peek();
296
- last unless defined ($token ) && $token ne ' esac' ;
300
+ last unless defined ($token ) && $token -> [0] ne ' esac' ;
297
301
push (@tokens ,
298
302
$self -> parse_case_pattern(),
299
303
$self -> optional_newlines(),
300
304
$self -> parse(qr / ^(?:;;|esac)$ / )); # item body
301
305
$token = $self -> peek();
302
- last unless defined ($token ) && $token ne ' esac' ;
306
+ last unless defined ($token ) && $token -> [0] ne ' esac' ;
303
307
push (@tokens ,
304
308
$self -> expect(' ;;' ),
305
309
$self -> optional_newlines());
@@ -315,7 +319,7 @@ sub parse_for {
315
319
$self -> next_token(), # variable
316
320
$self -> optional_newlines());
317
321
my $token = $self -> peek();
318
- if (defined ($token ) && $token eq ' in' ) {
322
+ if (defined ($token ) && $token -> [0] eq ' in' ) {
319
323
push (@tokens ,
320
324
$self -> expect(' in' ),
321
325
$self -> optional_newlines());
@@ -339,11 +343,11 @@ sub parse_if {
339
343
$self -> optional_newlines(),
340
344
$self -> parse(qr / ^(?:elif|else|fi)$ / )); # if/elif body
341
345
my $token = $self -> peek();
342
- last unless defined ($token ) && $token eq ' elif' ;
346
+ last unless defined ($token ) && $token -> [0] eq ' elif' ;
343
347
push (@tokens , $self -> expect(' elif' ));
344
348
}
345
349
my $token = $self -> peek();
346
- if (defined ($token ) && $token eq ' else' ) {
350
+ if (defined ($token ) && $token -> [0] eq ' else' ) {
347
351
push (@tokens ,
348
352
$self -> expect(' else' ),
349
353
$self -> optional_newlines(),
@@ -380,7 +384,7 @@ sub parse_bash_array_assignment {
380
384
my @tokens = $self -> expect(' (' );
381
385
while (defined (my $token = $self -> next_token())) {
382
386
push (@tokens , $token );
383
- last if $token eq ' )' ;
387
+ last if $token -> [0] eq ' )' ;
384
388
}
385
389
return @tokens ;
386
390
}
@@ -398,29 +402,31 @@ sub parse_cmd {
398
402
my $self = shift @_ ;
399
403
my $cmd = $self -> next_token();
400
404
return () unless defined ($cmd );
401
- return $cmd if $cmd eq " \n " ;
405
+ return $cmd if $cmd -> [0] eq " \n " ;
402
406
403
407
my $token ;
404
408
my @tokens = $cmd ;
405
- if ($cmd eq ' !' ) {
409
+ if ($cmd -> [0] eq ' !' ) {
406
410
push (@tokens , $self -> parse_cmd());
407
411
return @tokens ;
408
- } elsif (my $f = $compound {$cmd }) {
412
+ } elsif (my $f = $compound {$cmd -> [0] }) {
409
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 =$ / ) {
412
416
push (@tokens , $self -> parse_func());
413
417
return @tokens ;
414
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 ;
416
422
}
417
423
418
424
while (defined (my $token = $self -> next_token())) {
419
425
$self -> untoken($token ), last if $self -> stop_at($token );
420
426
push (@tokens , $token );
421
- last if $token =~ / ^(?:[;&\n |]|&&|\|\| )$ / ;
427
+ last if $token -> [0] =~ / ^(?:[;&\n |]|&&|\|\| )$ / ;
422
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 " ;
424
430
return @tokens ;
425
431
}
426
432
@@ -453,11 +459,18 @@ package TestParser;
453
459
454
460
use base ' ShellParser' ;
455
461
462
+ sub new {
463
+ my $class = shift @_ ;
464
+ my $self = $class -> SUPER::new(@_ );
465
+ $self -> {problems } = [];
466
+ return $self ;
467
+ }
468
+
456
469
sub find_non_nl {
457
470
my $tokens = shift @_ ;
458
471
my $n = shift @_ ;
459
472
$n = $# $tokens if !defined ($n );
460
- $n -- while $n >= 0 && $$tokens [$n ] eq " \n " ;
473
+ $n -- while $n >= 0 && $$tokens [$n ]-> [0] eq " \n " ;
461
474
return $n ;
462
475
}
463
476
@@ -467,7 +480,7 @@ sub ends_with {
467
480
for my $needle (reverse (@$needles )) {
468
481
return undef if $n < 0;
469
482
$n = find_non_nl($tokens , $n ), next if $needle eq " \n " ;
470
- return undef if $$tokens [$n ] !~ $needle ;
483
+ return undef if $$tokens [$n ]-> [0] !~ $needle ;
471
484
$n --;
472
485
}
473
486
return 1;
@@ -486,13 +499,13 @@ sub parse_loop_body {
486
499
my $self = shift @_ ;
487
500
my @tokens = $self -> SUPER::parse_loop_body(@_ );
488
501
# did loop signal failure via "|| return" or "|| exit"?
489
- return @tokens if !@tokens || grep ( / ^(?:return|exit|\$\? )$ / , @tokens ) ;
502
+ return @tokens if !@tokens || grep { $_ -> [0] =~ / ^(?:return|exit|\$\? )$ / } @tokens ;
490
503
# did loop upstream of a pipe signal failure via "|| echo 'impossible
491
504
# text'" as the final command in the loop body?
492
505
return @tokens if ends_with(\@tokens , [qr / ^\|\| $ / , " \n " , qr / ^echo$ / , qr / ^.+$ / ]);
493
506
# flag missing "return/exit" handling explicit failure in loop body
494
507
my $n = find_non_nl(\@tokens );
495
- splice ( @tokens , $n + 1, 0, ' ?! LOOP?! ' );
508
+ push (@{ $self -> { problems }}, [ ' LOOP' , $tokens [ $n ]] );
496
509
return @tokens ;
497
510
}
498
511
@@ -505,29 +518,34 @@ sub parse_loop_body {
505
518
506
519
sub accumulate {
507
520
my ($self , $tokens , $cmd ) = @_ ;
521
+ my $problems = $self -> {problems };
522
+
523
+ # no previous command to check for missing "&&"
508
524
goto DONE unless @$tokens ;
509
- goto DONE if @$cmd == 1 && $$cmd [0] eq " \n " ;
525
+
526
+ # new command is empty line; can't yet check if previous is missing "&&"
527
+ goto DONE if @$cmd == 1 && $$cmd [0]-> [0] eq " \n " ;
510
528
511
529
# did previous command end with "&&", "|", "|| return" or similar?
512
530
goto DONE if match_ending($tokens , \@safe_endings );
513
531
514
532
# if this command handles "$?" specially, then okay for previous
515
533
# command to be missing "&&"
516
534
for my $token (@$cmd ) {
517
- goto DONE if $token =~ / \$\? / ;
535
+ goto DONE if $token -> [0] =~ / \$\? / ;
518
536
}
519
537
520
538
# if this command is "false", "return 1", or "exit 1" (which signal
521
539
# failure explicitly), then okay for all preceding commands to be
522
540
# missing "&&"
523
- if ($$cmd [0] =~ / ^(?:false|return|exit)$ / ) {
524
- @$tokens = grep (!/^\?!AMP\?! $/ , @$tokens ) ;
541
+ if ($$cmd [0]-> [0] =~ / ^(?:false|return|exit)$ / ) {
542
+ @$problems = grep { $_ -> [0] ne ' AMP ' } @$problems ;
525
543
goto DONE;
526
544
}
527
545
528
546
# flag missing "&&" at end of previous command
529
547
my $n = find_non_nl($tokens );
530
- splice (@$tokens , $n + 1, 0, ' ?! AMP?! ' ) unless $n < 0;
548
+ push (@$problems , [ ' AMP' , $tokens -> [ $n ]] ) unless $n < 0;
531
549
532
550
DONE:
533
551
$self -> SUPER::accumulate($tokens , $cmd );
@@ -553,7 +571,7 @@ sub new {
553
571
# composition of multiple strings and non-string character runs; for instance,
554
572
# `"test body"` unwraps to `test body`; `word"a b"42'c d'` to `worda b42c d`
555
573
sub unwrap {
556
- my $token = @_ ? shift @_ : $_ ;
574
+ my $token = ( @_ ? shift @_ : $_ ) -> [0] ;
557
575
# simple case: 'sqstring' or "dqstring"
558
576
return $token if $token =~ s / ^'([^']*)'$/ $1 / ;
559
577
return $token if $token =~ s / ^"([^"]*)"$/ $1 / ;
@@ -584,12 +602,21 @@ sub check_test {
584
602
$self -> {ntests }++;
585
603
my $parser = TestParser-> new(\$body );
586
604
my @tokens = $parser -> parse();
587
- return unless $emit_all || grep (/ \? ![^?]+\? !/ , @tokens );
605
+ my $problems = $parser -> {problems };
606
+ return unless $emit_all || @$problems ;
588
607
my $c = main::fd_colors(1);
589
- my $checked = join (' ' , @tokens );
608
+ my $start = 0;
609
+ my $checked = ' ' ;
610
+ for (sort {$a -> [1]-> [2] <=> $b -> [1]-> [2]} @$problems ) {
611
+ my ($label , $token ) = @$_ ;
612
+ my $pos = $token -> [2];
613
+ $checked .= substr ($body , $start , $pos - $start ) . " ?!$label ?! " ;
614
+ $start = $pos ;
615
+ }
616
+ $checked .= substr ($body , $start );
590
617
$checked =~ s / ^\n // ;
591
- $checked =~ s /^ / /mg ;
592
- $checked =~ s / $ / /mg ;
618
+ $checked =~ s /( \s ) \? ! / $1 ?! / mg ;
619
+ $checked =~ s /\? ! ( \s ) / ?! $1 / mg ;
593
620
$checked =~ s / (\? ![^?]+\? !)/ $c ->{rev}$c ->{red}$1 $c ->{reset}/ mg ;
594
621
$checked .= " \n " unless $checked =~ / \n $ / ;
595
622
push (@{$self -> {output }}, " $c ->{blue}# chainlint: $title$c ->{reset}\n $checked " );
@@ -598,9 +625,9 @@ sub check_test {
598
625
sub parse_cmd {
599
626
my $self = shift @_ ;
600
627
my @tokens = $self -> SUPER::parse_cmd();
601
- return @tokens unless @tokens && $tokens [0] =~ / ^test_expect_(?:success|failure)$ / ;
628
+ return @tokens unless @tokens && $tokens [0]-> [0] =~ / ^test_expect_(?:success|failure)$ / ;
602
629
my $n = $#tokens ;
603
- $n -- while $n >= 0 && $tokens [$n ] =~ / ^(?:[;&\n |]|&&|\|\| )$ / ;
630
+ $n -- while $n >= 0 && $tokens [$n ]-> [0] =~ / ^(?:[;&\n |]|&&|\|\| )$ / ;
604
631
$self -> check_test($tokens [1], $tokens [2]) if $n == 2; # title body
605
632
$self -> check_test($tokens [2], $tokens [3]) if $n > 2; # prereq title body
606
633
return @tokens ;
0 commit comments