t: extract chainlint's parser into shared module
Move chainlint.pl's Lexer, ShellParser, and ScriptParser into a shared module (lib-shell-parser.pl) so other lint tools can reuse the same shell parsing infrastructure. A subsequent commit adds greplint.pl, which needs the same tokenizer to correctly identify command boundaries. ScriptParser's check_test() becomes a no-op in the shared module. chainlint.pl defines ChainlintParser (extending ScriptParser) with the &&-chain check_test() implementation. No functional change: chainlint produces the same output and check-chainlint self-tests pass. Signed-off-by: Michael Montalbo <mmontalbo@gmail.com> Signed-off-by: Junio C Hamano <gitster@pobox.com>
Michael Montalbo committed
Jul 6, 2026 at 05:01 UTC
c451e96f3f6da47bab881b6b1246417691ce66d4
2 files changed
+543
-517
t/chainlint.pl
+12
-517
@@ -23,458 +23,9 @@ my $jobs = -1;
23
my $show_stats;
24
my $emit_all;
25
26
-# Lexer tokenizes POSIX shell scripts. It is roughly modeled after section 2.3
27
-# "Token Recognition" of POSIX chapter 2 "Shell Command Language". Although
28
-# similar to lexical analyzers for other languages, this one differs in a few
29
-# substantial ways due to quirks of the shell command language.
30
-#
31
-# For instance, in many languages, newline is just whitespace like space or
32
-# TAB, but in shell a newline is a command separator, thus a distinct lexical
33
-# token. A newline is significant and returned as a distinct token even at the
34
-# end of a shell comment.
35
-#
36
-# In other languages, `1+2` would typically be scanned as three tokens
37
-# (`1`, `+`, and `2`), but in shell it is a single token. However, the similar
38
-# `1 + 2`, which embeds whitepace, is scanned as three token in shell, as well.
39
-# In shell, several characters with special meaning lose that meaning when not
40
-# surrounded by whitespace. For instance, the negation operator `!` is special
41
-# when standing alone surrounded by whitespace; whereas in `foo!uucp` it is
42
-# just a plain character in the longer token "foo!uucp". In many other
43
-# languages, `"string"/foo:'string'` might be scanned as five tokens ("string",
44
-# `/`, `foo`, `:`, and 'string'), but in shell, it is just a single token.
45
-#
46
-# The lexical analyzer for the shell command language is also somewhat unusual
47
-# in that it recursively invokes the parser to handle the body of `$(...)`
48
-# expressions which can contain arbitrary shell code. Such expressions may be
49
-# encountered both inside and outside of double-quoted strings.
50
-#
51
-# The lexical analyzer is responsible for consuming shell here-doc bodies which
52
-# extend from the line following a `<<TAG` operator until a line consisting
53
-# solely of `TAG`. Here-doc consumption begins when a newline is encountered.
54
-# It is legal for multiple here-doc `<<TAG` operators to be present on a single
55
-# line, in which case their bodies must be present one following the next, and
56
-# are consumed in the (left-to-right) order the `<<TAG` operators appear on the
57
-# line. A special complication is that the bodies of all here-docs must be
58
-# consumed when the newline is encountered even if the parse context depth has
59
-# changed. For instance, in `cat <<A && x=$(cat <<B &&\n`, bodies of here-docs
60
-# "A" and "B" must be consumed even though "A" was introduced outside the
61
-# recursive parse context in which "B" was introduced and in which the newline
62
-# is encountered.
63
-package Lexer;
64
-
65
-sub new {
66
- my ($class, $parser, $s) = @_;
67
- bless {
68
- parser => $parser,
69
- buff => $s,
70
- lineno => 1,
71
- heretags => []
72
- } => $class;
73
-}
74
-
75
-sub scan_heredoc_tag {
76
- my $self = shift @_;
77
- ${$self->{buff}} =~ /\G(-?)/gc;
78
- my $indented = $1;
79
- my $token = $self->scan_token();
80
- return "<<$indented" unless $token;
81
- my $tag = $token->[0];
82
- $tag =~ s/['"\\]//g;
83
- $$token[0] = $indented ? "\t$tag" : "$tag";
84
- push(@{$self->{heretags}}, $token);
85
- return "<<$indented$tag";
86
-}
87
-
88
-sub scan_op {
89
- my ($self, $c) = @_;
90
- my $b = $self->{buff};
91
- return $c unless $$b =~ /\G(.)/sgc;
92
- my $cc = $c . $1;
93
- return scan_heredoc_tag($self) if $cc eq '<<';
94
- return $cc if $cc =~ /^(?:&&|\|\||>>|;;|<&|>&|<>|>\|)$/;
95
- pos($$b)--;
96
- return $c;
97
-}
98
-
99
-sub scan_sqstring {
100
- my $self = shift @_;
101
- ${$self->{buff}} =~ /\G([^']*'|.*\z)/sgc;
102
- my $s = $1;
103
- $self->{lineno} += () = $s =~ /\n/sg;
104
- return "'" . $s;
105
-}
106
-
107
-sub scan_dqstring {
108
- my $self = shift @_;
109
- my $b = $self->{buff};
110
- my $s = '"';
111
- while (1) {
112
- # slurp up non-special characters
113
- $s .= $1 if $$b =~ /\G([^"\$\\]+)/gc;
114
- # handle special characters
115
- last unless $$b =~ /\G(.)/sgc;
116
- my $c = $1;
117
- $s .= '"', last if $c eq '"';
118
- $s .= '$' . $self->scan_dollar(), next if $c eq '$';
119
- if ($c eq '\\') {
120
- $s .= '\\', last unless $$b =~ /\G(.)/sgc;
121
- $c = $1;
122
- $self->{lineno}++, next if $c eq "\n"; # line splice
123
- # backslash escapes only $, `, ", \ in dq-string
124
- $s .= '\\' unless $c =~ /^[\$`"\\]$/;
125
- $s .= $c;
126
- next;
127
- }
128
- die("internal error scanning dq-string '$c'\n");
129
- }
130
- $self->{lineno} += () = $s =~ /\n/sg;
131
- return $s;
132
-}
133
-
134
-sub scan_balanced {
135
- my ($self, $c1, $c2) = @_;
136
- my $b = $self->{buff};
137
- my $depth = 1;
138
- my $s = $c1;
139
- while ($$b =~ /\G([^\Q$c1$c2\E]*(?:[\Q$c1$c2\E]|\z))/gc) {
140
- $s .= $1;
141
- $depth++, next if $s =~ /\Q$c1\E$/;
142
- $depth--;
143
- last if $depth == 0;
144
- }
145
- $self->{lineno} += () = $s =~ /\n/sg;
146
- return $s;
147
-}
148
-
149
-sub scan_subst {
150
- my $self = shift @_;
151
- my @tokens = $self->{parser}->parse(qr/^\)$/);
152
- $self->{parser}->next_token(); # closing ")"
153
- return @tokens;
154
-}
155
-
156
-sub scan_dollar {
157
- my $self = shift @_;
158
- my $b = $self->{buff};
159
- return $self->scan_balanced('(', ')') if $$b =~ /\G\((?=\()/gc; # $((...))
160
- return '(' . join(' ', map {$_->[0]} $self->scan_subst()) . ')' if $$b =~ /\G\(/gc; # $(...)
161
- return $self->scan_balanced('{', '}') if $$b =~ /\G\{/gc; # ${...}
162
- return $1 if $$b =~ /\G(\w+)/gc; # $var
163
- return $1 if $$b =~ /\G([@*#?$!0-9-])/gc; # $*, $1, $$, etc.
164
- return '';
165
-}
166
-
167
-sub swallow_heredocs {
168
- my $self = shift @_;
169
- my $b = $self->{buff};
170
- my $tags = $self->{heretags};
171
- while (my $tag = shift @$tags) {
172
- my $start = pos($$b);
173
- my $indent = $$tag[0] =~ s/^\t// ? '\\s*' : '';
174
- $$b =~ /(?:\G|\n)$indent\Q$$tag[0]\E(?:\n|\z)/gc;
175
- if (pos($$b) > $start) {
176
- my $body = substr($$b, $start, pos($$b) - $start);
177
- $self->{parser}->{heredocs}->{$$tag[0]} = {
178
- content => substr($body, 0, length($body) - length($&)),
179
- start_line => $self->{lineno},
180
- };
181
- $self->{lineno} += () = $body =~ /\n/sg;
182
- next;
183
- }
184
- push(@{$self->{parser}->{problems}}, ['HEREDOC', $tag]);
185
- $$b =~ /(?:\G|\n).*\z/gc; # consume rest of input
186
- my $body = substr($$b, $start, pos($$b) - $start);
187
- $self->{lineno} += () = $body =~ /\n/sg;
188
- last;
189
- }
190
-}
191
-
192
-sub scan_token {
193
- my $self = shift @_;
194
- my $b = $self->{buff};
195
- my $token = '';
196
- my ($start, $startln);
197
-RESTART:
198
- $startln = $self->{lineno};
199
- $$b =~ /\G[ \t]+/gc; # skip whitespace (but not newline)
200
- $start = pos($$b) || 0;
201
- $self->{lineno}++, return ["\n", $start, pos($$b), $startln, $startln] if $$b =~ /\G#[^\n]*(?:\n|\z)/gc; # comment
202
- while (1) {
203
- # slurp up non-special characters
204
- $token .= $1 if $$b =~ /\G([^\\;&|<>(){}'"\$\s]+)/gc;
205
- # handle special characters
206
- last unless $$b =~ /\G(.)/sgc;
207
- my $c = $1;
208
- pos($$b)--, last if $c =~ /^[ \t]$/; # whitespace ends token
209
- pos($$b)--, last if length($token) && $c =~ /^[;&|<>(){}\n]$/;
210
- $token .= $self->scan_sqstring(), next if $c eq "'";
211
- $token .= $self->scan_dqstring(), next if $c eq '"';
212
- $token .= $c . $self->scan_dollar(), next if $c eq '$';
213
- $self->{lineno}++, $self->swallow_heredocs(), $token = $c, last if $c eq "\n";
214
- $token = $self->scan_op($c), last if $c =~ /^[;&|<>]$/;
215
- $token = $c, last if $c =~ /^[(){}]$/;
216
- if ($c eq '\\') {
217
- $token .= '\\', last unless $$b =~ /\G(.)/sgc;
218
- $c = $1;
219
- $self->{lineno}++, next if $c eq "\n" && length($token); # line splice
220
- $self->{lineno}++, goto RESTART if $c eq "\n"; # line splice
221
- $token .= '\\' . $c;
222
- next;
223
- }
224
- die("internal error scanning character '$c'\n");
225
- }
226
- return length($token) ? [$token, $start, pos($$b), $startln, $self->{lineno}] : undef;
227
-}
228
-
229
-# ShellParser parses POSIX shell scripts (with minor extensions for Bash). It
230
-# is a recursive descent parser very roughly modeled after section 2.10 "Shell
231
-# Grammar" of POSIX chapter 2 "Shell Command Language".
232
-package ShellParser;
233
-
234
-sub new {
235
- my ($class, $s) = @_;
236
- my $self = bless {
237
- buff => [],
238
- stop => [],
239
- output => [],
240
- heredocs => {},
241
- insubshell => 0,
242
- } => $class;
243
- $self->{lexer} = Lexer->new($self, $s);
244
- return $self;
245
-}
246
-
247
-sub next_token {
248
- my $self = shift @_;
249
- return pop(@{$self->{buff}}) if @{$self->{buff}};
250
- return $self->{lexer}->scan_token();
251
-}
252
-
253
-sub untoken {
254
- my $self = shift @_;
255
- push(@{$self->{buff}}, @_);
256
-}
257
-
258
-sub peek {
259
- my $self = shift @_;
260
- my $token = $self->next_token();
261
- return undef unless defined($token);
262
- $self->untoken($token);
263
- return $token;
264
-}
265
-
266
-sub stop_at {
267
- my ($self, $token) = @_;
268
- return 1 unless defined($token);
269
- my $stop = ${$self->{stop}}[-1] if @{$self->{stop}};
270
- return defined($stop) && $token->[0] =~ $stop;
271
-}
272
-
273
-sub expect {
274
- my ($self, $expect) = @_;
275
- my $token = $self->next_token();
276
- return $token if defined($token) && $token->[0] eq $expect;
277
- push(@{$self->{output}}, "?!ERR?! expected '$expect' but found '" . (defined($token) ? $token->[0] : "<end-of-input>") . "'\n");
278
- $self->untoken($token) if defined($token);
279
- return ();
280
-}
281
-
282
-sub optional_newlines {
283
- my $self = shift @_;
284
- my @tokens;
285
- while (my $token = $self->peek()) {
286
- last unless $token->[0] eq "\n";
287
- push(@tokens, $self->next_token());
288
- }
289
- return @tokens;
290
-}
291
-
292
-sub parse_group {
293
- my $self = shift @_;
294
- return ($self->parse(qr/^}$/),
295
- $self->expect('}'));
296
-}
297
-
298
-sub parse_subshell {
299
- my $self = shift @_;
300
- $self->{insubshell}++;
301
- my @tokens = ($self->parse(qr/^\)$/),
302
- $self->expect(')'));
303
- $self->{insubshell}--;
304
- return @tokens;
305
-}
306
-
307
-sub parse_case_pattern {
308
- my $self = shift @_;
309
- my @tokens;
310
- while (defined(my $token = $self->next_token())) {
311
- push(@tokens, $token);
312
- last if $token->[0] eq ')';
313
- }
314
- return @tokens;
315
-}
316
-
317
-sub parse_case {
318
- my $self = shift @_;
319
- my @tokens;
320
- push(@tokens,
321
- $self->next_token(), # subject
322
- $self->optional_newlines(),
323
- $self->expect('in'),
324
- $self->optional_newlines());
325
- while (1) {
326
- my $token = $self->peek();
327
- last unless defined($token) && $token->[0] ne 'esac';
328
- push(@tokens,
329
- $self->parse_case_pattern(),
330
- $self->optional_newlines(),
331
- $self->parse(qr/^(?:;;|esac)$/)); # item body
332
- $token = $self->peek();
333
- last unless defined($token) && $token->[0] ne 'esac';
334
- push(@tokens,
335
- $self->expect(';;'),
336
- $self->optional_newlines());
337
- }
338
- push(@tokens, $self->expect('esac'));
339
- return @tokens;
340
-}
341
-
342
-sub parse_for {
343
- my $self = shift @_;
344
- my @tokens;
345
- push(@tokens,
346
- $self->next_token(), # variable
347
- $self->optional_newlines());
348
- my $token = $self->peek();
349
- if (defined($token) && $token->[0] eq 'in') {
350
- push(@tokens,
351
- $self->expect('in'),
352
- $self->optional_newlines());
353
- }
354
- push(@tokens,
355
- $self->parse(qr/^do$/), # items
356
- $self->expect('do'),
357
- $self->optional_newlines(),
358
- $self->parse_loop_body(),
359
- $self->expect('done'));
360
- return @tokens;
361
-}
362
-
363
-sub parse_if {
364
- my $self = shift @_;
365
- my @tokens;
366
- while (1) {
367
- push(@tokens,
368
- $self->parse(qr/^then$/), # if/elif condition
369
- $self->expect('then'),
370
- $self->optional_newlines(),
371
- $self->parse(qr/^(?:elif|else|fi)$/)); # if/elif body
372
- my $token = $self->peek();
373
- last unless defined($token) && $token->[0] eq 'elif';
374
- push(@tokens, $self->expect('elif'));
375
- }
376
- my $token = $self->peek();
377
- if (defined($token) && $token->[0] eq 'else') {
378
- push(@tokens,
379
- $self->expect('else'),
380
- $self->optional_newlines(),
381
- $self->parse(qr/^fi$/)); # else body
382
- }
383
- push(@tokens, $self->expect('fi'));
384
- return @tokens;
385
-}
386
-
387
-sub parse_loop_body {
388
- my $self = shift @_;
389
- return $self->parse(qr/^done$/);
390
-}
391
-
392
-sub parse_loop {
393
- my $self = shift @_;
394
- return ($self->parse(qr/^do$/), # condition
395
- $self->expect('do'),
396
- $self->optional_newlines(),
397
- $self->parse_loop_body(),
398
- $self->expect('done'));
399
-}
400
-
401
-sub parse_func {
402
- my $self = shift @_;
403
- return ($self->expect('('),
404
- $self->expect(')'),
405
- $self->optional_newlines(),
406
- $self->parse_cmd()); # body
407
-}
408
-
409
-sub parse_bash_array_assignment {
410
- my $self = shift @_;
411
- my @tokens = $self->expect('(');
412
- while (defined(my $token = $self->next_token())) {
413
- push(@tokens, $token);
414
- last if $token->[0] eq ')';
415
- }
416
- return @tokens;
417
-}
418
-
419
-my %compound = (
420
- '{' => \&parse_group,
421
- '(' => \&parse_subshell,
422
- 'case' => \&parse_case,
423
- 'for' => \&parse_for,
424
- 'if' => \&parse_if,
425
- 'until' => \&parse_loop,
426
- 'while' => \&parse_loop);
427
-
428
-sub parse_cmd {
429
- my $self = shift @_;
430
- my $cmd = $self->next_token();
431
- return () unless defined($cmd);
432
- return $cmd if $cmd->[0] eq "\n";
433
-
434
- my $token;
435
- my @tokens = $cmd;
436
- if ($cmd->[0] eq '!') {
437
- push(@tokens, $self->parse_cmd());
438
- return @tokens;
439
- } elsif (my $f = $compound{$cmd->[0]}) {
440
- push(@tokens, $self->$f());
441
- } elsif (defined($token = $self->peek()) && $token->[0] eq '(') {
442
- if ($cmd->[0] !~ /\w=$/) {
443
- push(@tokens, $self->parse_func());
444
- return @tokens;
445
- }
446
- my @array = $self->parse_bash_array_assignment();
447
- $tokens[-1]->[0] .= join(' ', map {$_->[0]} @array);
448
- $tokens[-1]->[2] = $array[$#array][2] if @array;
449
- }
450
-
451
- while (defined(my $token = $self->next_token())) {
452
- $self->untoken($token), last if $self->stop_at($token);
453
- push(@tokens, $token);
454
- last if $token->[0] =~ /^(?:[;&\n|]|&&|\|\|)$/;
455
- }
456
- push(@tokens, $self->next_token()) if $tokens[-1]->[0] ne "\n" && defined($token = $self->peek()) && $token->[0] eq "\n";
457
- return @tokens;
458
-}
459
-
460
-sub accumulate {
461
- my ($self, $tokens, $cmd) = @_;
462
- push(@$tokens, @$cmd);
463
-}
464
-
465
-sub parse {
466
- my ($self, $stop) = @_;
467
- push(@{$self->{stop}}, $stop);
468
- goto DONE if $self->stop_at($self->peek());
469
- my @tokens;
470
- while (my @cmd = $self->parse_cmd()) {
471
- $self->accumulate(\@tokens, \@cmd);
472
- last if $self->stop_at($self->peek());
473
- }
474
-DONE:
475
- pop(@{$self->{stop}});
476
- return @tokens;
477
-}
26
+use File::Basename;
27
+do(dirname($0) . "/lib-shell-parser.pl")
28
+ or die "$0: failed to load lib-shell-parser.pl: $@$!\n";
29
30
# TestParser is a subclass of ShellParser which, beyond parsing shell script
31
# code, is also imbued with semantic knowledge of test construction, and checks
@@ -482,9 +33,10 @@ DONE:
33
# the tests themselves or in behaviors being exercised by the tests. As such,
34
# TestParser is only called upon to parse test bodies, not the top-level
35
# scripts in which the tests are defined.
36
+
37
package TestParser;
38
487
-use base 'ShellParser';
39
+our @ISA = ('ShellParser');
40
41
sub new {
42
my $class = shift @_;
@@ -578,51 +130,10 @@ DONE:
130
$self->SUPER::accumulate($tokens, $cmd);
131
}
132
581
-# ScriptParser is a subclass of ShellParser which identifies individual test
582
-# definitions within test scripts, and passes each test body through TestParser
583
-# to identify possible problems. ShellParser detects test definitions not only
584
-# at the top-level of test scripts but also within compound commands such as
585
-# loops and function definitions.
586
-package ScriptParser;
587
-
588
-use base 'ShellParser';
589
-
590
-sub new {
591
- my $class = shift @_;
592
- my $self = $class->SUPER::new(@_);
593
- $self->{ntests} = 0;
594
- $self->{nerrs} = 0;
595
- return $self;
596
-}
133
+# ChainlintParser extends ScriptParser with &&-chain checking
134
+package ChainlintParser;
135
598
-# extract the raw content of a token, which may be a single string or a
599
-# composition of multiple strings and non-string character runs; for instance,
600
-# `"test body"` unwraps to `test body`; `word"a b"42'c d'` to `worda b42c d`
601
-sub unwrap {
602
- my $token = (@_ ? shift @_ : $_)->[0];
603
- # simple case: 'sqstring' or "dqstring"
604
- return $token if $token =~ s/^'([^']*)'$/$1/;
605
- return $token if $token =~ s/^"([^"]*)"$/$1/;
606
-
607
- # composite case
608
- my ($s, $q, $escaped);
609
- while (1) {
610
- # slurp up non-special characters
611
- $s .= $1 if $token =~ /\G([^\\'"]*)/gc;
612
- # handle special characters
613
- last unless $token =~ /\G(.)/sgc;
614
- my $c = $1;
615
- $q = undef, next if defined($q) && $c eq $q;
616
- $q = $c, next if !defined($q) && $c =~ /^['"]$/;
617
- if ($c eq '\\') {
618
- last unless $token =~ /\G(.)/sgc;
619
- $c = $1;
620
- $s .= '\\' if $c eq "\n"; # preserve line splice
621
- }
622
- $s .= $c;
623
- }
624
- return $s
625
-}
136
+our @ISA = ('ScriptParser');
137
138
sub format_problem {
139
local $_ = shift;
@@ -635,10 +146,10 @@ sub format_problem {
146
147
sub check_test {
148
my $self = shift @_;
638
- my $title = unwrap(shift @_);
149
+ my $title = ScriptParser::unwrap(shift @_);
150
my $body = shift @_;
151
my $lineno = $body->[3];
641
- $body = unwrap($body);
152
+ $body = ScriptParser::unwrap($body);
153
if ($body eq '-') {
154
my $herebody = shift @_;
155
$body = $herebody->{content};
@@ -673,24 +184,8 @@ sub check_test {
184
push(@{$self->{output}}, "$c->{blue}# chainlint: $title$c->{reset}\n$checked");
185
}
186
676
-sub parse_cmd {
677
- my $self = shift @_;
678
- my @tokens = $self->SUPER::parse_cmd();
679
- return @tokens unless @tokens && $tokens[0]->[0] =~ /^test_expect_(?:success|failure)$/;
680
- my $n = $#tokens;
681
- $n-- while $n >= 0 && $tokens[$n]->[0] =~ /^(?:[;&\n|]|&&|\|\|)$/;
682
- my $herebody;
683
- if ($n >= 2 && $tokens[$n-1]->[0] eq '-' && $tokens[$n]->[0] =~ /^<<-?(.+)$/) {
684
- $herebody = $self->{heredocs}->{$1};
685
- $n--;
686
- }
687
- $self->check_test($tokens[1], $tokens[2], $herebody) if $n == 2; # title body
688
- $self->check_test($tokens[2], $tokens[3], $herebody) if $n > 2; # prereq title body
689
- return @tokens;
690
-}
691
-
187
# main contains high-level functionality for processing command-line switches,
693
-# feeding input test scripts to ScriptParser, and reporting results.
188
+# feeding input test scripts to ChainlintParser, and reporting results.
189
package main;
190
191
my $getnow = sub { return time(); };
@@ -803,7 +298,7 @@ sub check_script {
298
}
299
my $s = do { local $/; <$fh> };
300
close($fh);
806
- my $parser = ScriptParser->new(\$s);
301
+ my $parser = ChainlintParser->new(\$s);
302
1 while $parser->parse_cmd();
303
if (@{$parser->{output}}) {
304
my $c = fd_colors(1);
t/lib-shell-parser.pl
new
+531
@@ -0,0 +1,531 @@
1
+# Copyright (c) 2021-2022 Eric Sunshine <sunshine@sunshineco.com>
2
+#
3
+# Shared shell script parser for test lint tools. Provides Lexer,
4
+# ShellParser, and ScriptParser. Subclass ScriptParser and override
5
+# check_test() to implement lint checks.
6
+
7
+use strict;
8
+use warnings;
9
+
10
+# Lexer tokenizes POSIX shell scripts. It is roughly modeled after section 2.3
11
+# "Token Recognition" of POSIX chapter 2 "Shell Command Language". Although
12
+# similar to lexical analyzers for other languages, this one differs in a few
13
+# substantial ways due to quirks of the shell command language.
14
+#
15
+# For instance, in many languages, newline is just whitespace like space or
16
+# TAB, but in shell a newline is a command separator, thus a distinct lexical
17
+# token. A newline is significant and returned as a distinct token even at the
18
+# end of a shell comment.
19
+#
20
+# In other languages, `1+2` would typically be scanned as three tokens
21
+# (`1`, `+`, and `2`), but in shell it is a single token. However, the similar
22
+# `1 + 2`, which embeds whitespace, is scanned as three token in shell, as well.
23
+# In shell, several characters with special meaning lose that meaning when not
24
+# surrounded by whitespace. For instance, the negation operator `!` is special
25
+# when standing alone surrounded by whitespace; whereas in `foo!uucp` it is
26
+# just a plain character in the longer token "foo!uucp". In many other
27
+# languages, `"string"/foo:'string'` might be scanned as five tokens ("string",
28
+# `/`, `foo`, `:`, and 'string'), but in shell, it is just a single token.
29
+#
30
+# The lexical analyzer for the shell command language is also somewhat unusual
31
+# in that it recursively invokes the parser to handle the body of `$(...)`
32
+# expressions which can contain arbitrary shell code. Such expressions may be
33
+# encountered both inside and outside of double-quoted strings.
34
+#
35
+# The lexical analyzer is responsible for consuming shell here-doc bodies which
36
+# extend from the line following a `<<TAG` operator until a line consisting
37
+# solely of `TAG`. Here-doc consumption begins when a newline is encountered.
38
+# It is legal for multiple here-doc `<<TAG` operators to be present on a single
39
+# line, in which case their bodies must be present one following the next, and
40
+# are consumed in the (left-to-right) order the `<<TAG` operators appear on the
41
+# line. A special complication is that the bodies of all here-docs must be
42
+# consumed when the newline is encountered even if the parse context depth has
43
+# changed. For instance, in `cat <<A && x=$(cat <<B &&\n`, bodies of here-docs
44
+# "A" and "B" must be consumed even though "A" was introduced outside the
45
+# recursive parse context in which "B" was introduced and in which the newline
46
+# is encountered.
47
+package Lexer;
48
+
49
+sub new {
50
+ my ($class, $parser, $s) = @_;
51
+ bless {
52
+ parser => $parser,
53
+ buff => $s,
54
+ lineno => 1,
55
+ heretags => []
56
+ } => $class;
57
+}
58
+
59
+sub scan_heredoc_tag {
60
+ my $self = shift @_;
61
+ ${$self->{buff}} =~ /\G(-?)/gc;
62
+ my $indented = $1;
63
+ my $token = $self->scan_token();
64
+ return "<<$indented" unless $token;
65
+ my $tag = $token->[0];
66
+ $tag =~ s/['"\\]//g;
67
+ $$token[0] = $indented ? "\t$tag" : "$tag";
68
+ push(@{$self->{heretags}}, $token);
69
+ return "<<$indented$tag";
70
+}
71
+
72
+sub scan_op {
73
+ my ($self, $c) = @_;
74
+ my $b = $self->{buff};
75
+ return $c unless $$b =~ /\G(.)/sgc;
76
+ my $cc = $c . $1;
77
+ return scan_heredoc_tag($self) if $cc eq '<<';
78
+ return $cc if $cc =~ /^(?:&&|\|\||>>|;;|<&|>&|<>|>\|)$/;
79
+ pos($$b)--;
80
+ return $c;
81
+}
82
+
83
+sub scan_sqstring {
84
+ my $self = shift @_;
85
+ ${$self->{buff}} =~ /\G([^']*'|.*\z)/sgc;
86
+ my $s = $1;
87
+ $self->{lineno} += () = $s =~ /\n/sg;
88
+ return "'" . $s;
89
+}
90
+
91
+sub scan_dqstring {
92
+ my $self = shift @_;
93
+ my $b = $self->{buff};
94
+ my $s = '"';
95
+ while (1) {
96
+ # slurp up non-special characters
97
+ $s .= $1 if $$b =~ /\G([^"\$\\]+)/gc;
98
+ # handle special characters
99
+ last unless $$b =~ /\G(.)/sgc;
100
+ my $c = $1;
101
+ $s .= '"', last if $c eq '"';
102
+ $s .= '$' . $self->scan_dollar(), next if $c eq '$';
103
+ if ($c eq '\\') {
104
+ $s .= '\\', last unless $$b =~ /\G(.)/sgc;
105
+ $c = $1;
106
+ $self->{lineno}++, next if $c eq "\n"; # line splice
107
+ # backslash escapes only $, `, ", \ in dq-string
108
+ $s .= '\\' unless $c =~ /^[\$`"\\]$/;
109
+ $s .= $c;
110
+ next;
111
+ }
112
+ die("internal error scanning dq-string '$c'\n");
113
+ }
114
+ $self->{lineno} += () = $s =~ /\n/sg;
115
+ return $s;
116
+}
117
+
118
+sub scan_balanced {
119
+ my ($self, $c1, $c2) = @_;
120
+ my $b = $self->{buff};
121
+ my $depth = 1;
122
+ my $s = $c1;
123
+ while ($$b =~ /\G([^\Q$c1$c2\E]*(?:[\Q$c1$c2\E]|\z))/gc) {
124
+ $s .= $1;
125
+ $depth++, next if $s =~ /\Q$c1\E$/;
126
+ $depth--;
127
+ last if $depth == 0;
128
+ }
129
+ $self->{lineno} += () = $s =~ /\n/sg;
130
+ return $s;
131
+}
132
+
133
+sub scan_subst {
134
+ my $self = shift @_;
135
+ my @tokens = $self->{parser}->parse(qr/^\)$/);
136
+ $self->{parser}->next_token(); # closing ")"
137
+ return @tokens;
138
+}
139
+
140
+sub scan_dollar {
141
+ my $self = shift @_;
142
+ my $b = $self->{buff};
143
+ return $self->scan_balanced('(', ')') if $$b =~ /\G\((?=\()/gc; # $((...))
144
+ return '(' . join(' ', map {$_->[0]} $self->scan_subst()) . ')' if $$b =~ /\G\(/gc; # $(...)
145
+ return $self->scan_balanced('{', '}') if $$b =~ /\G\{/gc; # ${...}
146
+ return $1 if $$b =~ /\G(\w+)/gc; # $var
147
+ return $1 if $$b =~ /\G([@*#?$!0-9-])/gc; # $*, $1, $$, etc.
148
+ return '';
149
+}
150
+
151
+sub swallow_heredocs {
152
+ my $self = shift @_;
153
+ my $b = $self->{buff};
154
+ my $tags = $self->{heretags};
155
+ while (my $tag = shift @$tags) {
156
+ my $start = pos($$b);
157
+ my $indent = $$tag[0] =~ s/^\t// ? '\\s*' : '';
158
+ $$b =~ /(?:\G|\n)$indent\Q$$tag[0]\E(?:\n|\z)/gc;
159
+ if (pos($$b) > $start) {
160
+ my $body = substr($$b, $start, pos($$b) - $start);
161
+ $self->{parser}->{heredocs}->{$$tag[0]} = {
162
+ content => substr($body, 0, length($body) - length($&)),
163
+ start_line => $self->{lineno},
164
+ };
165
+ $self->{lineno} += () = $body =~ /\n/sg;
166
+ next;
167
+ }
168
+ push(@{$self->{parser}->{problems}}, ['HEREDOC', $tag]);
169
+ $$b =~ /(?:\G|\n).*\z/gc; # consume rest of input
170
+ my $body = substr($$b, $start, pos($$b) - $start);
171
+ $self->{lineno} += () = $body =~ /\n/sg;
172
+ last;
173
+ }
174
+}
175
+
176
+sub scan_token {
177
+ my $self = shift @_;
178
+ my $b = $self->{buff};
179
+ my $token = '';
180
+ my ($start, $startln);
181
+RESTART:
182
+ $startln = $self->{lineno};
183
+ $$b =~ /\G[ \t]+/gc; # skip whitespace (but not newline)
184
+ $start = pos($$b) || 0;
185
+ $self->{lineno}++, return ["\n", $start, pos($$b), $startln, $startln] if $$b =~ /\G#[^\n]*(?:\n|\z)/gc; # comment
186
+ while (1) {
187
+ # slurp up non-special characters
188
+ $token .= $1 if $$b =~ /\G([^\\;&|<>(){}'"\$\s]+)/gc;
189
+ # handle special characters
190
+ last unless $$b =~ /\G(.)/sgc;
191
+ my $c = $1;
192
+ pos($$b)--, last if $c =~ /^[ \t]$/; # whitespace ends token
193
+ pos($$b)--, last if length($token) && $c =~ /^[;&|<>(){}\n]$/;
194
+ $token .= $self->scan_sqstring(), next if $c eq "'";
195
+ $token .= $self->scan_dqstring(), next if $c eq '"';
196
+ $token .= $c . $self->scan_dollar(), next if $c eq '$';
197
+ $self->{lineno}++, $self->swallow_heredocs(), $token = $c, last if $c eq "\n";
198
+ $token = $self->scan_op($c), last if $c =~ /^[;&|<>]$/;
199
+ $token = $c, last if $c =~ /^[(){}]$/;
200
+ if ($c eq '\\') {
201
+ $token .= '\\', last unless $$b =~ /\G(.)/sgc;
202
+ $c = $1;
203
+ $self->{lineno}++, next if $c eq "\n" && length($token); # line splice
204
+ $self->{lineno}++, goto RESTART if $c eq "\n"; # line splice
205
+ $token .= '\\' . $c;
206
+ next;
207
+ }
208
+ die("internal error scanning character '$c'\n");
209
+ }
210
+ return length($token) ? [$token, $start, pos($$b), $startln, $self->{lineno}] : undef;
211
+}
212
+
213
+# ShellParser parses POSIX shell scripts (with minor extensions for Bash). It
214
+# is a recursive descent parser very roughly modeled after section 2.10 "Shell
215
+# Grammar" of POSIX chapter 2 "Shell Command Language".
216
+
217
+package ShellParser;
218
+
219
+sub new {
220
+ my ($class, $s) = @_;
221
+ my $self = bless {
222
+ buff => [],
223
+ stop => [],
224
+ output => [],
225
+ heredocs => {},
226
+ insubshell => 0,
227
+ } => $class;
228
+ $self->{lexer} = Lexer->new($self, $s);
229
+ return $self;
230
+}
231
+
232
+sub next_token {
233
+ my $self = shift @_;
234
+ return pop(@{$self->{buff}}) if @{$self->{buff}};
235
+ return $self->{lexer}->scan_token();
236
+}
237
+
238
+sub untoken {
239
+ my $self = shift @_;
240
+ push(@{$self->{buff}}, @_);
241
+}
242
+
243
+sub peek {
244
+ my $self = shift @_;
245
+ my $token = $self->next_token();
246
+ return undef unless defined($token);
247
+ $self->untoken($token);
248
+ return $token;
249
+}
250
+
251
+sub stop_at {
252
+ my ($self, $token) = @_;
253
+ return 1 unless defined($token);
254
+ my $stop = ${$self->{stop}}[-1] if @{$self->{stop}};
255
+ return defined($stop) && $token->[0] =~ $stop;
256
+}
257
+
258
+sub expect {
259
+ my ($self, $expect) = @_;
260
+ my $token = $self->next_token();
261
+ return $token if defined($token) && $token->[0] eq $expect;
262
+ push(@{$self->{output}}, "?!ERR?! expected '$expect' but found '" . (defined($token) ? $token->[0] : "<end-of-input>") . "'\n");
263
+ $self->untoken($token) if defined($token);
264
+ return ();
265
+}
266
+
267
+sub optional_newlines {
268
+ my $self = shift @_;
269
+ my @tokens;
270
+ while (my $token = $self->peek()) {
271
+ last unless $token->[0] eq "\n";
272
+ push(@tokens, $self->next_token());
273
+ }
274
+ return @tokens;
275
+}
276
+
277
+sub parse_group {
278
+ my $self = shift @_;
279
+ return ($self->parse(qr/^}$/),
280
+ $self->expect('}'));
281
+}
282
+
283
+sub parse_subshell {
284
+ my $self = shift @_;
285
+ $self->{insubshell}++;
286
+ my @tokens = ($self->parse(qr/^\)$/),
287
+ $self->expect(')'));
288
+ $self->{insubshell}--;
289
+ return @tokens;
290
+}
291
+
292
+sub parse_case_pattern {
293
+ my $self = shift @_;
294
+ my @tokens;
295
+ while (defined(my $token = $self->next_token())) {
296
+ push(@tokens, $token);
297
+ last if $token->[0] eq ')';
298
+ }
299
+ return @tokens;
300
+}
301
+
302
+sub parse_case {
303
+ my $self = shift @_;
304
+ my @tokens;
305
+ push(@tokens,
306
+ $self->next_token(), # subject
307
+ $self->optional_newlines(),
308
+ $self->expect('in'),
309
+ $self->optional_newlines());
310
+ while (1) {
311
+ my $token = $self->peek();
312
+ last unless defined($token) && $token->[0] ne 'esac';
313
+ push(@tokens,
314
+ $self->parse_case_pattern(),
315
+ $self->optional_newlines(),
316
+ $self->parse(qr/^(?:;;|esac)$/)); # item body
317
+ $token = $self->peek();
318
+ last unless defined($token) && $token->[0] ne 'esac';
319
+ push(@tokens,
320
+ $self->expect(';;'),
321
+ $self->optional_newlines());
322
+ }
323
+ push(@tokens, $self->expect('esac'));
324
+ return @tokens;
325
+}
326
+
327
+sub parse_for {
328
+ my $self = shift @_;
329
+ my @tokens;
330
+ push(@tokens,
331
+ $self->next_token(), # variable
332
+ $self->optional_newlines());
333
+ my $token = $self->peek();
334
+ if (defined($token) && $token->[0] eq 'in') {
335
+ push(@tokens,
336
+ $self->expect('in'),
337
+ $self->optional_newlines());
338
+ }
339
+ push(@tokens,
340
+ $self->parse(qr/^do$/), # items
341
+ $self->expect('do'),
342
+ $self->optional_newlines(),
343
+ $self->parse_loop_body(),
344
+ $self->expect('done'));
345
+ return @tokens;
346
+}
347
+
348
+sub parse_if {
349
+ my $self = shift @_;
350
+ my @tokens;
351
+ while (1) {
352
+ push(@tokens,
353
+ $self->parse(qr/^then$/), # if/elif condition
354
+ $self->expect('then'),
355
+ $self->optional_newlines(),
356
+ $self->parse(qr/^(?:elif|else|fi)$/)); # if/elif body
357
+ my $token = $self->peek();
358
+ last unless defined($token) && $token->[0] eq 'elif';
359
+ push(@tokens, $self->expect('elif'));
360
+ }
361
+ my $token = $self->peek();
362
+ if (defined($token) && $token->[0] eq 'else') {
363
+ push(@tokens,
364
+ $self->expect('else'),
365
+ $self->optional_newlines(),
366
+ $self->parse(qr/^fi$/)); # else body
367
+ }
368
+ push(@tokens, $self->expect('fi'));
369
+ return @tokens;
370
+}
371
+
372
+sub parse_loop_body {
373
+ my $self = shift @_;
374
+ return $self->parse(qr/^done$/);
375
+}
376
+
377
+sub parse_loop {
378
+ my $self = shift @_;
379
+ return ($self->parse(qr/^do$/), # condition
380
+ $self->expect('do'),
381
+ $self->optional_newlines(),
382
+ $self->parse_loop_body(),
383
+ $self->expect('done'));
384
+}
385
+
386
+sub parse_func {
387
+ my $self = shift @_;
388
+ return ($self->expect('('),
389
+ $self->expect(')'),
390
+ $self->optional_newlines(),
391
+ $self->parse_cmd()); # body
392
+}
393
+
394
+sub parse_bash_array_assignment {
395
+ my $self = shift @_;
396
+ my @tokens = $self->expect('(');
397
+ while (defined(my $token = $self->next_token())) {
398
+ push(@tokens, $token);
399
+ last if $token->[0] eq ')';
400
+ }
401
+ return @tokens;
402
+}
403
+
404
+my %compound = (
405
+ '{' => \&parse_group,
406
+ '(' => \&parse_subshell,
407
+ 'case' => \&parse_case,
408
+ 'for' => \&parse_for,
409
+ 'if' => \&parse_if,
410
+ 'until' => \&parse_loop,
411
+ 'while' => \&parse_loop);
412
+
413
+sub parse_cmd {
414
+ my $self = shift @_;
415
+ my $cmd = $self->next_token();
416
+ return () unless defined($cmd);
417
+ return $cmd if $cmd->[0] eq "\n";
418
+
419
+ my $token;
420
+ my @tokens = $cmd;
421
+ if ($cmd->[0] eq '!') {
422
+ push(@tokens, $self->parse_cmd());
423
+ return @tokens;
424
+ } elsif (my $f = $compound{$cmd->[0]}) {
425
+ push(@tokens, $self->$f());
426
+ } elsif (defined($token = $self->peek()) && $token->[0] eq '(') {
427
+ if ($cmd->[0] !~ /\w=$/) {
428
+ push(@tokens, $self->parse_func());
429
+ return @tokens;
430
+ }
431
+ my @array = $self->parse_bash_array_assignment();
432
+ $tokens[-1]->[0] .= join(' ', map {$_->[0]} @array);
433
+ $tokens[-1]->[2] = $array[$#array][2] if @array;
434
+ }
435
+
436
+ while (defined(my $token = $self->next_token())) {
437
+ $self->untoken($token), last if $self->stop_at($token);
438
+ push(@tokens, $token);
439
+ last if $token->[0] =~ /^(?:[;&\n|]|&&|\|\|)$/;
440
+ }
441
+ push(@tokens, $self->next_token()) if $tokens[-1]->[0] ne "\n" && defined($token = $self->peek()) && $token->[0] eq "\n";
442
+ return @tokens;
443
+}
444
+
445
+sub accumulate {
446
+ my ($self, $tokens, $cmd) = @_;
447
+ push(@$tokens, @$cmd);
448
+}
449
+
450
+sub parse {
451
+ my ($self, $stop) = @_;
452
+ push(@{$self->{stop}}, $stop);
453
+ goto DONE if $self->stop_at($self->peek());
454
+ my @tokens;
455
+ while (my @cmd = $self->parse_cmd()) {
456
+ $self->accumulate(\@tokens, \@cmd);
457
+ last if $self->stop_at($self->peek());
458
+ }
459
+DONE:
460
+ pop(@{$self->{stop}});
461
+ return @tokens;
462
+}
463
+
464
+# ScriptParser is a subclass of ShellParser which identifies individual test
465
+# definitions within test scripts and passes each test body to check_test().
466
+# ScriptParser detects test definitions not only at the top-level of test
467
+# scripts but also within compound commands such as loops and function
468
+# definitions.
469
+
470
+package ScriptParser;
471
+
472
+our @ISA = ('ShellParser');
473
+
474
+sub new {
475
+ my $class = shift @_;
476
+ my $self = $class->SUPER::new(@_);
477
+ $self->{ntests} = 0;
478
+ $self->{nerrs} = 0;
479
+ return $self;
480
+}
481
+
482
+# extract the raw content of a token, which may be a single string or a
483
+# composition of multiple strings and non-string character runs; for instance,
484
+# `"test body"` unwraps to `test body`; `word"a b"42'c d'` to `worda b42c d`
485
+sub unwrap {
486
+ my $token = (@_ ? shift @_ : $_)->[0];
487
+ # simple case: 'sqstring' or "dqstring"
488
+ return $token if $token =~ s/^'([^']*)'$/$1/;
489
+ return $token if $token =~ s/^"([^"]*)"$/$1/;
490
+
491
+ # composite case
492
+ my ($s, $q, $escaped);
493
+ while (1) {
494
+ # slurp up non-special characters
495
+ $s .= $1 if $token =~ /\G([^\\'"]*)/gc;
496
+ # handle special characters
497
+ last unless $token =~ /\G(.)/sgc;
498
+ my $c = $1;
499
+ $q = undef, next if defined($q) && $c eq $q;
500
+ $q = $c, next if !defined($q) && $c =~ /^['"]$/;
501
+ if ($c eq '\\') {
502
+ last unless $token =~ /\G(.)/sgc;
503
+ $c = $1;
504
+ $s .= '\\' if $c eq "\n"; # preserve line splice
505
+ }
506
+ $s .= $c;
507
+ }
508
+ return $s
509
+}
510
+
511
+sub check_test {
512
+ # no-op; subclass and override to implement lint checks
513
+}
514
+
515
+sub parse_cmd {
516
+ my $self = shift @_;
517
+ my @tokens = $self->SUPER::parse_cmd();
518
+ return @tokens unless @tokens && $tokens[0]->[0] =~ /^test_expect_(?:success|failure)$/;
519
+ my $n = $#tokens;
520
+ $n-- while $n >= 0 && $tokens[$n]->[0] =~ /^(?:[;&\n|]|&&|\|\|)$/;
521
+ my $herebody;
522
+ if ($n >= 2 && $tokens[$n-1]->[0] eq '-' && $tokens[$n]->[0] =~ /^<<-?(.+)$/) {
523
+ $herebody = $self->{heredocs}->{$1};
524
+ $n--;
525
+ }
526
+ $self->check_test($tokens[1], $tokens[2], $herebody) if $n == 2; # title body
527
+ $self->check_test($tokens[2], $tokens[3], $herebody) if $n > 2; # prereq title body
528
+ return @tokens;
529
+}
530
+
531
+1;