third_party/nlfaultinjection/repo/third_party/cstyle/repo/cstyle.pl

   1 #!/usr/bin/perl
   2
   3 #
   4 #    Copyright (c) 2001-2017 Grant Erickson
   5 #
   6 #    Licensed under the Apache License, Version 2.0 (the "License");
   7 #    you may not use this file except in compliance with the License.
   8 #    You may obtain a copy of the License at
   9 #
  10 #       http://www.apache.org/licenses/LICENSE-2.0
  11 #
  12 #    Unless required by applicable law or agreed to in writing, software
  13 #    distributed under the License is distributed on an "AS IS" BASIS,
  14 #    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  15 #    See the License for the specific language governing permissions and
  16 #    limitations under the License.
  17 #
  18 #    Description:
  19 #      This program is used to flexibly and parametrically check for code
  20 #      formatting style compliance.
  21 #
  22 #      Philosophically, this assumes it is working on compilable
  23 #      code. Consequently, this does not endeavor to be nor is it a
  24 #      grammatically-correct source code parser.
  25 #
  26 #      Where possible, effort is expended to make the syntax, option
  27 #      invocation, and output familiar to users of compilers and other
  28 #      linting and formatting tools for ease of use and efficient
  29 #      system integration.
  30 #
  31
  32 use strict 'refs';
  33
  34 use File::Basename;
  35 use File::Path;
  36 use Getopt::Long qw(:config gnu_getopt);
  37 use POSIX;
  38
  39 # Global Variables
  40
  41 my($program);
  42
  43 # Default program options. Eventually, the vision is to allow these to
  44 # be overridden by command-line options and via a global
  45 # (e.g. /usr/local/etc/style.conf) or local (e.g. ~/.style) or
  46 # arbitrary configuration file. However, at present, only command-line
  47 # options are supported since loading and parsing configuration files
  48 # will, undoubtably, slow the program down considerably.
  49
  50 my(%defaults) = ();
  51
  52 my(%options) = ();
  53
  54 my(%warnings) = ();
  55
  56 # Mappings of supported languages to style handlers. Supported
  57 # languages as translated by file extension or via the '-x' option. In
  58 # the absence of any better nomenclature, the language names from GCC
  59 # are used.
  60
  61 my(%handlers) = (
  62                  "assembler",                   \&asmstyle,
  63                  "assembler-with-cpp",          \&asmstyle,
  64                  "c",                           \&cstyle,
  65                  "c-header",                    \&cstyle,
  66                  "c++",                         \&cxxstyle,
  67                  "c++-header",                  \&cxxstyle,
  68                  "objective-c",                 \&objcstyle,
  69                  "objective-c-header",          \&objcstyle,
  70                  "objective-c++",               \&objcxxstyle,
  71                  "objective-c++-header",        \&objcxxstyle
  72                  );
  73
  74 my(@languages) = sort(keys(%handlers));
  75
  76 # Mappings of file extensions to source language type. As with the list
  77 # of supported languages, language names from GCC are used.
  78
  79 my(%extensions) = (
  80                    "C",         "c++",
  81                    "H",         "c++-header",
  82                    "M",         "objective-c++",
  83                    "S",         "assembler-with-cpp",
  84                    "c",         "c",
  85                    "c++",       "c++",
  86                    "cc",        "c++",
  87                    "cp",        "c++",
  88                    "cpp",       "c++",
  89                    "cxx",       "c++",
  90                    "h",         "c-header",
  91                    "hh",        "c++-header",
  92                    "hpp",       "c++-header",
  93                    "m",         "objective-c",
  94                    "mm",        "objective-c++",
  95                    "s",         "assembler"
  96                   );
  97
  98 # Some freqeuently-used, precompiled regular expression patterns.
  99
 100 my($storage_specifiers_re) = qr/((extern|static)\s+)/;
 101 my($type_qualifiers_re) = qr/((const|volatile)\s+)/;
 102 my($method_qualifiers_re) = qr/((const|volatile)\s*)/;
 103 my($type_declarator_re) = qr/([_[:alpha:]][_[:alnum:]]*\s*)/;
 104 my($type_re) = qr/$type_qualifiers_re*$type_declarator_re*\s*($type_qualifiers_re*[*&])*/;
 105 my($function_declarator_re) = qr/([_~[:alpha:]][_[:alnum:]]*)/;
 106 my($argument_declarator_re) = qr/([_[:alpha:]][_[:alnum:]]*)/;
 107 my($array_declarator_re) = qr/(\[\w+\])/;
 108 my($argument_re) = qr/$type_re\s*($argument_declarator_re\s*$array_declarator_re*)*/;
 109 my($argument_list_re) = qr/(void|($argument_re\s*,*\s*)*)/;
 110 my($function_declaration_re) = qr/$storage_specifiers_re*\s*$type_re\s*$function_declarator_re\s*\($argument_list_re\)\s*$method_qualifiers_re*;\s*/;
 111
 112 #
 113 # usage()
 114 #
 115 # Description:
 116 #   This routine prints out the proper command line usage for this program
 117 #
 118 # Input(s):
 119 #   status - Flag determining what usage information will be printed and what
 120 #            the exit status of the program will be after the information is
 121 #            printed.
 122 #
 123 # Output(s):
 124 #   N/A
 125 #
 126 # Returns:
 127 #   This subroutine does not return.
 128 #
 129 sub usage {
 130   my($status) = $_[0];
 131
 132   print(STDERR "Usage: style [ options... ] [ files... ]\n");
 133
 134   if ($status != 0) {
 135     print(STDERR "Try `style --help' for more information.\n");
 136   }
 137
 138   if ($status != 1) {
 139     my($usage) =
 140 "General Options:
 141   -d, --debug                Display debug execution information.
 142   --help                     Display this information.
 143   -v, --verbose              Display verbose execution information.
 144   --version                  Display version information.
 145   -W<WARNING>                Select a comma-separated WARNING option.
 146   -x, --language=<LANGUAGE>  Specify LANGUAGE as source language of input
 147                              files.
 148
 149 Language Options:
 150   Permissible languages include:
 151     %s
 152
 153     'none' means revert to the default behavior of guessing the language
 154     based on the input file's extension.
 155
 156 Style Options:
 157   --copyright=<PATTERN>           Copyright pattern to search for.
 158   --file-length=<LENGTH>          Maximum file length is LENGTH lines.
 159   --line-length=<LENGTH>          Maximum line length is LENGTH characters.
 160   --tab-size=<SIZE>               Interpret tab characters as SIZE spaces.
 161   --cpp-lines-between-conditionals=<LINES>
 162                                   Initiate preprocessor conditional checks when
 163                                   separation between conditionals is more than
 164                                   LINES lines.
 165
 166 Warning Options:
 167   -Wall                           Enable all warning options.
 168   -Werror                         Make all warnings into errors.
 169   -Wimplicit-void-declaration     Warn about implicit void declarations [EXPERIMENTAL].
 170   -Winterpolated-space            Warn about interpolated spaces and tabs.
 171   -Wfile-length                   Warn about long files.
 172   -Wline-length                   Warn about long lines.
 173   -Wtrailing-line                 Warn about blank line(s) at the end of a file.
 174   -Wblank-trailing-space          Warn about white space at the end of a blank line.
 175   -Wtrailing-space                Warn about white space at the end of a non-blank
 176                                   line.
 177   -Wmissing-cpp-conditional-labels
 178                                   Warn about missing labels on conditionals.
 179   -Wcpp-constant-conditionals
 180                                   Warn about constant conditional expressions.
 181   -Wcpp-directive-leading-space
 182                                   Warn about leading space before directives.
 183   -Wmultiple-returns
 184                                   Warn about multiple return statements per function or method.
 185   -Wmissing-copyright             Warn about a missing copyright declaration.
 186   -Wmissing-newline-at-eof        Warn about missing new line at the end of a file.
 187   -Wmissing-space-after-comma     Warn about missing space after a comma.
 188   -Wmissing-space-after-else-if   Warn about missing space after the 'else if' keyword
 189   -Wmissing-space-after-for       Warn about missing space after the 'for' keyword
 190   -Wmissing-space-after-if        Warn about missing space after the 'if' keyword
 191   -Wmissing-space-after-operator  Warn about missing space after the 'operator' keyword.
 192   -Wmissing-space-after-semicolon
 193                                   Warn about missing space after a semicolon.
 194   -Wmissing-space-after-switch    Warn about missing space after the 'switch' keyword
 195   -Wmissing-space-after-while     Warn about missing space after the 'while' keyword
 196   -Wmissing-space-around-binary-operators
 197                                   Warn about missing space around binary operators [EXPERIMENTAL].
 198   -Wmissing-space-around-braces   Warn about missing space around braces.
 199   -Wspace-around-unary-operators  Warn about space around unary operators.
 200 ";
 201     # Build up a string of the permissible languages
 202
 203     my($languages) = "'" . join("', '", @languages) . "' and 'none'";
 204
 205     # Display the usage, substituting in the permissible languages
 206
 207     printf(STDERR $usage, $languages);
 208   }
 209
 210   exit($status);
 211 }
 212
 213 #
 214 # version()
 215 #
 216 # Description:
 217 #   This routine prints out program version information
 218 #
 219 # Input(s):
 220 #   N/A
 221 #
 222 # Output(s):
 223 #   N/A
 224 #
 225 # Returns:
 226 #   This subroutine does not return.
 227 #
 228 sub version {
 229   print("cstyle Version 1.7.5d\n");
 230   print("Copyright (c) 2001-2017 Grant Erickson\n");
 231
 232   exit (0);
 233 }
 234
 235 #
 236 # parse_warnings
 237 #
 238 # Description:
 239 #   This routine handles generating a quick-reference hash to all options
 240 #   invoked by the '-W' command line option.
 241 #
 242 # Input(s):
 243 #   option   - This is the command option and should always be 'W'.
 244 #   argument - This is the command argument and may contain one or
 245 #              more comma-separated arguments.
 246 #
 247 # Output(s):
 248 #   N/A
 249 #
 250 # Returns:
 251 #   N/A
 252 #
 253 sub parse_warnings {
 254   my($warning);
 255   my($flag);
 256
 257   # Options are either going to be singly specified or comma-separated.
 258   # In either case, split them up and add them to the warning hash.
 259
 260   foreach $warning (split(/,/, $_[1])) {
 261     # Warning options may only use alphanumeric characters and the
 262     # dash (-) or underscore (_) characters.
 263
 264     if ($warning =~ m/[^A-Za-z0-9_\-]/g) {
 265       die("Unknown or invalid warning option: `$warning'");
 266     }
 267
 268     # Warnings that are of the form 'no-<warning>' have the effect of
 269     # disabling a warning (e.g. overrides -Wall or a previous enabling
 270     # of that warning.
 271     #
 272     # Attempt to match and if it matches, delete, the leading 'no-' to
 273     # a warning option and then deassert the warning. Otherwise, assert
 274     # the warning.
 275
 276     if ($warning =~ s/^no-//g) {
 277       $flag = 0;
 278
 279     } else {
 280       $flag = 1;
 281
 282     }
 283
 284     # Set the warning hash to true for this warning key.
 285
 286     $warnings{$warning} = $flag;
 287   }
 288 }
 289
 290 #
 291 # decode_options()
 292 #
 293 # Description:
 294 #   This routine steps through the command-line arguments, parsing out
 295 #   recognzied options.
 296 #
 297 # Input(s):
 298 #   N/A
 299 #
 300 # Output(s):
 301 #   N/A
 302 #
 303 # Returns:
 304 #   N/A
 305 #
 306 sub decode_options {
 307   my($errors) = 0;
 308   my(@dependencies);
 309
 310   if (!&GetOptions(\%options,
 311                    "W=s@" => \&parse_warnings,
 312                    "debug|d+",
 313                    "help",
 314                    "language|x=s",
 315                    "copyright=s",
 316                    "cpp-lines-between-conditionals=i",
 317                    "file-length=i",
 318                    "line-length|l=i",
 319                    "tab-size|ts=i",
 320                    "verbose|v+",
 321                    "version"
 322                   )) {
 323     usage(1);
 324   }
 325
 326   if ($options{"version"}) {
 327     version();
 328   }
 329
 330   if ($options{"help"}) {
 331     usage(0);
 332   }
 333
 334   # If -Wmissing-copyright was set, then so too must be --copyright.
 335
 336   @dependencies = ({ OPTION => "copyright",
 337                      DESCRIPTION => "copyright regular expression pattern" });
 338
 339   $errors += check_warning_deps("missing-copyright", \@dependencies);
 340
 341   # If -Wfile-length was set, then so too must be --file-length.
 342
 343   @dependencies = ({ OPTION => "file-length",
 344                      DESCRIPTION => "file length" });
 345
 346   $errors += check_warning_deps("file-length", \@dependencies);
 347
 348   # If -Wline-length was set, then so too must be --line-length and
 349   # --tab-size.
 350
 351   @dependencies = ({ OPTION => "line-length",
 352                      DESCRIPTION => "line length" },
 353                    { OPTION => "tab-size",
 354                      DESCRIPTION => "tab size" });
 355
 356   $errors += check_warning_deps("line-length", \@dependencies);
 357
 358   # If -Wmissing-cpp-conditional-labels was set, then so too must be
 359   # --cpp-lines-between-conditionals.
 360
 361   @dependencies = ({ OPTION => "cpp-lines-between-conditionals",
 362                      DESCRIPTION => "maximum number of lines between " .
 363                      "preprocessor conditionals" });
 364
 365   $errors += check_warning_deps("missing-cpp-conditional-labels", \@dependencies);
 366
 367   # At this point, we either have a list of one or more files to process
 368   # remaining in the argument list or we will process standard input. If
 369   # we are processing standard input, then a language must be specified.
 370
 371   if ($#ARGV < 0 && !defined($options{"language"})) {
 372     print(STDERR "A language must be specified when using standard input!\n");
 373     $errors++;
 374   }
 375
 376   usage(1) if ($errors);
 377
 378   return;
 379 }
 380
 381 #
 382 # line_violation_with_column()
 383 #
 384 # Description:
 385 #   This routine is used in response to line style violations and
 386 #   displays, to standard error, the file path, line number, column
 387 #   number, and line enforcement violation. If the verbose option flag
 388 #   is in effect, the actual text of the offending line is also
 389 #   displayed along with a leader indicating the position of the
 390 #   error, as specified by the provided column parameter.
 391 #
 392 # Input(s):
 393 #   file    - Path name of the current input file being processed.
 394 #   message - Violation message to display.
 395 #   line    - The current input line being processed, in its pristine,
 396 #             unmodified state.
 397 #   column  - The column number (0-based) of the violation used to
 398 #             generate the indicative leader in verbose mode.
 399 #
 400 # Output(s):
 401 #   N/A
 402 #
 403 # Returns:
 404 #   N/A
 405 #
 406 sub line_violation_with_column {
 407   my($file) = $_[0];
 408   my($message) = $_[1];
 409   my($line) = $_[2];
 410   my($column) = $_[3];
 411   my($format);
 412   my($status) = ($warnings{"error"} ? "error" : "warning");
 413
 414   if ($options{"verbose"}) {
 415     $format = "%s:%d:%d: %s: %s\n%s\n%s%s\n";
 416   } else {
 417     $format = "%s:%d:%d: %s: %s\n";
 418   }
 419
 420   printf(STDERR $format, $file, $., $column + 1, $status, $message, $line,
 421          '-' x $column, "^");
 422 }
 423
 424 #
 425 # line_violation()
 426 #
 427 # Description:
 428 #   This routine is used in response to line style violations and
 429 #   displays, to standard error, the file path, line number, column
 430 #   number, and line enforcement violation. If the verbose option flag
 431 #   is in effect, the actual text of the offending line is also
 432 #   displayed along with a leader indicating the position of the
 433 #   error. The column to generate the indicating leader is extraced
 434 #   from $-[1].
 435 #
 436 # Input(s):
 437 #   file    - Path name of the current input file being processed.
 438 #   message - Violation message to display.
 439 #   line    - The current input line being processed, in its pristine,
 440 #             unmodified state.
 441 #
 442 # Output(s):
 443 #   N/A
 444 #
 445 # Returns:
 446 #   N/A
 447 #
 448 sub line_violation {
 449   my($file) = $_[0];
 450   my($message) = $_[1];
 451   my($line) = $_[2];
 452
 453   line_violation_with_column($file, $message, $line, $-[1]);
 454 }
 455
 456 #
 457 # file_violation()
 458 #
 459 # Description:
 460 #   This routine is used in response to file style violations and
 461 #   displays, to standard error, the file path, and file enforcement
 462 #   violation.
 463 #
 464 # Input(s):
 465 #   file    - Path name of the current input file being processed.
 466 #   message - Violation message to display.
 467 #
 468 # Output(s):
 469 #   N/A
 470 #
 471 # Returns:
 472 #   N/A
 473 #
 474 sub file_violation {
 475   my($file) = $_[0];
 476   my($message) = $_[1];
 477   my($format) = "%s: %s: %s\n";
 478   my($status) = ($warnings{"error"} ? "error" : "warning");
 479
 480   printf(STDERR $format, $file, $status, $message);
 481 }
 482
 483 #
 484 # check_warning()
 485 #
 486 # Description:
 487 #   This routine checks whether or not the specified warning option has
 488 #   been set as well as checking the 'all' warning option which implicitly
 489 #   sets the specified warning.
 490 #
 491 # Input(s):
 492 #   warning - The name of the warning to be checked.
 493 #
 494 # Output(s):
 495 #   N/A
 496 #
 497 # Returns:
 498 #   TRUE (1) if the warning is set; otherwise, FALSE (0).
 499 #
 500 sub check_warning {
 501   my($warning) = $_[0];
 502   my($flag);
 503
 504   # A warning is considered enabled if: 1) The warning was
 505   # independently asserted OR 2) The 'all' warning was asserted and
 506   # the warning was not independently deasserted.
 507   #
 508   # So, if we are checking warning 'foo', the following truth table
 509   # results:
 510   #
 511   #                     -> False
 512   #   -Wall             -> True
 513   #   -Wall -Wfoo       -> True
 514   #   -Wall -Wno-foo    -> False
 515   #   -Wfoo             -> True
 516   #   -Wno-foo          -> False
 517
 518   if (defined($warnings{$warning}) && $warnings{$warning}) {
 519     $flag = 1;
 520
 521   } elsif (defined($warnings{$warning}) && !$warnings{$warnings}) {
 522     $flag = 0;
 523
 524   } else {
 525     $flag = $warnings{'all'};
 526
 527   }
 528
 529   return ($flag);
 530 }
 531
 532 #
 533 # check_warning_deps()
 534 #
 535 # Description:
 536 #   This routine checks for interdependencies between a warning option
 537 #   and one or more style options settings by ensuring the if the
 538 #   warning option has been asserted that the style options on which
 539 #   it depends are defined.
 540 #
 541 # Input(s):
 542 #   warning - The name of the warning to be checked.
 543 #   depref - A reference to an array of dependency records, each
 544 #            record a hash reference containing the style option and
 545 #            description.
 546 #
 547 # Output(s):
 548 #   N/A
 549 #
 550 # Returns:
 551 #   The number of dependency errors encounterd.
 552 #
 553 sub check_warning_deps {
 554   my($errors) = 0;
 555   my($warning) = $_[0];
 556   my($depref) = $_[1];
 557
 558   if (check_warning($warning)) {
 559     my($warnings) = "`-Wall' or `-W$warning'";
 560
 561     foreach $dependency (@{$depref}) {
 562
 563       if (!defined($options{$dependency->{"OPTION"}})) {
 564         printf(STDERR "The %s must be specified with " .
 565                       "`--%s' when used with %s!\n",
 566                $dependency->{"DESCRIPTION"},
 567                $dependency->{"OPTION"},
 568                $warnings);
 569         $errors++;
 570       }
 571     }
 572   }
 573
 574   return ($errors);
 575 }
 576
 577 #
 578 # cppstyle()
 579 #
 580 # Description:
 581 #   This routine performs coding style checking for lines identified
 582 #   as C preprocessor input.
 583 #
 584 #   At minimum, the following preprocessor directives are possible and
 585 #   expected:
 586 #
 587 #     <null>
 588 #     assert <predicate> <answer>
 589 #     define <macro> [<expression>]
 590 #     elif <expression>
 591 #     else
 592 #     endif
 593 #     error <string>
 594 #     ident <string>
 595 #     if <expression>
 596 #     ifdef <macro>
 597 #     ifndef <expression>
 598 #     import <string>
 599 #     include <string>
 600 #     line [ (<number> [<string>]) | <expression> ]
 601 #     sccs <string>
 602 #     unassert <predicate>
 603 #     undef <macro>
 604 #     warning <string>
 605 #
 606 # Input(s):
 607 #   file    - Path name of the current input file being processed.
 608 #   line    - The current input line being processed, in its pristine,
 609 #             unmodified state.
 610 #   record  - A reference to the record defining the current C preprocessor
 611 #             directive being checked.
 612 #   records - A stack of C preprocessor conditional directives
 613 #             encountered thus far in the input file. This is used as state
 614 #             for various checks.
 615 #
 616 # Output(s):
 617 #   records - The C preprocessor conditional directive stack, possibly with
 618 #             records pushed onto or popped off.
 619 #
 620 # Returns:
 621 #   The number of preprocessor violations encountered.
 622 #
 623 sub cppstyle {
 624   my($file) = $_[0];
 625   my($line) = $_[1];
 626   my($record) = $_[2];
 627   my($records) = $_[3];
 628   my($violations) = 0;
 629
 630
 631   # If enabled, check for leading white space before the
 632   # preprocessor directive token ('#').
 633
 634   if (check_warning("cpp-directive-leading-space") &&
 635       (length($record->{'LEADING'}) > 0)) {
 636     line_violation($file, "leading space before preprocessor directive", $line);
 637     $violations++;
 638   }
 639
 640   # Perform directive-specific checking, accumulating state for those
 641   # directives which have context-specific checks.
 642
 643   DIRECTIVE: for ($record->{'DIRECTIVE'}) {
 644
 645       /^(else|endif)$/  && do {
 646         # Check to ensure that conditionals, separated by
 647         # `cpp-lines-between-conditionals' lines or more have
 648         # comment labels.
 649
 650         my($top) = pop(@{$records});
 651         my($ifline) = $top->{'LINE'};
 652
 653         # If the directive is an 'else', put the line the matching
 654         # 'if' directive was on back on the stack since we cannot
 655         # permanently pop it until we see the matching 'endif'.
 656
 657         if ($_ =~ m/^else$/g) {
 658           push(@{$records}, $top);
 659         }
 660
 661         # Compute the distance from the last seen if/ifdef/ifndef
 662         # directive.
 663
 664         my($distance) = $record->{'LINE'} - $ifline;
 665         my($threshold) = $options{"cpp-lines-between-conditionals"};
 666
 667         # If the warning is asserted, the match to anything other than
 668         # white space following the directive hits, and the distance
 669         # exceeds the threshold, flag a violation.
 670
 671         if (check_warning("missing-cpp-conditional-labels") &&
 672             ($record->{'REST'} =~ m/^\s*$/g) && ($distance > $threshold)) {
 673
 674           # Rematch on the entire original line so that @- is set
 675           # correctly and the '-v' leader behavior works to identify
 676           # the offending column.
 677
 678           $line =~ m/^\s*#\s*(else|endif)\s*$/g;
 679
 680           line_violation($file,
 681                          "Missing preprocessor conditional comment label " .
 682                          "for '$_' matching '$top->{'DIRECTIVE'}' at line " .
 683                          "$ifline, which is more than $threshold line(s) away",
 684                          $line);
 685           $violations++;
 686         }
 687
 688         last DIRECTIVE;
 689       };
 690
 691       /^(if|elif)$/     && do {
 692         # Push the current line onto the if/ifdef/ifndef
 693         # conditional stack so that it can be used for subsequent
 694         # checks.
 695
 696         if ($_ =~ m/^if$/g) {
 697           push(@{$records}, $record);
 698         }
 699
 700         # Check for constant numeric conditional expressions which
 701         # indicate that the code is being unconditionally compiled
 702         # out or in. Any sequence of digits following the directive
 703         # hits the match.
 704
 705         if (check_warning("cpp-constant-conditionals")) {
 706           my($cpp_constant_conditional_re) = qr/[([:space:]]*(\d+)[)[:space:]]*/;
 707
 708           if ($record->{'REST'} =~ m/^$cpp_constant_conditional_re$/g) {
 709
 710             # Rematch on the entire original line so that @- is set
 711             # correctly and the '-v' leader behavior works to identify
 712             # the offending column.
 713
 714             $line =~ m/$cpp_constant_conditional_re$/g;
 715
 716             # Now flag the violation.
 717
 718             line_violation($file, "constant numeric preprocessor expression",
 719                            $line);
 720             $violations++;
 721           }
 722         }
 723
 724         last DIRECTIVE;
 725       };
 726
 727       /^if(n)*def$/     && do {
 728         # Push the current line onto the if/ifdef/ifndef
 729         # conditional stack so that it can be used for subsequent
 730         # checks.
 731
 732         push(@{$records}, $record);
 733
 734         last DIRECTIVE;
 735       };
 736
 737       # Default
 738
 739       last DIRECTIVE;
 740   }
 741
 742   return ($violations);
 743 }
 744
 745 #
 746 # asmstyle()
 747 #
 748 # Description:
 749 #   This routine performs the actual coding style checking for assembler
 750 #   source files.
 751 #
 752 # Input(s):
 753 #   file - Path name of the current input file being processed.
 754 #
 755 # Output(s):
 756 #   N/A
 757 #
 758 # Returns:
 759 #   N/A
 760 #
 761 sub asmstyle {
 762   my($file) = $_[0];
 763
 764   # In the absence of any language-specific checks, just call cstyle...
 765
 766   return (cstyle($file));
 767 }
 768
 769 #
 770 # objcstyle()
 771 #
 772 # Description:
 773 #   This routine performs the actual coding style checking for
 774 #   Objective C source files.
 775 #
 776 # Input(s):
 777 #   file - Path name of the current input file being processed.
 778 #
 779 # Output(s):
 780 #   N/A
 781 #
 782 # Returns:
 783 #   N/A
 784 #
 785 sub objcstyle {
 786   my($file) = $_[0];
 787
 788   # In the absence of any language-specific checks, just call cstyle...
 789
 790   return (cstyle($file));
 791 }
 792
 793 #
 794 # objcxxstyle()
 795 #
 796 # Description:
 797 #   This routine performs the actual coding style checking for
 798 #   Objective C++ source files.
 799 #
 800 # Input(s):
 801 #   file - Path name of the current input file being processed.
 802 #
 803 # Output(s):
 804 #   N/A
 805 #
 806 # Returns:
 807 #   N/A
 808 #
 809 sub objcxxstyle {
 810   my($file) = $_[0];
 811
 812   # In the absence of any language-specific checks, just call cstyle...
 813
 814   return (cstyle($file));
 815 }
 816
 817 #
 818 # is_function_or_method_declaration()
 819 #
 820 # Description:
 821 #   This routine attempts to perform a match on the current line ($_)
 822 #   and determines whether or not it contains a C or C++ function or
 823 #   method declaration.
 824 #
 825 # Input(s):
 826 #   N/A
 827 #
 828 # Output(s):
 829 #   N/A
 830 #
 831 # Returns:
 832 #   True (1) if the current line ($_) is thought to contain a C or C++
 833 #   function or method declaration; otherwise, false.
 834 #
 835 sub is_function_or_method_declaration {
 836   return (/$function_declaration_re/);
 837 }
 838
 839 #
 840 # is_function_or_method_declaration()
 841 #
 842 # Description:
 843 #   This routine attempts to perform a match on the current line ($_)
 844 #   and determines whether or not it contains an implicit void (e.g. foo())
 845 #   C or C++ function or method declaration.
 846 #
 847 # Input(s):
 848 #   N/A
 849 #
 850 # Output(s):
 851 #   N/A
 852 #
 853 # Returns:
 854 #   True (1) if the current line ($_) is thought to contain an
 855 #   implicit void C or C++ function or method declaration; otherwise,
 856 #   false.
 857 #
 858 sub is_implicit_void_function_or_method_declaration {
 859   my($virtual_specifier_re) = qr/((virtual)\s+)/;
 860   my($implicit_void_function_declaration_re) = qr/($virtual_specifier_re|$storage_specifiers_re)*\s*$type_re\s*$function_declarator_re\s*\(\s*\)\s*$method_qualifiers_re*(\s*=\s*0)*;\s*/;
 861   my($retval);
 862
 863   $retval = m/$implicit_void_function_declaration_re/gp;
 864
 865   # Filter out:
 866   #
 867   #   - Any member pointer or member reference selection void method
 868   #     calls.
 869   #
 870   #   - Any return statements embedding a void function or method
 871   #     call.
 872   #
 873   #   - Any assignments with a void function or method call as an rvalue.
 874
 875   if ($retval) {
 876     if ((${^PREMATCH} =~ m/(\.|->)$/gp) ||
 877         (${^PREMATCH} =~ m/\s*return\s/gp) ||
 878         (${^PREMATCH} =~ m/\s*=\s*/gp)) {
 879       $retval = undef;
 880     }
 881   }
 882
 883   return ($retval);
 884 }
 885
 886 #
 887 # cstyle()
 888 #
 889 # Description:
 890 #   This routine performs the actual coding style checking for C source
 891 #   and header files.
 892 #
 893 # Input(s):
 894 #   file - Path name of the current input file being processed.
 895 #
 896 # Output(s):
 897 #   N/A
 898 #
 899 # Returns:
 900 #   N/A
 901 #
 902 sub cstyle {
 903   my($file) = $_[0];
 904   my($neolchars) = 0;
 905   my($line, $prev);
 906   my($violations) = 0;
 907   my($return_count) = 0;
 908   my(%state) = ();
 909   my(@cppstack);
 910   my(@bracestack);
 911   my($in_function_at_depth) = -1;
 912   my($in_comment) = 0;
 913   my($saw_copyright) = 0;
 914
 915 LINE: while (<STDIN>) {
 916     # Attempt to automatically detect end-of-line markers based on what is
 917     # encountered on the first line.
 918
 919     if ($. == 1) {
 920       if (m/(\015?\012?)$/) {
 921         $/ = $1
 922       }
 923     }
 924
 925     # Strip the end-of-line marker. Note that chomp should always be
 926     # used rather than chop, since chomp acts intelligently based on
 927     # '$/' whereas chop just always consumes that last character on a
 928     # line without regard to whether or not its actually a newline
 929     # character at all.
 930
 931     $neolchars = chomp;
 932
 933     # Cache the input line in its pristine, unmodified state.
 934
 935     $line = $_;
 936
 937     # Clean-up and ignore things we don't want to further check:
 938     #
 939     # 1) Text, including escaped characters, w/i single ('') and double ("") quotes.
 940
 941     s/(["'])(?:(?=(\\?))\2.)*?\1/\1\1/g;
 942
 943     # 2) Trailing backslashes.
 944
 945     s/\s*\\$//;
 946
 947     # Check file length
 948
 949     if (check_warning("file-length")) {
 950       if ($. > $options{"file-length"}) {
 951         line_violation($file, "file > " .
 952                        $options{"file-length"} .
 953                        " lines", $line);
 954         $violations++;
 955       }
 956     }
 957
 958     # Inline "/* *STYLE-OFF* */" or "// *STYLE-OFF*" directives on a
 959     # line by themselves exempt subsequent lines from style checking
 960     # until a similar "/* *STYLE-ON* */ or "// *STYLE-ON*" directive
 961     # on a line by itself is encountered.
 962
 963     if ((/^\s*\/\*\s*\*STYLE-(ON|OFF)\*\s*\*\/$/) ||    # C-style directive
 964         (/^\s*\/\/\s*\*STYLE-(ON|OFF)\*$/)) {           # C++-style directive
 965
 966       # Set the state based on the positional match argument of "ON" or "OFF"
 967
 968       $state{"style-disable"} = ($1 eq "OFF") ? 1 : 0;
 969     }
 970
 971     # If style checking has been disabled by a style directive, skip ahead
 972     # to the next line.
 973
 974     if (defined($state{"style-disable"}) && $state{"style-disable"} == 1) {
 975       $prev = $line;
 976
 977       next LINE;
 978     }
 979
 980     #
 981     # Check line length
 982     #
 983
 984     if (check_warning("line-length")) {
 985       # First, a quick check to see if there is any chance of being too long.
 986
 987       if ($line =~ tr/\t/\t/ *
 988           ($options{"tab-size"} - 1) +
 989           length($line) > $options{"line-length"}) {
 990
 991         # Confirmed. Interpolate spaces for tabs and check again.
 992
 993         $eline = $line;
 994
 995         1 while $eline =~ s/\t+/" " x (length($&) *
 996                                        $options{"tab-size"} - length($`) %
 997                                        $options{"tab-size"})/e;
 998
 999         if (length($eline) > $options{"line-length"}) {
1000           line_violation($file, "line > " .
1001                          $options{"line-length"} .
1002                          " characters", $line);
1003           $violations++;
1004         }
1005       }
1006     }
1007
1008     # Check for unnecessary trailing white-space at the end of a
1009     # non-blank line.
1010
1011     if (check_warning("trailing-space")) {
1012       if (/[^[:space:]]+(\s+)$/) {
1013         line_violation($file, "white space at end of a non-blank line", $line);
1014         $violations++;
1015       }
1016     }
1017
1018     # Check for unnecessary trailing white-space at the end of a blank
1019     # line.
1020
1021     if (check_warning("blank-trailing-space")) {
1022       if (/^(\s+)$/ && !/^\f$/) {
1023         line_violation($file, "white space at end of a blank line", $line);
1024         $violations++;
1025       }
1026     }
1027
1028     # Check for interpolation of tabs with spaces.
1029
1030     if (check_warning("interpolated-space")) {
1031       if (/\t([ ]+)\t/) {
1032         line_violation($file, "spaces between tabs", $line);
1033         $violations++;
1034       }
1035
1036       if (/ ([\t]+) /) {
1037         line_violation($file, "tabs between spaces", $line);
1038         $violations++;
1039       }
1040     }
1041
1042     # Delete any trailing whitespace; we have already checked for that.
1043
1044     s/\s*$//;
1045
1046     # Check preprocessor directives.
1047     #
1048     # The following regular expression breaks up the directive as follows
1049     #
1050     #   1: Optional leading white space, up to the '#'.
1051     #   2: Optional trailing white space, after the '#'.
1052     #   3: The directive itself.
1053     #   4: Optional trailing white space, after the directive.
1054     #   5: Optional directive-specific tokens.
1055     #
1056
1057     if (/^(\s*)#(\s*)([a-z]+)(\s*)(.*)$/) {
1058
1059       %cpprecord = ( 'LEADING' => $1,
1060                      'TRAILING' => $2,
1061                      'DIRECTIVE' => $3,
1062                      'REST' => $5,
1063                      'LINE' => $. );
1064
1065       $violations += cppstyle($file, $line, {%cpprecord}, \@cppstack);
1066
1067       $prev = $line;
1068
1069       next LINE;
1070     }
1071
1072     # Check for a missing copyright declaration
1073
1074     if (check_warning("missing-copyright") && $saw_copyright != 1) {
1075       if (/$options{"copyright"}/) {
1076         $saw_copyright = 1;
1077       }
1078     }
1079
1080     # Search for a start of a multi-line comment
1081
1082     if (/\/\*/ && $in_comment != 1) {
1083       $in_comment = 1;
1084
1085       # This might be an one line comment (e.g. "/* ... */")
1086
1087       if (/\*\//) {
1088         $in_comment = 0;
1089       }
1090
1091       # Swallow it.
1092
1093       s/\/\*.+$//;
1094     }
1095
1096     # Search for the end of a multi-line comment
1097
1098     if (/\*\// && $in_comment != 0) {
1099       $in_comment = 0;
1100
1101       # Swallow it.
1102
1103       s/^.+\*\///;
1104     }
1105
1106     # If we are in a multi-line comment, there is no further style
1107     # checking at tis point. Simply iterate to the next line.
1108
1109     if ($in_comment != 0) {
1110       $prev = $line;
1111
1112       next LINE;
1113     }
1114
1115     # Swallow, at this point, any inline comments (i.e. "// ...")
1116
1117     s/\/\/.+$//;
1118
1119     # Check for missing white space after commas
1120
1121     if (check_warning("missing-space-after-comma")) {
1122       if (/(,)\S/) {
1123         line_violation($file, "missing space after comma", $line);
1124         $violations++;
1125       }
1126     }
1127
1128     # Check for missing white space after semicolons
1129
1130     if (check_warning("missing-space-after-semicolon")) {
1131       if (/(;)\S/) {
1132         line_violation($file, "missing space after semicolon", $line);
1133         $violations++;
1134       }
1135     }
1136
1137     # Check for missing space after keywords
1138
1139     if (check_warning("missing-space-after-if")) {
1140       if (/(?<!else)\sif(\()/) {
1141         line_violation($file, "missing space after 'if' keyword", $line);
1142         $violations++;
1143       }
1144     }
1145
1146     if (check_warning("missing-space-after-else-if")) {
1147       if (/else if(\()/) {
1148         line_violation($file, "missing space after 'else if' keyword", $line);
1149         $violations++;
1150       }
1151     }
1152
1153     if (check_warning("missing-space-after-for")) {
1154       if (/\sfor(\()/) {
1155         line_violation($file, "missing space after 'for' keyword", $line);
1156         $violations++;
1157       }
1158     }
1159
1160     if (check_warning("missing-space-after-operator")) {
1161       if (/[[:space:]&*]operator(new|delete|[.\-+*\/%><=!|^&~\[,(])/) {
1162         line_violation($file, "missing space after 'operator' keyword", $line);
1163         $violations++;
1164       }
1165     }
1166
1167     if (check_warning("missing-space-after-switch")) {
1168       if (/\sswitch(\()/) {
1169         line_violation($file, "missing space after 'switch' keyword", $line);
1170         $violations++;
1171       }
1172     }
1173
1174     if (check_warning("missing-space-after-while")) {
1175       if (/}*\s*while(\()/) {
1176         line_violation($file, "missing space after 'while' keyword", $line);
1177         $violations++;
1178       }
1179     }
1180
1181     if (check_warning("missing-space-around-braces")) {
1182       my($opening_brace_re) = qr/(^\{\S|[^\s@^]\{\s|[^\s@^]\{\S|\s\{\S|[^\s@^]\{$)/;
1183       my($closing_brace_re) = qr/(^}[^\s,;)]|\S}\s|\S}\S|\S}$|\s}[^\s,;)])/;
1184
1185       if ((/${opening_brace_re}/) || (/${closing_brace_re}/)) {
1186         my($column) = $-[1];
1187         my($which_brace);
1188
1189         if ($1 =~ m/{/) {
1190           $which_brace = "opening";
1191         } else {
1192           $which_brace = "closing";
1193         }
1194
1195         line_violation_with_column($file, "missing space around $which_brace brace", $line, $column);
1196         $violations++;
1197       }
1198     }
1199
1200     # Check for missing space around binary operators:
1201     #
1202     #   [space]<binary operator>[space]
1203     #
1204     # including:
1205     #
1206     #   - Comparison operators: ==, !=, <=, >=, <, >
1207     #   - Logical operators: &&, ||
1208     #   - Bitwise operators: &, |, ^
1209     #   - Arithmetic operators: +, *, -, /, %
1210     #   - Shift operators: <<, >>
1211     #   - Assignment operator: =
1212     #   - Compound operators: &=, |=, ^=, +=, *=, -=, /=, %=, <<=, >>=
1213
1214     if (check_warning("missing-space-around-binary-operators")) {
1215       my($eq_operator_re)                        = qr/==/;
1216       my($ne_operator_re)                        = qr/!=/;
1217       my($le_operator_re)                        = qr/<=/;
1218       my($ge_operator_re)                        = qr/>=/;
1219       my($lt_operator_re)                        = qr/(?<!([ct]_cast))(?<!<)<(?![=<])/;
1220       my($gt_operator_re)                        = qr/(?<![>-])>(?![=>])/;
1221       my($logical_and_operator_re)               = qr/&&/;
1222       my($logical_or_operator_re)                = qr/\|\|/;
1223       my($bitwise_and_operator_re)               = qr/(?<![=*&,][[:space:]])(?<![&*(])&(?![&=)])/;
1224       my($bitwise_or_operator_re)                = qr/(?<!\|)\|(?![\|=])/;
1225       my($bitwise_xor_operator_re)               = qr/\^(?!=)/;
1226       my($addition_operator_re)                  = qr/(?<!\+)\+(?![\+=])/;
1227       my($multiplication_operator_re)            = qr/(?<![=*&,][[:space:]])(?<![(\*])\*(?![=\*&>)])/;
1228       my($subtraction_operator_re)               = qr/(?<![=][[:space:](])(?<![-\[\(])-(?![-=>])/;
1229       my($division_operator_re)                  = qr/\/(?!=)/;
1230       my($modulus_operator_re)                   = qr/%(?!=)/;
1231       my($left_shift_operator_re)                = qr/<</;
1232       my($right_shift_operator_re)               = qr/>>/;
1233       my($assignment_operator_re)                = qr/(?<![=!<>+*\-\/%&|^])=(?!=)/;
1234       my($bitwise_and_assignment_operator_re)    = qr/&=/;
1235       my($bitwise_or_assignment_operator_re)     = qr/\|=/;
1236       my($bitwise_xor_assignment_operator_re)    = qr/\^=/;
1237       my($addition_assignment_operator_re)       = qr/\+=/;
1238       my($multiplication_assignment_operator_re) = qr/\*=/;
1239       my($subtraction_assignment_operator_re)    = qr/-=/;
1240       my($division_assignment_operator_re)       = qr/\/=/;
1241       my($modulus_assignment_operator_re)        = qr/%=/;
1242       my($left_shift_assignment_operator_re)     = qr/<<=/;
1243       my($right_shift_assignment_operator_re)    = qr/>>=/;
1244       my($binop_core_re)                         = qr/(?<!operator)
1245                                                       (?<!operator\s)
1246                                                       (?<!operator[><])
1247                                                       (${eq_operator_re}|
1248                                                        ${ne_operator_re}|
1249                                                        ${le_operator_re}|
1250                                                        ${ge_operator_re}|
1251                                                        ${lt_operator_re}|
1252                                                        ${gt_operator_re}|
1253                                                        ${logical_and_operator_re}|
1254                                                        ${logical_or_operator_re}|
1255                                                        ${bitwise_and_operator_re}|
1256                                                        ${bitwise_or_operator_re}|
1257                                                        ${bitwise_xor_operator_re}|
1258                                                        ${addition_operator_re}|
1259                                                        ${multiplication_operator_re}|
1260                                                        ${subtraction_operator_re}|
1261                                                        ${division_operator_re}|
1262                                                        ${modulus_operator_re}|
1263                                                        ${left_shift_operator_re}|
1264                                                        ${right_shift_operator_re}|
1265                                                        ${assignment_operator_re}|
1266                                                        ${bitwise_and_assignment_operator_re}|
1267                                                        ${bitwise_or_assignment_operator_re}|
1268                                                        ${bitwise_xor_assignment_operator_re}|
1269                                                        ${addition_assignment_operator_re}|
1270                                                        ${multiplication_assignment_operator_re}|
1271                                                        ${subtraction_assignment_operator_re}|
1272                                                        ${division_assignment_operator_re}|
1273                                                        ${modulus_assignment_operator_re}|
1274                                                        ${left_shift_assignment_operator_re}|
1275                                                        ${right_shift_assignment_operator_re})/x;
1276       if (/\S${binop_core_re}\S/ || /\s${binop_core_re}\S/ || /\S${binop_core_re}\s/) {
1277         line_violation($file, "missing space around binary operator '$1'", $line);
1278         $violations++;
1279       }
1280     }
1281
1282     # Check for space around unary operators:
1283     #
1284     #   [space]<unary operator>[space]
1285     #
1286     # including:
1287     #
1288     #   - Logical negation operator: !
1289     #   - Bitwise negation operator: ~
1290     #   - Post- and prefix increment operator: ++
1291     #   - Post- and prefix decrement operator: --
1292
1293     if (check_warning("space-around-unary-operators")) {
1294       my($logical_negation_re)  = qr/(!)\s+/;
1295       my($bitwise_negation_re)  = qr/(~)\s+/;
1296       my($prefix_increment_re)  = qr/(\+\+)\s+[[:alnum:]_(\[]/;
1297       my($postfix_increment_re) = qr/[[:alnum:]_)\]]\s+(\+\+)/;
1298       my($prefix_decrement_re)  = qr/(--)\s+[[:alnum:]_(\[]/;
1299       my($postfix_decrement_re) = qr/[[:alnum:]_)\]]\s+(--)/;
1300
1301       if (/${logical_negation_re}/  ||
1302           /${bitwise_negation_re}/  ||
1303           /${prefix_increment_re}/  ||
1304           /${postfix_increment_re}/ ||
1305           /${prefix_decrement_re}/  ||
1306           /${postfix_decrement_re}/) {
1307         line_violation($file, "space around unary operator '$1'", $line);
1308         $violations++;
1309       }
1310     }
1311
1312     # Search for implicit void function or method declarations:
1313     #
1314     #   [extern|static ][return type ][name]()[[const ][volatile ]];
1315
1316     if (check_warning("implicit-void-declaration")) {
1317       if (is_implicit_void_function_or_method_declaration()) {
1318         line_violation($file, "implicit void declaration", $line);
1319         $violations++;
1320       }
1321     }
1322
1323     # Search for function or method implementations:
1324     #
1325     #   [static ][inline ][return type ][name](argument[, [argument]])[ [const ][volatile]]
1326
1327     if (/((static|inline)\s)*([_A-Za-z]\w+)*(?!if|else|for|while|switch|return|sizeof)([_A-Za-z]\w+)\s*\(\s*.+\)\s*(?!;)(\s(const|volatile)\s)*/) {
1328       print("$file: $.: found a possible function implementation\n") if ($options{"debug"});
1329       $in_function_at_depth = $#bracestack + 1;
1330     }
1331
1332     # Match and push opening brace lines onto the brace parsing stack.
1333
1334     if (/{/) {
1335       print("$file: $.: encountered opening brace.\n") if ($options{"debug"});
1336       push(@bracestack, $line);
1337     }
1338
1339     # Increment the return count (ostensibly within the outermost function or
1340     # method scope) where return statements are encountered.
1341
1342     if (/return\s*\(*.*\)*;/) {
1343       $return_count++;
1344       printf("$file: $.: Saw a return statement! Return count %u\n", $return_count) if ($options{"debug"});
1345       if (check_warning("multiple-returns") && ($return_count > 1)) {
1346         line_violation($file, "multiple return statements", $line);
1347         $violations++;
1348       }
1349     }
1350
1351     # Match and pop closing brace lines off of the brace parsing
1352     # stack, resetting the return statement count if we have exited
1353     # the current function or method scope.
1354
1355     if (/}/) {
1356       print("$file: $.: encountered closing brace.\n") if ($options{"debug"});
1357       pop(@bracestack);
1358       if ($in_function_at_depth == $#bracestack + 1) {
1359         print("Probably out of function!\n") if ($options{"debug"});
1360         $return_count = 0;
1361       }
1362     }
1363
1364     # Cache the last line and move onto the next line.
1365
1366     $prev = $line;
1367   }
1368
1369   if (!defined($state{"style-disable"}) || $state{"style-disable"} != 1) {
1370     # Check to make sure that the last line of the file contains a new
1371     # line (depends on the Perl execution environment and is stored in
1372     # '$/').
1373
1374     if (check_warning("missing-newline-at-eof")) {
1375       if ($neolchars == 0) {
1376         line_violation($file, "missing new line at the end of file", $line);
1377         $violations++;
1378       }
1379     }
1380
1381     # Check to make sure that the last line in the file is not blank
1382
1383     if (check_warning("trailing-line")) {
1384       if ($prev eq "") {
1385         line_violation($file, "last line in file is blank", $line);
1386         $violations++;
1387       }
1388     }
1389
1390     # Check to make sure we saw a matching copyright declaration if
1391     # requested.
1392
1393     if (check_warning("missing-copyright") && $saw_copyright != 1) {
1394       file_violation($file, "missing copyright declaration");
1395       $violations++;
1396     }
1397   }
1398
1399   return ($violations);
1400 }
1401
1402 #
1403 # cxxstyle()
1404 #
1405 # Description:
1406 #   This routine performs the actual coding style checking for C source
1407 #   and header files.
1408 #
1409 # Input(s):
1410 #   file - Path name of the current input file being processed.
1411 #
1412 # Output(s):
1413 #   N/A
1414 #
1415 # Returns:
1416 #   N/A
1417 #
1418 sub cxxstyle {
1419   my($file) = $_[0];
1420
1421   # In the absence of any language-specific checks, just call cstyle...
1422
1423   return (cstyle($file));
1424 }
1425
1426 #
1427 # style()
1428 #
1429 # Description:
1430 #   This routine performs the actual coding style checking for all language
1431 #   independent checks and calls a handler for the specified language to
1432 #   perform language-specific checks.
1433 #
1434 # Input(s):
1435 #   file     - Path name of the current input file being processed.
1436 #   language - Language-specific handler reference.
1437 #
1438 # Output(s):
1439 #   N/A
1440 #
1441 # Returns:
1442 #   N/A
1443 #
1444 sub style {
1445   my($file) = $_[0];
1446   my($language) = $_[1];
1447   my($eol, $handler, $status);
1448
1449   # Identify whether or not a valid handler is registered for
1450   # this language.
1451
1452   $handler = $handlers{$language};
1453
1454   if (!defined($handler)) {
1455     printf(STDERR "%s: Unknown or unsupported language!\n", $language);
1456     return (1);
1457   }
1458
1459   # The EOL variable may get set (differently) from file to file when
1460   # the program is operating on multiple files. Save the initial EOL
1461   # marker and reset it on entry and exit, respectively. Failure to do
1462   # so, leads to interesting and incorrect program behavior when one
1463   # file has one line ending type (e.g DS) and the subsequent one
1464   # another (e.g. UNIX).
1465
1466   $eol = $/;
1467
1468   $status = &{$handler}($file);
1469
1470   $/ = $eol;
1471
1472   return ($status);
1473 }
1474
1475 #
1476 # Main program body
1477 #
1478 {
1479   my($file);
1480   my($status) = 0;
1481   my($language);
1482   my($useextensions) = 0;
1483
1484   # Set the program name
1485
1486   $program = basename($0);
1487
1488   # Parse non-file program options from the command line
1489
1490   decode_options();
1491
1492   # Determine whether or not a default language has been specified.
1493   # This is required when working from standard input; otherwise, the
1494   # language is determined file-by-file based on the extension.
1495   #
1496   # If the language option is explicitly "none", then it is the same
1497   # as if it had not been defined at all.
1498
1499   $language = $options{"language"};
1500
1501   if (!defined($language) || ($language eq "none")) {
1502     $useextensions = 1;
1503   }
1504
1505   # Work on each file specified on the command line. Otherwise, just
1506   # process standard input.
1507
1508   if ($#ARGV >= 0) {
1509       SOURCEFILE: foreach $file (@ARGV) {
1510
1511           if ($useextensions) {
1512             # Determine which parser/handler to use by mapping the
1513             # file extension. Extensions are split at the last dot (.)
1514             # in the extension, so "foo.c.N" yields ".N" and
1515             # "bar.tar.gz" yields ".gz" for extensions, respectively.
1516
1517             my($extension) = (fileparse($file, qr(\.[^.]+)))[2];
1518
1519             # Strip the dot off the beginning of the extension.
1520
1521             $extension =~ s/^\.//;
1522
1523             # Attempt to map the extension to a language through the
1524             # extensions hash.
1525
1526             $language = $extensions{$extension};
1527
1528             if (!defined($language)) {
1529               printf(STDERR "%s: Unknown or unsupported file type!\n", $file);
1530               $status++;
1531               next SOURCEFILE;
1532             }
1533           }
1534
1535           # Attempt to open the file
1536
1537           if (!open(STDIN, $file)) {
1538             printf(STDERR "%s: Cannot open!\n", $file);
1539             $status++;
1540             next SOURCEFILE;
1541           }
1542
1543           # Style check the file, note the status and close the stream
1544
1545           $status += style($file, $language);
1546           close(STDIN);
1547         }
1548
1549   } else {
1550     $status += style("<standard input>", $language);
1551   }
1552
1553   # If the caller invoked with '-Werror', return the accumulated
1554   # status; otherwise, return zero (0).
1555
1556   exit($warnings{"error"} ? $status : 0);
1557 }