| 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 whitepaces, 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 non-special characters; count newlines here because |
| 97 | # newlines inside $() are already counted by the recursive parse. |
| 98 | if ($$b =~ /\G([^"\$\\]+)/gc) { |
| 99 | $s .= $1; |
| 100 | $self->{lineno} += $1 =~ tr/\n//; |
| 101 | } |
| 102 | # handle special characters |
| 103 | last unless $$b =~ /\G(.)/sgc; |
| 104 | my $c = $1; |
| 105 | $s .= '"', last if $c eq '"'; |
| 106 | $s .= '$' . $self->scan_dollar(), next if $c eq '$'; |
| 107 | if ($c eq '\\') { |
| 108 | $s .= '\\', last unless $$b =~ /\G(.)/sgc; |
| 109 | $c = $1; |
| 110 | $self->{lineno}++, next if $c eq "\n"; # line splice |
| 111 | # backslash escapes only $, `, ", \ in dq-string |
| 112 | $s .= '\\' unless $c =~ /^[\$`"\\]$/; |
| 113 | $s .= $c; |
| 114 | next; |
| 115 | } |
| 116 | die("internal error scanning dq-string '$c'\n"); |
| 117 | } |
| 118 | return $s; |
| 119 | } |
| 120 | |
| 121 | sub scan_balanced { |
| 122 | my ($self, $c1, $c2) = @_; |
| 123 | my $b = $self->{buff}; |
| 124 | my $depth = 1; |
| 125 | my $s = $c1; |
| 126 | while ($$b =~ /\G([^\Q$c1$c2\E]*(?:[\Q$c1$c2\E]|\z))/gc) { |
| 127 | $s .= $1; |
| 128 | $depth++, next if $s =~ /\Q$c1\E$/; |
| 129 | $depth--; |
| 130 | last if $depth == 0; |
| 131 | } |
| 132 | $self->{lineno} += () = $s =~ /\n/sg; |
| 133 | return $s; |
| 134 | } |
| 135 | |
| 136 | sub scan_subst { |
| 137 | my $self = shift @_; |
| 138 | my @tokens = $self->{parser}->parse(qr/^\)$/); |
| 139 | $self->{parser}->next_token(); # closing ")" |
| 140 | return @tokens; |
| 141 | } |
| 142 | |
| 143 | sub scan_dollar { |
| 144 | my $self = shift @_; |
| 145 | my $b = $self->{buff}; |
| 146 | return $self->scan_balanced('(', ')') if $$b =~ /\G\((?=\()/gc; # $((...)) |
| 147 | return '(' . join(' ', map {$_->[0]} $self->scan_subst()) . ')' if $$b =~ /\G\(/gc; # $(...) |
| 148 | return $self->scan_balanced('{', '}') if $$b =~ /\G\{/gc; # ${...} |
| 149 | return $1 if $$b =~ /\G(\w+)/gc; # $var |
| 150 | return $1 if $$b =~ /\G([@*#?$!0-9-])/gc; # $*, $1, $$, etc. |
| 151 | return ''; |
| 152 | } |
| 153 | |
| 154 | sub swallow_heredocs { |
| 155 | my $self = shift @_; |
| 156 | my $b = $self->{buff}; |
| 157 | my $tags = $self->{heretags}; |
| 158 | while (my $tag = shift @$tags) { |
| 159 | my $start = pos($$b); |
| 160 | my $indent = $$tag[0] =~ s/^\t// ? '\\s*' : ''; |
| 161 | $$b =~ /(?:\G|\n)$indent\Q$$tag[0]\E(?:\n|\z)/gc; |
| 162 | if (pos($$b) > $start) { |
| 163 | my $body = substr($$b, $start, pos($$b) - $start); |
| 164 | $self->{parser}->{heredocs}->{$$tag[0]} = { |
| 165 | content => substr($body, 0, length($body) - length($&)), |
| 166 | start_line => $self->{lineno}, |
| 167 | }; |
| 168 | $self->{lineno} += () = $body =~ /\n/sg; |
| 169 | next; |
| 170 | } |
| 171 | push(@{$self->{parser}->{problems}}, ['HEREDOC', $tag]); |
| 172 | $$b =~ /(?:\G|\n).*\z/gc; # consume rest of input |
| 173 | my $body = substr($$b, $start, pos($$b) - $start); |
| 174 | $self->{lineno} += () = $body =~ /\n/sg; |
| 175 | last; |
| 176 | } |
| 177 | } |
| 178 | |
| 179 | sub scan_token { |
| 180 | my $self = shift @_; |
| 181 | my $b = $self->{buff}; |
| 182 | my $token = ''; |
| 183 | my ($start, $startln); |
| 184 | RESTART: |
| 185 | $startln = $self->{lineno}; |
| 186 | $$b =~ /\G[ \t]+/gc; # skip whitespace (but not newline) |
| 187 | $start = pos($$b) || 0; |
| 188 | $self->{lineno}++, return ["\n", $start, pos($$b), $startln, $startln] if $$b =~ /\G#[^\n]*(?:\n|\z)/gc; # comment |
| 189 | while (1) { |
| 190 | # slurp up non-special characters |
| 191 | $token .= $1 if $$b =~ /\G([^\\;&|<>(){}'"\$\s]+)/gc; |
| 192 | # handle special characters |
| 193 | last unless $$b =~ /\G(.)/sgc; |
| 194 | my $c = $1; |
| 195 | pos($$b)--, last if $c =~ /^[ \t]$/; # whitespace ends token |
| 196 | pos($$b)--, last if length($token) && $c =~ /^[;&|<>(){}\n]$/; |
| 197 | $token .= $self->scan_sqstring(), next if $c eq "'"; |
| 198 | $token .= $self->scan_dqstring(), next if $c eq '"'; |
| 199 | $token .= $c . $self->scan_dollar(), next if $c eq '$'; |
| 200 | $self->{lineno}++, $self->swallow_heredocs(), $token = $c, last if $c eq "\n"; |
| 201 | $token = $self->scan_op($c), last if $c =~ /^[;&|<>]$/; |
| 202 | $token = $c, last if $c =~ /^[(){}]$/; |
| 203 | if ($c eq '\\') { |
| 204 | $token .= '\\', last unless $$b =~ /\G(.)/sgc; |
| 205 | $c = $1; |
| 206 | $self->{lineno}++, next if $c eq "\n" && length($token); # line splice |
| 207 | $self->{lineno}++, goto RESTART if $c eq "\n"; # line splice |
| 208 | $token .= '\\' . $c; |
| 209 | next; |
| 210 | } |
| 211 | die("internal error scanning character '$c'\n"); |
| 212 | } |
| 213 | return length($token) ? [$token, $start, pos($$b), $startln, $self->{lineno}] : undef; |
| 214 | } |
| 215 | |
| 216 | # ShellParser parses POSIX shell scripts (with minor extensions for Bash). It |
| 217 | # is a recursive descent parser very roughly modeled after section 2.10 "Shell |
| 218 | # Grammar" of POSIX chapter 2 "Shell Command Language". |
| 219 | |
| 220 | package ShellParser; |
| 221 | |
| 222 | sub new { |
| 223 | my ($class, $s) = @_; |
| 224 | my $self = bless { |
| 225 | buff => [], |
| 226 | stop => [], |
| 227 | output => [], |
| 228 | heredocs => {}, |
| 229 | insubshell => 0, |
| 230 | } => $class; |
| 231 | $self->{lexer} = Lexer->new($self, $s); |
| 232 | return $self; |
| 233 | } |
| 234 | |
| 235 | sub next_token { |
| 236 | my $self = shift @_; |
| 237 | return pop(@{$self->{buff}}) if @{$self->{buff}}; |
| 238 | return $self->{lexer}->scan_token(); |
| 239 | } |
| 240 | |
| 241 | sub untoken { |
| 242 | my $self = shift @_; |
| 243 | push(@{$self->{buff}}, @_); |
| 244 | } |
| 245 | |
| 246 | sub peek { |
| 247 | my $self = shift @_; |
| 248 | my $token = $self->next_token(); |
| 249 | return undef unless defined($token); |
| 250 | $self->untoken($token); |
| 251 | return $token; |
| 252 | } |
| 253 | |
| 254 | sub stop_at { |
| 255 | my ($self, $token) = @_; |
| 256 | return 1 unless defined($token); |
| 257 | my $stop = ${$self->{stop}}[-1] if @{$self->{stop}}; |
| 258 | return defined($stop) && $token->[0] =~ $stop; |
| 259 | } |
| 260 | |
| 261 | sub expect { |
| 262 | my ($self, $expect) = @_; |
| 263 | my $token = $self->next_token(); |
| 264 | return $token if defined($token) && $token->[0] eq $expect; |
| 265 | push(@{$self->{output}}, "?!ERR?! expected '$expect' but found '" . (defined($token) ? $token->[0] : "<end-of-input>") . "'\n"); |
| 266 | $self->untoken($token) if defined($token); |
| 267 | return (); |
| 268 | } |
| 269 | |
| 270 | sub optional_newlines { |
| 271 | my $self = shift @_; |
| 272 | my @tokens; |
| 273 | while (my $token = $self->peek()) { |
| 274 | last unless $token->[0] eq "\n"; |
| 275 | push(@tokens, $self->next_token()); |
| 276 | } |
| 277 | return @tokens; |
| 278 | } |
| 279 | |
| 280 | sub parse_group { |
| 281 | my $self = shift @_; |
| 282 | return ($self->parse(qr/^}$/), |
| 283 | $self->expect('}')); |
| 284 | } |
| 285 | |
| 286 | sub parse_subshell { |
| 287 | my $self = shift @_; |
| 288 | $self->{insubshell}++; |
| 289 | my @tokens = ($self->parse(qr/^\)$/), |
| 290 | $self->expect(')')); |
| 291 | $self->{insubshell}--; |
| 292 | return @tokens; |
| 293 | } |
| 294 | |
| 295 | sub parse_case_pattern { |
| 296 | my $self = shift @_; |
| 297 | my @tokens; |
| 298 | while (defined(my $token = $self->next_token())) { |
| 299 | push(@tokens, $token); |
| 300 | last if $token->[0] eq ')'; |
| 301 | } |
| 302 | return @tokens; |
| 303 | } |
| 304 | |
| 305 | sub parse_case { |
| 306 | my $self = shift @_; |
| 307 | my @tokens; |
| 308 | push(@tokens, |
| 309 | $self->next_token(), # subject |
| 310 | $self->optional_newlines(), |
| 311 | $self->expect('in'), |
| 312 | $self->optional_newlines()); |
| 313 | while (1) { |
| 314 | my $token = $self->peek(); |
| 315 | last unless defined($token) && $token->[0] ne 'esac'; |
| 316 | push(@tokens, |
| 317 | $self->parse_case_pattern(), |
| 318 | $self->optional_newlines(), |
| 319 | $self->parse(qr/^(?:;;|esac)$/)); # item body |
| 320 | $token = $self->peek(); |
| 321 | last unless defined($token) && $token->[0] ne 'esac'; |
| 322 | push(@tokens, |
| 323 | $self->expect(';;'), |
| 324 | $self->optional_newlines()); |
| 325 | } |
| 326 | push(@tokens, $self->expect('esac')); |
| 327 | return @tokens; |
| 328 | } |
| 329 | |
| 330 | sub parse_for { |
| 331 | my $self = shift @_; |
| 332 | my @tokens; |
| 333 | push(@tokens, |
| 334 | $self->next_token(), # variable |
| 335 | $self->optional_newlines()); |
| 336 | my $token = $self->peek(); |
| 337 | if (defined($token) && $token->[0] eq 'in') { |
| 338 | push(@tokens, |
| 339 | $self->expect('in'), |
| 340 | $self->optional_newlines()); |
| 341 | } |
| 342 | push(@tokens, |
| 343 | $self->parse(qr/^do$/), # items |
| 344 | $self->expect('do'), |
| 345 | $self->optional_newlines(), |
| 346 | $self->parse_loop_body(), |
| 347 | $self->expect('done')); |
| 348 | return @tokens; |
| 349 | } |
| 350 | |
| 351 | sub parse_if { |
| 352 | my $self = shift @_; |
| 353 | my @tokens; |
| 354 | while (1) { |
| 355 | push(@tokens, |
| 356 | $self->parse(qr/^then$/), # if/elif condition |
| 357 | $self->expect('then'), |
| 358 | $self->optional_newlines(), |
| 359 | $self->parse(qr/^(?:elif|else|fi)$/)); # if/elif body |
| 360 | my $token = $self->peek(); |
| 361 | last unless defined($token) && $token->[0] eq 'elif'; |
| 362 | push(@tokens, $self->expect('elif')); |
| 363 | } |
| 364 | my $token = $self->peek(); |
| 365 | if (defined($token) && $token->[0] eq 'else') { |
| 366 | push(@tokens, |
| 367 | $self->expect('else'), |
| 368 | $self->optional_newlines(), |
| 369 | $self->parse(qr/^fi$/)); # else body |
| 370 | } |
| 371 | push(@tokens, $self->expect('fi')); |
| 372 | return @tokens; |
| 373 | } |
| 374 | |
| 375 | sub parse_loop_body { |
| 376 | my $self = shift @_; |
| 377 | return $self->parse(qr/^done$/); |
| 378 | } |
| 379 | |
| 380 | sub parse_loop { |
| 381 | my $self = shift @_; |
| 382 | return ($self->parse(qr/^do$/), # condition |
| 383 | $self->expect('do'), |
| 384 | $self->optional_newlines(), |
| 385 | $self->parse_loop_body(), |
| 386 | $self->expect('done')); |
| 387 | } |
| 388 | |
| 389 | sub parse_func { |
| 390 | my $self = shift @_; |
| 391 | return ($self->expect('('), |
| 392 | $self->expect(')'), |
| 393 | $self->optional_newlines(), |
| 394 | $self->parse_cmd()); # body |
| 395 | } |
| 396 | |
| 397 | sub parse_bash_array_assignment { |
| 398 | my $self = shift @_; |
| 399 | my @tokens = $self->expect('('); |
| 400 | while (defined(my $token = $self->next_token())) { |
| 401 | push(@tokens, $token); |
| 402 | last if $token->[0] eq ')'; |
| 403 | } |
| 404 | return @tokens; |
| 405 | } |
| 406 | |
| 407 | my %compound = ( |
| 408 | '{' => \&parse_group, |
| 409 | '(' => \&parse_subshell, |
| 410 | 'case' => \&parse_case, |
| 411 | 'for' => \&parse_for, |
| 412 | 'if' => \&parse_if, |
| 413 | 'until' => \&parse_loop, |
| 414 | 'while' => \&parse_loop); |
| 415 | |
| 416 | sub parse_cmd { |
| 417 | my $self = shift @_; |
| 418 | my $cmd = $self->next_token(); |
| 419 | return () unless defined($cmd); |
| 420 | return $cmd if $cmd->[0] eq "\n"; |
| 421 | |
| 422 | my $token; |
| 423 | my @tokens = $cmd; |
| 424 | if ($cmd->[0] eq '!') { |
| 425 | push(@tokens, $self->parse_cmd()); |
| 426 | return @tokens; |
| 427 | } elsif (my $f = $compound{$cmd->[0]}) { |
| 428 | push(@tokens, $self->$f()); |
| 429 | } elsif (defined($token = $self->peek()) && $token->[0] eq '(') { |
| 430 | if ($cmd->[0] !~ /\w=$/) { |
| 431 | push(@tokens, $self->parse_func()); |
| 432 | return @tokens; |
| 433 | } |
| 434 | my @array = $self->parse_bash_array_assignment(); |
| 435 | $tokens[-1]->[0] .= join(' ', map {$_->[0]} @array); |
| 436 | $tokens[-1]->[2] = $array[$#array][2] if @array; |
| 437 | } |
| 438 | |
| 439 | while (defined(my $token = $self->next_token())) { |
| 440 | $self->untoken($token), last if $self->stop_at($token); |
| 441 | push(@tokens, $token); |
| 442 | last if $token->[0] =~ /^(?:[;&\n|]|&&|\|\|)$/; |
| 443 | } |
| 444 | push(@tokens, $self->next_token()) if $tokens[-1]->[0] ne "\n" && defined($token = $self->peek()) && $token->[0] eq "\n"; |
| 445 | return @tokens; |
| 446 | } |
| 447 | |
| 448 | sub accumulate { |
| 449 | my ($self, $tokens, $cmd) = @_; |
| 450 | push(@$tokens, @$cmd); |
| 451 | } |
| 452 | |
| 453 | sub parse { |
| 454 | my ($self, $stop) = @_; |
| 455 | push(@{$self->{stop}}, $stop); |
| 456 | goto DONE if $self->stop_at($self->peek()); |
| 457 | my @tokens; |
| 458 | while (my @cmd = $self->parse_cmd()) { |
| 459 | $self->accumulate(\@tokens, \@cmd); |
| 460 | last if $self->stop_at($self->peek()); |
| 461 | } |
| 462 | DONE: |
| 463 | pop(@{$self->{stop}}); |
| 464 | return @tokens; |
| 465 | } |
| 466 | |
| 467 | # ScriptParser is a subclass of ShellParser which identifies individual test |
| 468 | # definitions within test scripts and passes each test body to check_test(). |
| 469 | # ScriptParser detects test definitions not only at the top-level of test |
| 470 | # scripts but also within compound commands such as loops and function |
| 471 | # definitions. |
| 472 | |
| 473 | package ScriptParser; |
| 474 | |
| 475 | our @ISA = ('ShellParser'); |
| 476 | |
| 477 | sub new { |
| 478 | my $class = shift @_; |
| 479 | my $self = $class->SUPER::new(@_); |
| 480 | $self->{ntests} = 0; |
| 481 | $self->{nerrs} = 0; |
| 482 | return $self; |
| 483 | } |
| 484 | |
| 485 | # extract the raw content of a token, which may be a single string or a |
| 486 | # composition of multiple strings and non-string character runs; for instance, |
| 487 | # `"test body"` unwraps to `test body`; `word"a b"42'c d'` to `worda b42c d` |
| 488 | sub unwrap { |
| 489 | my $token = (@_ ? shift @_ : $_)->[0]; |
| 490 | # simple case: 'sqstring' or "dqstring" |
| 491 | return $token if $token =~ s/^'([^']*)'$/$1/; |
| 492 | return $token if $token =~ s/^"([^"]*)"$/$1/; |
| 493 | |
| 494 | # composite case |
| 495 | my ($s, $q, $escaped); |
| 496 | while (1) { |
| 497 | # slurp up non-special characters |
| 498 | $s .= $1 if $token =~ /\G([^\\'"]*)/gc; |
| 499 | # handle special characters |
| 500 | last unless $token =~ /\G(.)/sgc; |
| 501 | my $c = $1; |
| 502 | $q = undef, next if defined($q) && $c eq $q; |
| 503 | $q = $c, next if !defined($q) && $c =~ /^['"]$/; |
| 504 | if ($c eq '\\') { |
| 505 | last unless $token =~ /\G(.)/sgc; |
| 506 | $c = $1; |
| 507 | $s .= '\\' if $c eq "\n"; # preserve line splice |
| 508 | } |
| 509 | $s .= $c; |
| 510 | } |
| 511 | return $s |
| 512 | } |
| 513 | |
| 514 | sub check_test { |
| 515 | # no-op; subclass and override to implement lint checks |
| 516 | } |
| 517 | |
| 518 | sub parse_cmd { |
| 519 | my $self = shift @_; |
| 520 | my @tokens = $self->SUPER::parse_cmd(); |
| 521 | return @tokens unless @tokens && $tokens[0]->[0] =~ /^test_expect_(?:success|failure)$/; |
| 522 | my $n = $#tokens; |
| 523 | $n-- while $n >= 0 && $tokens[$n]->[0] =~ /^(?:[;&\n|]|&&|\|\|)$/; |
| 524 | my $herebody; |
| 525 | if ($n >= 2 && $tokens[$n-1]->[0] eq '-' && $tokens[$n]->[0] =~ /^<<-?(.+)$/) { |
| 526 | $herebody = $self->{heredocs}->{$1}; |
| 527 | $n--; |
| 528 | } |
| 529 | $self->check_test($tokens[1], $tokens[2], $herebody) if $n == 2; # title body |
| 530 | $self->check_test($tokens[2], $tokens[3], $herebody) if $n > 2; # prereq title body |
| 531 | return @tokens; |
| 532 | } |
| 533 | |
| 534 | 1; |