bin/mlint

   1 #!/usr/bin/perl
   2
   3 BEGIN { $ENV{LC_ALL} = "C"; }
   4
   5 use FindBin;
   6 use Getopt::Std;
   7
   8 $p5_metaconfig_base = "$FindBin::Bin/../";
   9 chdir "$p5_metaconfig_base/perl" ||
  10     die "perl/ directory missing in $p5_metaconfig_base\n";
  11
  12 -l '.package' && -l 'U' or
  13     die ".package and U should be symlinks as per README\n";
  14
  15 # $Id: mlint.SH 22 2008-05-28 08:01:59Z rmanfredi $
  16 #
  17 #  Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
  18 #
  19 #  You may redistribute only under the terms of the Artistic Licence,
  20 #  as specified in the README file that comes with the distribution.
  21 #  You may reuse parts of this distribution only within the terms of
  22 #  that same Artistic Licence; a copy of which may be found at the root
  23 #  of the source tree for dist 4.0.
  24 #
  25 # Original Author: Harlan Stenn <harlan@mumps.pfcs.com>
  26 #
  27 # $Log: mlint.SH,v $
  28 # Revision 3.0.1.3  1994/05/06  15:20:42  ram
  29 # patch23: added -L switch to override public unit repository path
  30 #
  31 # Revision 3.0.1.2  1994/01/24  14:21:00  ram
  32 # patch16: added ~/.dist_profile awareness
  33 #
  34 # Revision 3.0.1.1  1993/08/19  06:42:27  ram
  35 # patch1: leading config.sh searching was not aborting properly
  36 #
  37 # Revision 3.0  1993/08/18  12:10:17  ram
  38 # Baseline for dist 3.0 netwide release.
  39 #
  40
  41 # Perload ON
  42
  43 $MC = "$p5_metaconfig_base/dist";
  44 $version = '3.5';
  45 $patchlevel = '0';
  46 $grep = '/usr/bin/grep';
  47 &profile;                                               # Read ~/.dist_profile
  48 &usage unless getopts("hklVL:oOs");
  49
  50 if ($opt_V) {
  51         print STDERR "metalint $version PL$patchlevel\n";
  52         exit 0;
  53 } elsif ($opt_h) {
  54         &usage;
  55 }
  56
  57 chop($date = `date`);
  58 $MC = $opt_L if $opt_L;                 # May override library path
  59 $MC = &tilda_expand($MC);               # ~name expansion
  60 chop($WD = `pwd`);                              # Working directory
  61 chdir $MC || die "Can't chdir to $MC: $!\n";
  62 chop($MC = `pwd`);                              # Real metalint lib path (no symbolic links)
  63 chdir $WD || die "Can't chdir back to $WD: $!\n";
  64
  65 &init;                                                                  # Various initializations
  66 `mkdir .MT 2>&1` unless -d '.MT';               # For private temporary files
  67
  68 &locate_units;                          # Fill in @ARGV with a unit list
  69 &extract_dependencies;          # Extract dependencies from units
  70 &sanity_checks;                         # Perform sanity checks
  71
  72 if ($opt_k) {
  73         print "Leaving subdirectory .MT unremoved so you can peruse it.\n"
  74                 unless $opt_s;
  75 } else {
  76         `rm -rf .MT 2>&1`;
  77 }
  78 print "Done.\n" unless $opt_s;
  79
  80 # General initializations
  81 sub init {
  82         &init_except;                   # Token which have upper-cased letters
  83         &init_depend;                   # The %Depend array records control line handling
  84 }
  85
  86 # Record the exceptions -- all symbols but these are lower case
  87 sub init_except {
  88         $Except{'Author'}++;
  89         $Except{'Date'}++;
  90         $Except{'Header'}++;
  91         $Except{'Id'}++;
  92         $Except{'Locker'}++;
  93         $Except{'Log'}++;
  94         $Except{'RCSfile'}++;
  95         $Except{'Revision'}++;
  96         $Except{'Source'}++;
  97         $Except{'State'}++;
  98 }
  99
 100 # Print out metalint's usage and exits
 101 sub usage {
 102         print STDERR <<EOM;
 103 Usage: metalint [-hklsV] [-L dir]
 104   -h : print this help message and exits.
 105   -k : keep temporary directory.
 106   -l : also report problems from library units.
 107   -s : silent mode.
 108   -L : specify main units repository.
 109   -V : print version number and exits.
 110 EOM
 111         exit 1;
 112 }
 113
 114 package locate;
 115
 116 # Locate the units and push their path in @ARGV (sorted alphabetically)
 117 sub main'locate_units {
 118         print "Locating units...\n" unless $main'opt_s;
 119         local(*WD) = *main'WD;                  # Current working directory
 120         local(*MC) = *main'MC;                  # Public metaconfig library
 121         undef %myUlist;                                 # Records private units paths
 122         undef %myUseen;                                 # Records private/public conflicts
 123         &private_units;                                 # Locate private units in @myUlist
 124         &public_units;                                  # Locate public units in @ARGV
 125         @ARGV = sort @ARGV;                             # Sort it alphabetically
 126         push(@ARGV, sort @myUlist);             # Append user's units sorted
 127         &dump_list if $main'opt_v;              # Dump the list of units
 128 }
 129
 130 # Dump the list of units on stdout
 131 sub dump_list {
 132         print "\t";
 133         $, = "\n\t";
 134         print @ARGV;
 135         $, = '';
 136         print "\n";
 137 }
 138
 139 # Scan private units
 140 sub private_units {
 141         return unless -d 'U';                   # Nothing to be done if no 'U' entry
 142         local(*ARGV) = *myUlist;                # Really fill in @myUlist
 143         local($MC) = $WD;                               # We are really in the working directory
 144         &units_path("U");                               # Locate units in the U directory
 145         local($unit_name);                              # Unit's name (without .U)
 146         local(@kept);                                   # Array of kept units
 147         # Loop over the units and remove duplicates (the first one seen is the one
 148         # we keep). Also set the %myUseen H table to record private units seen.
 149         foreach (@ARGV) {
 150                 ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
 151                 next if $myUseen{$unit_name};   # Already recorded
 152                 $myUseen{$unit_name} = 1;               # Record pirvate unit
 153                 push(@kept, $_);                                # Keep this unit
 154         }
 155         @ARGV = @kept;
 156 }
 157
 158 # Scan public units
 159 sub public_units {
 160         chdir($MC) || die "Can't find directory $MC.\n";
 161         &units_path("U");                               # Locate units in public U directory
 162         chdir($WD) || die "Can't go back to directory $WD.\n";
 163         local($path);                                   # Relative path from $WD
 164         local($unit_name);                              # Unit's name (without .U)
 165         local(*Unit) = *main'Unit;              # Unit is a global from main package
 166         local(@kept);                                   # Units kept
 167         local(%warned);                                 # Units which have already issued a message
 168         # Loop over all the units and keep only the ones that were not found in
 169         # the user's U directory. As it is possible two or more units with the same
 170         # name be found in
 171         foreach (@ARGV) {
 172                 ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path
 173                 next if $warned{$unit_name};    # We have already seen this unit
 174                 $warned{$unit_name} = 1;                # Remember we have warned the user
 175                 if ($myUseen{$unit_name}) {             # User already has a private unit
 176                         $path = $Unit{$unit_name};      # Extract user's unit path
 177                         next if $path eq $_;            # Same path, we must be in mcon/
 178                         $path =~ s|^$WD/||o;            # Weed out leading working dir path
 179                         $::opt_O and next;
 180                         print "    Your private $path overrides the public one.\n"
 181                                 unless $main'opt_s;
 182                 } else {
 183                         push(@kept, $_);                        # We may keep this one
 184                 }
 185         }
 186         @ARGV = @kept;
 187 }
 188
 189 # Recursively locate units in the directory. Each file ending with .U has to be
 190 # a unit. Others are stat()'ed, and if they are a directory, they are also
 191 # scanned through. The $MC and @ARGV variable are dynamically set by the caller.
 192 sub units_path {
 193         local($dir) = @_;                                       # Directory where units are to be found
 194         local(@contents);                                       # Contents of the directory
 195         local($unit_name);                                      # Unit's name, without final .U
 196         local($path);                                           # Full path of a unit
 197         local(*Unit) = *main'Unit;                      # Unit is a global from main package
 198         unless (opendir(DIR, $dir)) {
 199                 warn("Cannot open directory $dir.\n");
 200                 return;
 201         }
 202         print "Locating in $MC/$dir...\n" if $main'opt_v;
 203         @contents = readdir DIR;                        # Slurp the whole thing
 204         closedir DIR;                                           # And close dir, ready for recursion
 205         foreach (@contents) {
 206                 next if $_ eq '.' || $_ eq '..';
 207                 if (/\.U$/) {                                   # A unit, definitely
 208                         ($unit_name) = /^(.*)\.U$/;
 209                         $path = "$MC/$dir/$_";                          # Full path of unit
 210                         push(@ARGV, $path);                                     # Record its path
 211                         if (defined $Unit{$unit_name}) {        # Already seen this unit
 212                                 if ($main'opt_v) {
 213                                         ($path) = $Unit{$unit_name} =~ m|^(.*)/.*|;
 214                                         print "    We've already seen $unit_name.U in $path.\n";
 215                                 }
 216                         } else {
 217                                 $Unit{$unit_name} = $path;              # Map name to path
 218                         }
 219                         next;
 220                 }
 221                 # We have found a file which does not look like a unit. If it is a
 222                 # directory, then scan it. Otherwise skip the file.
 223                 unless (-d "$dir/$_") {
 224                         print "    Skipping file $_ in $dir.\n" if $main'opt_v;
 225                         next;
 226                 }
 227                 &units_path("$dir/$_");
 228                 print "Back to $MC/$dir...\n" if $main'opt_v;
 229         }
 230 }
 231
 232 package main;
 233
 234 # Initialize the extraction process by setting some variables.
 235 # We return a string to be eval'ed to do more customized initializations.
 236 sub init_extraction {
 237         $c_symbol = '';                         # Current symbol seen in ?C: lines
 238         $s_symbol = '';                         # Current symbol seen in ?S: lines
 239         $m_symbol = '';                         # Current symbol seen in ?M: lines
 240         $h_section = 0;                         # 0 = no ?H: yet, 1 = in ?H:, 2 = ?H:. seen
 241         $h_section_warned = 0;          # Whether we warned about terminated ?H: section
 242         $heredoc = '';                          # Last "here" document symbol seen
 243         $heredoc_nosubst = 0;           # True for <<'EOM' here docs
 244         $heredoc_line = 0;                      # Line were last "here" document started
 245         $last_interpreted = 0;          # True when last line was an '@' one
 246         $past_first_line = 0;           # True when first body line was already seen
 247         $wiped_unit = 0;                        # True if unit will be "wiped" for macro subst
 248         %csym = ();                                     # C symbols described
 249         %ssym = ();                                     # Shell symbols described
 250         %hcsym = ();                            # C symbols used by ?H: lines
 251         %hssym = ();                            # Shell symbols used by ?H: lines
 252         %msym = ();                                     # Magic symbols defined by ?M: lines
 253         %mdep = ();                                     # C symbol dependencies introduced by ?M:
 254         %symset = ();                           # Records all the shell symbol set
 255         %symused = ();                          # Records all the shell symbol used
 256         %tempseen = ();                         # Temporary shell variable seen
 257         %fileseen = ();                         # Produced files seen
 258         %fileused = ();                         # Files used, by unit (private UU files)
 259         %filemisused = ();                      # Files not used as ./file or ...UU/file
 260         %filetmp = ();                          # Local temporary files in ?F: directives
 261         %filesetin = ();                        # Lists units defining a temporary file
 262         %filecreated = ();                      # Records files created in this unit
 263         %prodfile = ();                         # Unit where a given file is said to be created
 264         %defseen = ();                          # Symbol defintions claimed
 265         %lintset = ();                          # Symbols declared set by a ?LINT: line
 266         %lintsdesc = ();                        # Symbols declared described by a ?LINT: line
 267         %lintcdesc = ();                        # Symbols declared described by a ?LINT: line
 268         %lintseen = ();                         # Symbols declared known by a ?LINT: line
 269         %lintchange = ();                       # Symbols declared changed by a ?LINT: line
 270         %lintuse = ();                          # Symbols declared used by unit
 271         %lintextern = ();                       # Symbols known to be externally defined
 272         %lintcreated = ();                      # Files declared as created by a ?LINT: line
 273         %linthere = ();                         # Unclosed here document from ?LINT: line
 274         %lintnothere = ();                      # False here document names, from ?LINT: line
 275         %lintfused = ();                        # Records files markedas used in ?LINT: line
 276         %lintchange_used = ();          # Tracks symbols for which %lintchange was used
 277         %lintuse_used = ();                     # Tracks symbols for which %lintuse was used
 278         %lintseen_used = ();            # Tracks symbols for which %lintseen was used
 279         %lintcdesc_used = ();           # Tracks symbols for which %lintcdesc was used
 280         %lintsdesc_used = ();           # Tracks symbols for which %lintsdesc was used
 281         %lintset_used = ();                     # Tracks symbols for which %lintset was used
 282         %lintnocomment = ();            # Signals it's OK for unit to lack a : comment
 283         %condsym = ();                          # Records all the conditional symbols
 284         %condseen = ();                         # Records conditional dependencies
 285         %depseen = ();                          # Records full dependencies
 286         %shvisible = ();                        # Records units making a symbol visible
 287         %shspecial = ();                        # Records special units listed as wanted
 288         %shdepend = ();                         # Records units listed in one's dependency list
 289         %shmaster = ();                         # List of units defining a shell symbol
 290         %cmaster = ();                          # List of units defining a C symbol
 291         %symdep = ();                           # Records units where symbol is a dependency
 292         @make = ();                                     # Records make dependency lines
 293         $body = 'p_body';                       # Procedure to handle body
 294         $ending = 'p_end';                      # Called at the end of each unit
 295         @wiping = qw(                           # The keywords we recognize for "wiped" units
 296                 PACKAGENAME
 297                 MAINTLOC
 298                 VERSION
 299                 PATCHLEVEL
 300                 DATE
 301                 BASEREV
 302         );
 303 }
 304
 305 # End the extraction process
 306 sub end_extraction {
 307 }
 308
 309 # Process the command line of ?MAKE: lines
 310 sub p_make_command {
 311         local ($_) = @_;
 312         my $where = "\"$file\", line $. (?MAKE:)";
 313         unless (s/^\t+//) {
 314                 warn "$where: command line must start with a leading TAB character.\n";
 315                 s/^\s+//;                               # Remove spaces and continue
 316         }
 317         return unless s/^-?pick\b//;
 318         # Validate the special "pick" make command, processed internally
 319         # by metaconfig.
 320         my %valid = map { $_ => 1 } qw(
 321                 add add.Config_sh add.Null
 322                 c_h_weed cm_h_weed close.Config_sh
 323                 prepend weed wipe
 324
 325         );
 326         my $cmd;
 327         $cmd = $1 if s/^\s+(\S+)//;
 328         unless (defined $cmd) {
 329                 warn "$where: pick needs a command argument.\n";
 330                 return;
 331         }
 332         $wiped_unit++ if $cmd eq 'wipe';
 333         warn "$where: unknown pick command '$cmd'.\n" unless $valid{$cmd};
 334         s/^\s+//;
 335         unless (s/^\$\@//) {
 336                 warn "$where: third pick argument must be \$\@\n";
 337                 return;
 338         }
 339         s/^\s+//;
 340         my $target;
 341         $target = $1 if s/^(\S+)//;
 342         unless (defined $target) {
 343                 warn "$where: fourth pick argument is missing\n";
 344                 return;
 345         }
 346         return if $target =~ m|^\./|;
 347         warn "$where: weird fourth argument '$target' to pick.\n"
 348                 unless $target =~ /^\w+$/;
 349 }
 350
 351 # Process the ?MAKE: line
 352 sub p_make {
 353         local($_) = @_;
 354         local(@ary);                                    # Locally defined symbols
 355         local(@dep);                                    # Dependencies
 356         local($where) = "\"$file\", line $. (?MAKE:)";
 357         unless (/^[\w+ ]*:/) {
 358                 &p_make_command;
 359                 return;                                         # We only want the main dependency rule
 360         }
 361         warn "$where: ignoring duplicate dependency listing line.\n"
 362                 if $makeseen{$unit}++;
 363         return if $makeseen{$unit} > 1;
 364
 365         # Reset those once for every unit
 366         # (assuming there is only one depend line)
 367         $h_section = 0;                         # 0 = no ?H: yet, 1 = in ?H:, 2 = ?H:. seen
 368         $h_section_warned = 0;          # Whether we warned about terminated ?H: section
 369         $wiped_unit = 0;                        # Whether macros like "<MAINTLOC> will be wiped
 370         undef %condseen;
 371         undef %depseen;
 372         undef %defseen;
 373         undef %tempseen;
 374         undef %symset;
 375         undef %symused;
 376         undef %csym;
 377         undef %ssym;
 378         undef %hcsym;
 379         undef %hssym;
 380         undef %lintuse;
 381         undef %lintuse_used;
 382         undef %lintseen;
 383         undef %lintchange;
 384         undef %lintchange_used;
 385         undef %lintextern;
 386         undef %lintcreated;
 387         undef %fileseen;
 388         undef %lintseen_used;
 389         undef %filetmp;
 390         undef %filecreated;
 391         undef %linthere;
 392         undef %lintnothere;
 393         undef %lintfused;
 394         undef %lintsdesc;
 395         undef %lintsdesc_used;
 396         undef %lintcdesc;
 397         undef %lintcdesc_used;
 398         undef %lintset;
 399         undef %lintset_used;
 400
 401         s|^\s*||;                                               # Remove leading spaces
 402         chop;
 403         s/:(.*)//;
 404         @dep = split(' ', $1);                  # Dependencies
 405         @ary = split(' ');                              # Locally defined symbols
 406         local($nowarn);                                 # True when +Special is seen
 407         foreach $sym (@ary) {
 408                 # Ignore "internal use only" symbols as far as metalint goes.
 409                 # Actually, we record the presence of a '+' in front of a special
 410                 # unit name and use that as a hint to suppress the presence of that
 411                 # special unit in the defined symbol section.
 412                 $nowarn = ($sym =~ s/^\+//);
 413
 414                 # We record for each shell symbol the list of units which claim to make
 415                 # it, so as to report duplicates.
 416                 if ($sym =~ /^[_a-z]/ || $Except{$sym}) {
 417                         $shmaster{"\$$sym"} .= "$unit ";
 418                         ++$defseen{$sym};
 419                 } else {
 420                         warn "$where: special unit '$sym' should not be listed as made.\n"
 421                                 unless $sym eq $unit || $nowarn;
 422                 }
 423         }
 424         # Record dependencies for later perusal
 425         push(@make, join(' ', @ary) . ':' . join(' ', @dep));
 426         foreach $sym (@dep) {
 427                 if ($sym =~ /^\+[_A-Za-z]/) {
 428                         $sym =~ s|^\+||;
 429                         ++$condseen{$sym};              # Conditional symbol wanted
 430                         ++$condsym{$sym};               # %condsym has a greater lifetime
 431                 } else {
 432                         ++$depseen{$sym};               # Full dependency
 433                 }
 434
 435                 # Each 'wanted' special unit (i.e. one starting with a capital letter)
 436                 # is remembered, so as to prevent exported symbols from being reported
 437                 # as "undefined". For instance, Myread exports $dflt, $ans and $rp.
 438                 $shspecial{$unit} .= "$sym " if substr($sym, 0, 1) =~ /^[A-Z]/;
 439
 440                 # Record all known dependencies (special or not) for this unit
 441                 $shdepend{$unit} .= "$sym ";
 442
 443                 # Remember where wanted symbol is defined, so that we can report
 444                 # stale dependencies later on (i.e. dependencies which refer to non-
 445                 # existent symbols).
 446                 $symdep{$sym} .= "$unit ";      # This symbol is wanted here
 447         }
 448         # Make sure we do not want a symbol twice, nor do we want it once as a full
 449         # dependency and once as a conditional dependency.
 450         foreach $sym (@dep) {
 451                 if ($sym =~ /^\+[_A-Za-z]/) {
 452                         $sym =~ s|^\+||;
 453                         warn "$where: '+$sym' is listed $condseen{$sym} times.\n"
 454                                 if $condseen{$sym} > 1;
 455                         $condseen{$sym} = 1 if $condseen{$sym}; # Avoid multiple messages
 456                 } else {
 457                         warn "$where: '$sym' is listed $depseen{$sym} times.\n"
 458                                 if $depseen{$sym} > 1;
 459                         $depseen{$sym} = 1 if $depseen{$sym};   # Avoid multiple messages
 460                 }
 461                 warn "$where: '$sym' listed as both conditional and full dependency.\n"
 462                         if $condseen{$sym} && $depseen{$sym};
 463         }
 464         # Make sure every unit "inherits" from the symbols exported by 'Init'.
 465         $shspecial{$unit} .= 'Init ' unless $shspecial{$unit} =~ /Init\b/;
 466 }
 467
 468 # Process the ?O: line
 469 sub p_obsolete {
 470         local($_) = @_;
 471         chop;
 472         $Obsolete{"$unit.U"} = $_;              # Message to print if unit is used
 473 }
 474
 475 # Process the ?S: lines
 476 sub p_shell {
 477         local($_) = @_;
 478         local($where) = "\"$file\", line $. (?S:)";
 479         warn "$where: directive should come after ?MAKE declarations.\n"
 480                 unless $makeseen{$unit};
 481         if (/^(\w+)\s*(\(.*\))*\s*:/) {
 482                 &check_last_declaration;
 483                 $s_symbol = $1;
 484                 print "  ?S: $s_symbol\n" if $opt_d;
 485                 # Make sure we do not define symbol twice and that the symbol is indeed
 486                 # listed in the ?MAKE: line.
 487                 warn "$where: duplicate description for variable '\$$s_symbol'.\n"
 488                         if $ssym{$s_symbol}++;
 489                 unless ($defseen{$s_symbol}) {
 490                         warn "$where: variable '\$$s_symbol' is not listed " .
 491                                 "on ?MAKE: line.\n" unless $lintseen{$s_symbol};
 492                         $lintseen_used{$s_symbol}++ if $lintseen{$s_symbol};
 493                 }
 494                 # Deal with obsolete symbol list (enclosed between parenthesis)
 495                 &record_obsolete("\$$_") if /\(/;
 496         } else {
 497                 unless ($s_symbol) {
 498                         warn "$where: syntax error in ?S: construct.\n";
 499                         return;
 500                 }
 501         }
 502
 503         m|^\.\s*$| && ($s_symbol = '');         # End of comment
 504 }
 505
 506 # Process the ?C: lines
 507 sub p_c {
 508         local($_) = @_;
 509         local($where) = "\"$file\", line $. (?C:)";
 510         warn "$where: directive should come after ?MAKE declarations.\n"
 511                 unless $makeseen{$unit};
 512         # The previous ?H: section, if present, must have been closed
 513         if ($h_section && $h_section != 2) {
 514                  warn "$where: unclosed ?H: section.\n";
 515         }
 516         $h_section = 0;
 517         if (s/^(\w+)\s*~\s*(\S+)\s*(.*):/$1 $3:/) {
 518                 &check_last_declaration;
 519                 $c_symbol = $2;                                 # Alias for definition in config.h
 520                 # Record symbol definition for further duplicate spotting
 521                 $cmaster{$1} .= "$unit " unless $csym{$1};
 522                 print "  ?C: $1 ~ $c_symbol\n" if $opt_d;
 523                 # Make sure we do not define symbol twice
 524                 warn "$where: duplicate description for symbol '$1'.\n"
 525                         if $csym{$1}++;
 526                 # Deal with obsolete symbol list (enclosed between parenthesis)
 527                 &record_obsolete("$_") if /\(/;
 528         } elsif (/^(\w+)\s*(\(.*\))*\s*:/) {
 529                 &check_last_declaration;
 530                 $c_symbol = $1;
 531                 # Record symbol definition for further duplicate spotting
 532                 $cmaster{$c_symbol} .= "$unit " unless $csym{$c_symbol};
 533                 print "  ?C: $c_symbol\n" if $opt_d;
 534                 # Make sure we do not define symbol twice
 535                 warn "$where: duplicate description for symbol '$c_symbol'.\n"
 536                         if $csym{$c_symbol}++;
 537                 # Deal with obsolete symbol list (enclosed between parenthesis)
 538                 &record_obsolete("$_") if /\(/;
 539         } else {
 540                 unless ($c_symbol) {
 541                         warn "$where: syntax error in ?C: construct.\n";
 542                         return;
 543                 }
 544         }
 545
 546         s|^(\w+)|?$c_symbol:/* $1| ||                                                   # Start of comment
 547         (s|^\.\s*$|?$c_symbol: */\n| && ($c_symbol = '', 1)) || # End of comment
 548         s|^(.*)|?$c_symbol: *$1|;                                                               # Middle of comment
 549 }
 550
 551 # Process the ?H: lines
 552 sub p_config {
 553         local($_) = @_;
 554         local($where) = "\"$file\", line $. (?H)" unless $where;
 555         warn "$where: directive should come after ?MAKE declarations.\n"
 556                 unless $makeseen{$unit};
 557         unless ($h_section){                            # Entering ?H: section
 558                 $h_section = 1;
 559                 $h_section_warned = 0;
 560         }
 561         if ($h_section == 2) {
 562                 warn "$where: section was already terminated by '?H:.'.\n"
 563                         unless $h_section_warned++;
 564                 return;
 565         }
 566         if ($_ eq ".\n") {
 567                 $h_section = 2;                                 # Marks terminated ?H: section
 568                 return;
 569         }
 570         (my $constraint) = m/^\?(\w+):/;
 571         s/^\?\w+://;                                            # Remove leading '?var:' constraint
 572         if (m|^#\$(\w+)\s+(\w+).*\$(\w+)|) {
 573                 # Case: #$d_var VAR "$var"
 574                 warn "$where: symbol '$2' was already defined.\n" if $hcsym{$2}++;
 575                 &check_definition("$1");
 576                 &check_definition("$3");
 577         } elsif (m|^#define\s+(\w+)\((.*)\)\s+\$(\w+)|) {
 578                 # Case: #define VAR(x) $var
 579                 warn "$where: symbol '$1' was already defined.\n" if $hcsym{$1}++;
 580                 &check_definition("$3");
 581         } elsif (m|^#\$define\s+(\w+)|) {
 582                 # Case: #$define VAR
 583                 warn "$where: symbol '$1' was already defined.\n" if $hcsym{$1}++;
 584         } elsif (m|^#\$(\w+)\s+(\w+)|) {
 585                 # Case: #$d_var VAR
 586                 warn "$where: symbol '$2' was already defined.\n" if $hcsym{$2}++;
 587                 &check_definition("$1");
 588         } elsif (m|^#define\s+(\w+).*\$(\w+)|) {
 589                 # Case: #define VAR "$var"
 590                 warn "$where: symbol '$1' was already defined.\n" if $hcsym{$1}++;
 591                 &check_definition("$2");
 592         } elsif (m|^#define\s+(\w+)|) {
 593                 # Case: #define VAR
 594                 $hcsym{$1}++;                   # Multiple occurrences may be legitimate
 595         } else {
 596                 if (/^#/) {
 597                         warn "$where: uncommon cpp line should be protected with '?%<:'.\n"
 598                                 if $constraint eq '';
 599                 } elsif (!/^\@(if|elsif|else|end)\b/) {
 600                         warn "$where: line should not be listed here but in '?C:'.\n";
 601                 }
 602         }
 603
 604         # Ensure the constraint is either %< (unit base name) or a known symbol.
 605         if ($constraint ne '' && $constraint ne $unit) {
 606                 warn "$where: constraint '$constraint' is an unknown symbol.\n"
 607                                 unless $csym{$constraint} || $ssym{$constraint};
 608         }
 609 }
 610
 611 # Process the ?M: lines
 612 sub p_magic {
 613         local($_) = @_;
 614         local($where) = "\"$file\", line $. (?M)";
 615         warn "$where: directive should come after ?MAKE declarations.\n"
 616                 unless $makeseen{$unit};
 617         if (/^(\w+):\s*([\w\s]*)\n$/) {
 618                 &check_last_declaration;
 619                 $m_symbol = $1;
 620                 $msym{$1} = "$unit";    # p_wanted ensure we do not define symbol twice
 621                 $mdep{$1} = $2;                 # Save C symbol dependencies
 622                 &p_wanted("$unit:$m_symbol");
 623         } else {
 624                 unless ($m_symbol) {
 625                         warn "$where: syntax error in ?M: construct.\n";
 626                         return;
 627                 }
 628         }
 629         m|^\.\s*$| && ($m_symbol = '');         # End of comment
 630 }
 631
 632 # Process the ?INIT: lines
 633 sub p_init {
 634         local($_) = @_;
 635         local($where) = "\"$file\", line $. (?INIT)";
 636         warn "$where: directive should come after ?MAKE declarations.\n"
 637                 unless $makeseen{$unit};
 638         &p_body($_, 1);         # Pass it along as a body line (leading ?INIT: removed)
 639 }
 640
 641 # Process the ?D: lines
 642 sub p_default {
 643         local($_) = @_;
 644         local($where) = "\"$file\", line $. (?D)";
 645         warn "$where: directive should come after ?MAKE declarations.\n"
 646                 unless $makeseen{$unit};
 647         local($sym) = /^(\w+)=/;
 648         $hasdefault{$sym}++;
 649         unless ($defseen{$sym}) {
 650                 warn "$where: variable '\$$sym' is not listed " .
 651                         "on ?MAKE: line.\n" unless $lintseen{$sym};
 652                 $lintseen_used{$sym}++ if $lintseen{$sym};
 653         }
 654         s/^\w+=//;              # So that p_body does not consider variable as being set
 655         &p_body($_, 1); # Pass it along as a body line (leading ?D: + var removed)
 656 }
 657
 658 # Process the ?V: lines
 659 sub p_visible {
 660         local($where) = "\"$file\", line $. (?V)";
 661         warn "$where: directive should come after ?MAKE declarations.\n"
 662                 unless $makeseen{$unit};
 663
 664         # A visible symbol can freely be manipulated by any unit which includes the
 665         # current unit in its dependencies. Symbols before ':' may be only used for
 666         # reading while symbols after ':' may be used for both reading and writing.
 667         # The array %shvisible records symbols as keys. Read-only symbols have a
 668         # leading '$' while read-write symbols are recorded as-is.
 669
 670         unless (substr($unit, 0, 1) =~ /^[A-Z]/) {
 671                 warn "$where: visible declaration in non-special unit ignored.\n";
 672                 return;
 673         }
 674         local($read_only) = $_[0] =~ /^([^:]*):?/;
 675         local($read_write) = $_[0] =~ /:(.*)/;
 676         local(@rsym) = split(' ', $read_only);
 677         local(@rwsym) = split(' ', $read_write);
 678         local($w);
 679         foreach (@rsym) {               # Read only symbols
 680                 warn "$where: wanted variable '\$$_' made visible.\n" if &wanted($_);
 681                 warn "$where: defined variable '\$$_' made visible.\n"
 682                         if &defined($_) && !$lintseen{$_};
 683                 $w = $shvisible{"\$$_"};
 684                 warn "$where: variable '\$$_' already made visible by unit $w.\n" if $w;
 685                 $w = $shvisible{$_};
 686                 warn "$where: variable '\$$_' already read-write visible in $w.\n" if $w;
 687                 $shvisible{"\$$_"} = $unit unless $w;
 688         }
 689         foreach (@rwsym) {              # Read/write symbols
 690                 warn "$where: wanted variable '\$$_' made visible.\n" if &wanted($_);
 691                 warn "$where: defined variable '\$$_' made visible.\n"
 692                         if &defined($_) && !$lintseen{$_};
 693                 $w = $shvisible{$_};
 694                 warn "$where: variable '\$$_' already made visible by unit $w.\n" if $w;
 695                 $w = $shvisible{"\$$_"};
 696                 warn "$where: variable '\$$_' already read-only visible in $w.\n" if $w;
 697                 $shvisible{$_} = $unit unless $w;
 698         }
 699 }
 700
 701 # Process the ?W: lines
 702 sub p_wanted {
 703         local($where) = "\"$file\", line $. (?W)" unless $where;
 704         warn "$where: directive should come after ?MAKE declarations.\n"
 705                 unless $makeseen{$unit};
 706         # Somehow, we should check that none of the symbols to activate are stale
 707         # ones, i.e. they all finally resolve to some known target -- FIXME
 708         local($active) = $_[0] =~ /^([^:]*):/;          # Symbols to activate
 709         local($look_symbols) = $_[0] =~ /:(.*)/;        # When those are used
 710         local(@symbols) = split(' ', $look_symbols);
 711         # A "?W:symbol" line asks metaconfig to define 'symbol' in the wanted file
 712         # as a C target iff that word is found within the sources. This is mainly
 713         # intended for the built-in interpreter to check for definedness.
 714         local($w);
 715         foreach (@symbols) {
 716                 warn "$where: variable '\$$_' already wanted.\n" if &wanted($_);
 717                 warn "$where: variable '\$$_' also locally defined.\n" if &defined($_);
 718                 $w = $cwanted{$_};
 719                 if ($msym{$_} ne '') {
 720                         warn "$where: symbol '$_' already listed on a ?M: line in '$w'.\n"
 721                                 if $w;
 722                 } else {
 723                 warn "$where: variable '\$$_' already listed on a ?W: line in '$w'.\n"
 724                         if $w;
 725                 }
 726                 $cwanted{$_} = $unit unless $w;
 727         }
 728 }
 729
 730 # Process the ?Y: lines
 731 sub p_layout {
 732         local($where) = "\"$file\", line $. (?Y)";
 733         warn "$where: directive should come after ?MAKE declarations.\n"
 734                 unless $makeseen{$unit};
 735         local($_) = @_;
 736         chop;
 737         s/^\s+//;
 738         tr/A-Z/a-z/;                    # Layouts are record in lowercase
 739         warn "$where: unknown layout directive '$_'.\n"
 740                 unless defined $Lcmp{$_};
 741 }
 742
 743 # Process the ?P: lines
 744 sub p_public {
 745         # FIXME
 746 }
 747
 748 # Process the ?L: lines
 749 sub p_library {
 750         # There should not be any '-l' in front of the library name
 751         # FIXME
 752 }
 753
 754 # Process the ?I: lines
 755 sub p_include {
 756         # FIXME
 757 }
 758
 759 # Process the ?T: lines
 760 sub p_temp {
 761         local($where) = "\"$file\", line $. (?T:)";
 762         warn "$where: directive should come after ?MAKE declarations.\n"
 763                 unless $makeseen{$unit};
 764         local($_) = @_;
 765         local(@sym) = split(' ', $_);
 766         foreach $sym (@sym) {
 767                 warn "$where: temporary symbol '\$$sym' multiply declared.\n"
 768                         if $tempseen{$sym}++ == 1;
 769                 $tempmaster{$sym} .= "$unit " if $tempseen{$sym} == 1;
 770         }
 771 }
 772
 773 # Process the ?F: lines
 774 sub p_file {
 775         local($where) = "\"$file\", line $. (?F:)";
 776         warn "$where: directive should come after ?MAKE declarations.\n"
 777                 unless $makeseen{$unit};
 778         local($_) = @_;
 779         local(@files) = split(' ', $_);
 780         local($uufile);                                 # Name of file produced in the UU directory
 781         local($tmpfile);                                # Name of a temporary file
 782         # We care only about UU files, i.e. files produced in the UU directory
 783         # and which are identified by the convention ./filename. Files !filename
 784         # are not produced, i.e. they are temporary or externally provided.
 785         # The %prodfile table records all the files produced, so we may detect
 786         # inconsistencies between units, while %filemaster records the (first) unit
 787         # defining a given UU file to make sure that (special) unit is named in the
 788         # dependency line when that UU file if used. Duplicates will be caught in
 789         # the sanity check phase thanks to %prodfile.
 790         # Temporary files are recorded in %filesetin, so that we may later compare
 791         # the list with the UU files to detect possible overwrites.
 792         my $is_special = substr($unit, 0, 1) =~ /^[A-Z]/;
 793         foreach $file (@files) {
 794                 warn "$where: produced file '$file' multiply declared.\n"
 795                         if $fileseen{$file}++ == 1;
 796                 if (($tmpfile = $file) =~ s/^!//) {
 797                         $filetmp{$tmpfile} = 'x ';
 798                         $filesetin{$tmpfile} .= "$unit " if $fileseen{$file} == 1;
 799                         next;                                   # Is not a UU file for sure, so skip
 800                 }
 801                 $prodfile{$file} .= "$unit " if $fileseen{$file} == 1;
 802                 ($uufile = $file) =~ s|^\./(\S+)$|$1|;
 803                 next if $file eq $uufile;       # Don't care about non-UU files
 804                 unless ($is_special || $lintcreated{$uufile}) {
 805                         warn "$where: UU file '$uufile' in non-special unit ignored.\n";
 806                         delete $lintcreated{$uufile};   # Detect spurious LINT
 807                         next;
 808                 }
 809                 delete $lintcreated{$uufile} if !$is_special;   # Detect spurious LINT
 810                 $filemaster{$uufile} = $unit unless defined $filemaster{$uufile};
 811                 $filecreated{$uufile} = 'a';    # Will be automagically incremented
 812         }
 813 }
 814
 815 # Process the ?LINT: lines
 816 sub p_lint {
 817         local($_) = @_;
 818         local(@sym);
 819         local($where) = "\"$file\", line $. (?LINT:)";
 820         s/^\s+//;                                               # Strip leading spaces
 821         unless ($makeseen{$unit}) {
 822                 warn "$where: directive should come after ?MAKE declarations.\n"
 823                         unless m/^empty/;
 824         }
 825         if (s/^set//) {                                 # Listed variables are set
 826                 @sym = split(' ', $_);          # Spurious ones will be flagged
 827                 foreach (@sym) {
 828                         $lintset{$_}++;                 # Shell variable set
 829                 }
 830         } elsif (s/^desc\w+//) {                # Listed shell variables are described
 831                 @sym = split(' ', $_);          # Spurious ones will be flagged
 832                 foreach (@sym) {
 833                         $lintsdesc{$_}++;               # Shell variable described
 834                 }
 835         } elsif (s/^creat\w+//) {               # Listed created files in regular units
 836                 @sym = split(' ', $_);
 837                 foreach (@sym) {
 838                         $lintcreated{$_}++;             # Persistent UU file created
 839                 }
 840         } elsif (s/^known//) {                  # Listed C variables are described
 841                 @sym = split(' ', $_);          # Spurious ones will be flagged
 842                 foreach (@sym) {
 843                         $lintcdesc{$_}++;               # C symbol described
 844                 }
 845         } elsif (s/^change//) {                 # Shell variable ok to be changed
 846                 @sym = split(' ', $_);          # Spurious ones will be flagged
 847                 foreach (@sym) {
 848                         $lintchange{$_}++;              # Do not complain if changed
 849                 }
 850         } elsif (s/^extern//) {                 # Variables known to be externally defined
 851                 @sym = split(' ', $_);
 852                 foreach (@sym) {
 853                         $lintextern{$_}++;              # Do not complain if used in a ?H: line
 854                 }
 855         } elsif (s/^usefile//) {                # Files marked as being used
 856                 @sym = split(' ', $_);
 857                 foreach (@sym) {
 858                         $lintfused{$_}++;
 859                 }
 860         } elsif (s/^use//) {                    # Variables declared as used by unit
 861                 @sym = split(' ', $_);          # Spurious ones will be flagged
 862                 foreach (@sym) {
 863                         $lintuse{$_}++;                 # Do not complain if on ?MAKE and not used
 864                 }
 865         } elsif (s/^def\w+//) {                 # Listed variables are defined
 866                 @sym = split(' ', $_);          # Spurious ones will be flagged
 867                 foreach (@sym) {
 868                         $lintseen{$_}++;                # Shell variable defined in this unit
 869                 }
 870         } elsif (m/^empty/) {                   # Empty unit file
 871                 $lintempty{$unit}++;
 872         } elsif (m/^unclosed/) {                # Unclosed here-documents
 873                 @sym = split(' ', $_);
 874                 foreach (@sym) {
 875                         $linthere{$_}++;
 876                 }
 877         } elsif (s/^nothere//) {                # Not a here-document name
 878                 @sym = split(' ', $_);
 879                 foreach (@sym) {
 880                         $lintnothere{$_}++;
 881                 }
 882         } elsif (s/^nocomment//) {              # OK if leading unit ': comment' missing
 883                 $lintnocomment{$unit}++;
 884         } else {
 885                 local($where) = "\"$file\", line $." unless $where;
 886                 local($word) = /^(\w+)/;
 887                 warn "$where: unknown LINT request '$word' ignored.\n";
 888         }
 889 }
 890
 891 # Process the body of the unit
 892 sub p_body {
 893         return unless $makeseen{$unit};
 894         local($_, $special) = @_;
 895         local($where) = "\"$file\", line $." unless $where;
 896         # Ensure there is no control line in the body of the unit
 897         local($control) = /^\?([\w\-]+):/;
 898         local($known) = $control ? $Depend{$control} : "";
 899         warn "$where: control sequence '?$control:' ignored within body.\n"
 900                 if $known && !/^\?X:|^\?LINT:/;
 901         if (s/^\?LINT://) {                             # ?LINT directives allowed within body
 902                 $_ .= &complete_line(FILE) if s/\\\s*$//;
 903                 &p_lint($_);
 904         }
 905         return if $known;
 906         # First non-special line should be a ': description' line
 907         unless ($special || /^\?/ || /^@/) {
 908                 warn "$where: first body line should be a general ': description'.\n"
 909                         unless $past_first_line++ || $lintnocomment{$unit} || /^:\s+\w+/;
 910         }
 911         # Ensure ': comment' lines do not hold any meta-character
 912         # We assume ":)" introduces a case statement.
 913         if (/^\s*:/ && !/^\s*:\)/) {
 914                 warn "$where: missing space after ':' to make it a comment.\n"
 915                         unless /^\s*:\s/;
 916                 s/\\.//g;                                       # simplistic ignoring of "escaped" chars
 917                 s/".*?"//g;
 918                 s/'.*?'//g;
 919                 if ($wiped_unit) {
 920                         s/<\$\w+>//g;
 921                         foreach my $wipe (@wiping) {
 922                                 s/<$wipe>//g;
 923                         }
 924                 }
 925                 warn "$where: found unquoted meta-character $1 on comment line.\n"
 926                         while s/([`()<>;&\{\}\|])//g;
 927                 warn "$where: found dangling quote on ':' comment line.\n" if /['"]/;
 928                 return;
 929         }
 930         # Ingnore interpreted lines and their continuations
 931         if ($last_interpreted) {
 932                 return if /\\$/;                        # Still part of the interpreted line
 933                 $last_interpreted = 0;          # End of interpreted lines
 934                 return;                                         # This line was the last interpreted
 935         }
 936         # Look for interpreted lines and ignore them
 937         if (/^@/) {
 938                 $last_interpreted = /\\$/;      # Set flag if line is continued
 939                 return;                                         # And skip this line
 940         }
 941         # Detect ending of "here" documents
 942         if ($heredoc ne '' && $_ eq "$heredoc\n") {
 943                 $heredoc = '';                          # Close here-document
 944                 $heredoc_nosubst = 0;
 945                 return;
 946         }
 947         # Detect beginning of "here" document
 948         my $began_here = 0;
 949         if ($heredoc eq '') {
 950                 if (/<<\s*''/) {
 951                         # Discourage it, because we're not processing those...
 952                         warn "$where: empty here-document name discouraged.\n";
 953                 } elsif (/<<\s*'([^']+)'/ && !$lintnothere{$1}) {
 954                         $heredoc = $1;
 955                         $heredoc_nosubst = 1;
 956                         $began_here++;
 957                 } elsif (/<<\s*(\S+)/ && !$lintnothere{$1}) {
 958                         $heredoc = $1;
 959                         $began_here++;
 960                 }
 961                 # Continue, as we need to look for possible ">file" on the same line
 962                 # as a possible here document, as in "cat <<EOM >file".
 963         } else {
 964                 return if $heredoc_nosubst;             # Completely opaque to interpretation
 965         }
 966         $heredoc_line = $. if $began_here;
 967
 968         # If we've just entered a here document and we're generating a file
 969         # that is exported by the unit, then we need to monitor the variables
 970         # used to make sure there's no missing dependency.
 971         $heredoc_nosubst = 0
 972                 if $began_here && />>?\s*(\S+)/ && $filemaster{$1} eq $unit;
 973
 974         # From now on, do all substitutes with ':' since it would be dangerous
 975         # to remove things plain and simple. It could yields false matches
 976         # afterwards...
 977
 978         my $check_vars = 1;
 979         $chek_vars = 0 if $heredoc_nosubst && !$began_here;
 980
 981         # Record any attempt made to set a shell variable
 982         local($sym);
 983         while ($check_vars && s/(\W?)(\w+)=/$1:/) {
 984                 my $before = $1;
 985                 $sym = $2;
 986                 next unless $before eq '' || $before =~ /["'` \t]/;
 987                 next if $sym =~ /^\d+/;         # Ignore $1 and friends
 988                 $symset{$sym}++;                        # Shell variable set
 989                 # Not part of a $cc -DWHATEVER line and not made nor temporary
 990                 unless ($sym =~ /^D/ || &defined($sym)) {
 991                         if (&wanted($sym)) {
 992                                 warn "$where: variable '\$$sym' is changed.\n"
 993                                         unless $lintchange{$sym};
 994                                 $lintchange_used{$sym}++ if $lintchange{$sym};
 995                         } else {
 996                                 # Record that the variable is set but not listed locally.
 997                                 if ($shset{$unit} !~ /\b$sym\b/) {
 998                                         $shset{$unit} .= "$sym " unless $lintchange{$sym};
 999                                         $lintchange_used{$sym}++ if $lintchange{$sym};
1000                                 }
1001                         }
1002                 }
1003         }
1004         # Now look at the shell variables used: can be $var or ${var}
1005         local($var);
1006         local($line) = $_;
1007         while ($check_vars && s/\$\{?(\w+)\}?/$1/) {
1008                 $var = $1;
1009                 next if $var =~ /^\d+/;         # Ignore $1 and friends
1010                 # Record variable as undeclared but do not issue a message right now.
1011                 # That variable could be exported via ?V: (as $dflt in Myread) or be
1012                 # defined by a special unit (like $inlibc by unit Inlibc).
1013                 $shunknown{$unit} .= "$var " unless
1014                         $lintextern{$var} || &declared($var) ||
1015                         $shunknown{$unit} =~ /\b$var\b/;
1016                 $shused{$unit} .= "\$$var " unless $shused{$unit} =~ /\$$var\b/;
1017         }
1018
1019         return if $heredoc ne '' && !$began_here;       # Still in here-document
1020
1021         # Now look at private files used by the unit (./file or ..../UU/file)
1022         # We look at things like '. ./myread' and `./loc ...` as well as "< file"
1023         local($file);
1024         $_ = $line;
1025         s/<\S+?>//g;                    # <header.h> would set-off our <file detection
1026         while (
1027                 s!(\.\s+|`\s*)(\S*UU|\.)/([^\$/`\s;]+)\s*!! ||
1028                 s!(`\s*\$?)cat\s+(\./)?([^\$/`\s;]+)\s*`!! ||
1029                 s!(\s+)(\./)([^\$/`\s;]+)\s*!! ||
1030                 s!(\s+)<\s*(\./)?([^<\$/`'"\s;]+)!!
1031         ) {
1032                 $file = $3;
1033                 # Found some ". ./file" or `./file` execution, `$cat file`, or even
1034                 # "blah <file"...
1035                 # Record file as used. Later on, we will make sure we had the right
1036                 # to use that file: either we are in the unit that defines it, or we
1037                 # include the unit that creates it in our dependencies, relying on ?F:.
1038                 $fileused{$unit} .= "$file " unless
1039                         $filetmp{$file} || $fileused{$unit} =~ /\b$file\b/;
1040                 # Mark temporary file as being used, to spot useless local declarations
1041                 $filetmp{$file} .= ' used'
1042                         if defined $filetmp{$file} && $filetmp{$file} !~ /\bused/;
1043         }
1044         # Try to detect things like . myread or `loc` to warn that they
1045         # should rather use . ./myread and `./loc`. Also things like 'if prog',
1046         # or usage in conditional expressions such as || and &&. Be sure the file
1047         # name is always in $2...
1048         while (
1049                 s!(\.\s+|`\s*)([^\$/`\s;]+)\s*!: !      ||      # . myread or `loc`
1050                 s!(if|\|\||&&)\s+([^\$/`\s;]+)\s*!: !   # if prog, || prog, && prog
1051         ) {
1052                 $file = $2;
1053                 $filemisused{$unit} .= "$file " unless
1054                         $filetmp{$file} || $filemisused{$unit} =~ /\b\Q$file\E\b/;
1055                 # Temporary files should be used with ./ anyway
1056                 $filetmp{$file} .= ' misused'
1057                         if defined $filetmp{$file} && $filetmp{$file} !~ /\bmisused/;
1058         }
1059         # Locate file creation, >>file or >file
1060         while (s!>>?\s*([^\$/`\s;]+)\s*!: !) {
1061                 $file = $1;
1062                 next if $file =~ /&\d+/;        # skip >&4 and friends
1063                 $filecreated{$file}++;
1064         }
1065         # Look for mentions of known temporary files to avoid complaining
1066         # that they were not used.
1067         while (s!\s+(\S+)!!) {
1068                 $file = $1;
1069                 $filetmp{$file} .= ' used'
1070                         if defined $filetmp{$file} && $filetmp{$file} !~ /\bused/;
1071         }
1072 }
1073
1074 # Called at the end of each unit
1075 sub p_end {
1076         local($last) = @_;                              # Last processed line
1077         local($where) = "\"$file\"";
1078
1079         # The ?H: section, if present, must have been closed
1080         if ($h_section && $h_section != 2) {
1081                  warn "$where: unclosed ?H: section.\n";
1082         }
1083         $h_section = 0;                                 # For next unit, which may be empty
1084
1085         # All opened here-documents must be closed.
1086         if ($heredoc ne '') {
1087                  my $q = $heredoc_nosubst ? "'" : "";
1088                  warn "$where: unclosed here-document $q$heredoc$q " .
1089                         "started line $heredoc_line.\n"
1090                         unless $linthere{$heredoc};
1091         }
1092
1093         # Reinitialize for next unit.
1094         $heredoc = '';
1095         $heredoc_nosubst = 0;
1096         $past_first_line = 0;
1097         $last_interpreted = 0;
1098
1099         unless ($makeseen{$unit}) {
1100                 warn "$where: no ?MAKE: line describing dependencies.\n"
1101                         unless $lintempty{$unit};
1102                 return;
1103         }
1104
1105         # Each unit should end with a blank line. Unfortunately, some units
1106         # may also end with an '@end' request and have the blank line above it.
1107         # Currently, we do not have enough information to correctly diagnose
1108         # whether it is valid or not so just skip it.
1109         # Same thing for U/Obsol_sh.U which ends with a shell comment.
1110
1111         warn "$where: not ending with a blank line.\n" unless
1112                 $last =~ /^\s*$/ || $last =~ /^\@end/ || $last =~ /^#|\?/;
1113
1114         # For EMACS users. It would be fatal to the Configure script...
1115         warn "$where: last line not ending with a new-line character.\n"
1116                 unless $last =~ /\n$/;
1117
1118         # Make sure every shell symbol described in ?MAKE had a description
1119         foreach $sym (sort keys %defseen) {
1120                 unless ($ssym{$sym}) {
1121                         warn "$where: symbol '\$$sym' was not described.\n"
1122                                 unless $lintsdesc{$sym};
1123                         $lintsdesc_used{$sym}++ if $lintsdesc{$sym};
1124                 }
1125         }
1126         # Ensure all the C symbols defined by ?H: lines have a description
1127         foreach $sym (sort keys %hcsym) {
1128                 unless ($csym{$sym}) {
1129                         warn "$where: C symbol '$sym' was not described.\n"
1130                                 unless $lintcdesc{$sym};
1131                         $lintcdesc_used{$sym}++ if $lintcdesc{$sym};
1132                 }
1133         }
1134         # Ensure all the C symbols described by ?C: lines are defined in ?H:
1135         foreach $sym (sort keys %csym) {
1136                 warn "$where: C symbol '$sym' was not defined by any ?H: line.\n"
1137                         unless $hcsym{$sym};
1138         }
1139         # Make sure each defined symbol was set, unless it starts with an
1140         # upper-case letter in which case it is not a "true" shell symbol.
1141         # I don't care about the special symbols defined in %Except as I know
1142         # they are handled correctly.
1143         foreach $sym (sort keys %defseen) {
1144                 unless ($symset{$sym} || substr($sym, 0, 1) =~ /^[A-Z]/) {
1145                         warn "$where: variable '\$$sym' should have been set.\n"
1146                                 unless $lintset{$sym};
1147                         $lintset_used{$sym}++ if $lintset{$sym};
1148                 }
1149         }
1150         # Make sure every non-special unit declared as wanted is indeed needed
1151         foreach $sym (sort keys %depseen) {
1152                 if ($shused{$unit} !~ /\$$sym\b/ && substr($sym, 0, 1) !~ /^[A-Z]/) {
1153                         warn "$where: unused dependency variable '\$$sym'.\n" unless
1154                                 $lintchange{$sym} || $lintuse{$sym};
1155                         $lintchange_used{$sym}++ if $lintchange{$sym};
1156                         $lintuse_used{$sym}++ if $lintuse{$sym};
1157                 }
1158         }
1159         # Idem for conditionally wanted symbols
1160         foreach $sym (sort keys %condseen) {
1161                 if ($shused{$unit} !~ /\$$sym\b/ && substr($sym, 0, 1) !~ /^[A-Z]/) {
1162                         warn "$where: unused conditional variable '\$$sym'.\n" unless
1163                                 $lintchange{$sym} || $lintuse{$sym};
1164                         $lintchange_used{$sym}++ if $lintchange{$sym};
1165                         $lintuse_used{$sym}++ if $lintuse{$sym};
1166                 }
1167         }
1168         # Idem for temporary symbols
1169         foreach $sym (sort keys %tempseen) {
1170                 if ($shused{$unit} !~ /\$$sym\b/ && !$symset{$sym}) {
1171                         warn "$where: unused temporary variable '\$$sym'.\n" unless
1172                                 $lintuse{$sym};
1173                         $lintuse_used{$sym}++ if $lintuse{$sym};
1174                 }
1175         }
1176         # Idem for local files
1177         foreach $file (sort keys %filetmp) {
1178                 warn "$where: mis-used temporary file '$file'.\n" if
1179                         $filetmp{$file} =~ /\bmisused/;
1180                 warn "$where: unused temporary file '$file'.\n" unless
1181                         $lintfused{$file} ||
1182                         $filetmp{$file} =~ /\bused/ || $filetmp{$file} =~ /\bmisused/;
1183         }
1184         # Make sure each private file listed as created on ?F: is really created.
1185         # When found, a private UU file is entered in the %filecreated array
1186         # with value 'a'. Each time a file creation occurs in the unit, an
1187         # increment is done on that value. Since 'a'++ -> 'b', a numeric value
1188         # in %filecreated means a non-local file, which is skipped. An 'a' means
1189         # the file was not created...
1190         local($value);
1191         foreach $file (sort keys %filecreated) {
1192                 $value = $filecreated{$file};
1193                 next if $value > 0;             # Skip non UU-files.
1194                 warn "$where: file '$file' was not created.\n" if $value eq 'a';
1195         }
1196         # Check whether some of the LINT directives were useful
1197         foreach my $sym (sort keys %lintcreated) {
1198                 warn "$where: spurious 'LINT create $sym' directive.\n";
1199         }
1200         foreach my $sym (sort keys %lintuse) {
1201                 warn "$where: spurious 'LINT use $sym' directive.\n"
1202                         unless $lintuse_used{$sym};
1203         }
1204         foreach my $sym (sort keys %lintchange) {
1205                 warn "$where: spurious 'LINT change $sym' directive.\n"
1206                         unless $lintchange_used{$sym};
1207         }
1208         foreach my $sym (sort keys %lintseen) {
1209                 warn "$where: spurious 'LINT define $sym' directive.\n"
1210                         unless $lintseen_used{$sym};
1211         }
1212         foreach my $sym (sort keys %lintsdesc) {
1213                 warn "$where: spurious 'LINT describe $sym' directive.\n"
1214                         unless $lintsdesc_used{$sym};
1215         }
1216         foreach my $sym (sort keys %lintcdesc) {
1217                 warn "$where: spurious 'LINT known $sym' directive.\n"
1218                         unless $lintcdesc_used{$sym};
1219         }
1220         foreach my $sym (sort keys %lintset) {
1221                 warn "$where: spurious 'LINT set $sym' directive.\n"
1222                         unless $lintset_used{$sym};
1223         }
1224 }
1225
1226 # An unknown control line sequence was found (held in $proc)
1227 sub p_unknown {
1228         warn "\"$file\", line $.: unknown control sequence '?$proc:'.\n";
1229 }
1230
1231 # Run sanity checks, to make sure every conditional symbol has a suitable
1232 # default value. Also ensure every symbol was defined once.
1233 sub sanity_checks {
1234         print "Sanity checks...\n";
1235         local($key, $value);
1236         local($w);
1237         local(%message);                # Record messages on a per-unit basis
1238         local(%said);                   # Avoid duplicate messages
1239         # Warn about symbols ever used in conditional dependency with no default
1240         while (($key, $value) = each(%condsym)) {
1241                 unless ($hasdefault{$key}) {
1242                         $w = (split(' ', $shmaster{"\$$key"}))[0];
1243                         $message{$w} .= "#$key ";
1244                 }
1245         }
1246         # Warn about any undeclared variables. They are all listed in %shunknown,
1247         # being the values while the unit where they appear is the key. If the
1248         # symbol is defined by any of the special units included or made visible,
1249         # then no warning is issued.
1250         local($defined);                # True if symbol is defined in one unit
1251         local($where);                  # List of units where symbol is defined
1252         local($myself);                 # The name of the current unit if itself special
1253         local($visible);                # Symbol made visible via a ?V: line
1254         foreach $unit (sort keys %shunknown) {
1255                 foreach $sym (split(' ', $shunknown{$unit})) {
1256                         $defined = 0;
1257                         $where = $shmaster{"\$$sym"};
1258                         $defined = 1 if $tempmaster{"\$$sym"} =~ /$unit\b/;
1259                         $myself = substr($unit, 0, 1) =~ /^[A-Z]/ ? $unit : '';
1260                         # Symbol has to be either defined within one of the special units
1261                         # listed in the dependencies or exported via a ?V: line.
1262                         unless ($defined) {
1263                                 $defined = &visible($sym, $unit);
1264                                 $spneeded{$unit}++ if $defined;
1265                         }
1266                         $message{$unit} .= "\$$sym " unless $defined;
1267                 }
1268         }
1269
1270         # Warn about any undeclared files. Files used in one unit are all within
1271         # the %fileused table, indexed by unit. If a file is used, it must either
1272         # be in the unit that declared it (relying on %filemaster for that) or
1273         # the unit listed in %filemaster must be part of our dependency.
1274         %said = ();
1275         foreach $unit (sort keys %fileused) {
1276                 foreach $file (split(' ', $fileused{$unit})) {
1277                         $defined = 0;
1278                         $where = $filemaster{$file};            # Where file is created
1279                         $defined = 1 if $unit eq $where;        # We're in the unit defining it
1280                         # Private UU files may be only be created by special units
1281                         foreach $special (split(' ', $shspecial{$unit})) {
1282                                 last if $defined;
1283                                 $defined = 1 if $where eq $special;
1284                         }
1285                         # Exceptions to above rule possible via a ?LINT:create hint,
1286                         # so parse all known dependencies for the unit...
1287                         foreach $depend (split(' ', $shdepend{$unit})) {
1288                                 last if $defined;
1289                                 $defined = 1 if $where eq $depend;
1290                         }
1291                         $message{$unit} .= "\@$file " unless
1292                                 $defined || $said{"$unit/$file"}++;     # Unknown file
1293                 }
1294         }
1295         undef %fileused;
1296
1297         # Warn about any misused files, kept in %filemisused
1298         foreach $unit (sort keys %filemisused) {
1299                 foreach $file (split(' ', $filemisused{$unit})) {
1300                         next unless defined $filemaster{$file}; # Skip non UU-files
1301                         $message{$unit} .= "\@\@$file ";                # Misused file
1302                 }
1303         }
1304         undef %filemisused;
1305
1306         # Warn about temporary files which could be created and inadvertently
1307         # override a private UU file (listed in %filemaster).
1308         foreach $tmpfile (keys %filesetin) {
1309                 next unless defined $filemaster{$tmpfile};
1310                 $where = $filemaster{$tmpfile};
1311                 foreach $unit (split(' ', $filesetin{$tmpfile})) {
1312                         $message{$unit} .= "\@\@\@$where:$tmpfile ";
1313                 }
1314         }
1315         undef %filesetin;
1316
1317         # Warn about any set variable which was not listed.
1318         foreach $unit (sort keys %shset) {
1319                 symbol: foreach $sym (split(' ', $shset{$unit})) {
1320                         next if $shvisible{$sym};
1321                         $defined = 0;
1322                         # Symbol has to be either defined within one of the special units
1323                         # listed in the dependencies or exported read-write via a ?V: line.
1324                         # If symbol is exported read-only, report the attempt to set it.
1325                         $where = $shmaster{"\$$sym"};
1326                         study $where;
1327                         foreach $special (split(' ', $shspecial{$unit})) {
1328                                 $defined = 1 if $where =~ /\b$special\b/;
1329                                 last if $defined;
1330                         }
1331                         $visible = 0;
1332                         $defined = $visible = &visible($sym, $unit) unless $defined;
1333                         if ($visible && $shvisible{"\$$sym"} ne '') {
1334                                 # We are allowed to set a read-only symbol in the unit which
1335                                 # declared it...
1336                                 next symbol if $shvisible{"\$$sym"} eq $unit;
1337                                 $message{$unit} .= "\&$sym ";   # Read-only symbol set
1338                                 next symbol;
1339                         }
1340                         $message{$unit} .= "$sym " unless $defined;
1341                 }
1342         }
1343         # Warn about any obsolete variable which may be used
1344         foreach $unit (sort keys %shused) {
1345                 foreach $sym (split(' ', $shused{$unit})) {
1346                         $message{$unit} .= "!$sym " if $Obsolete{$sym} ne '';
1347                 }
1348         }
1349
1350         # Warn about stale dependencies, and prepare successor and predecessor
1351         # tables for later topological sort.
1352
1353         local($targets, $deps);
1354         local(%Succ);                           # Successors
1355         local(%Prec);                           # Predecessors
1356
1357         # Split dependencies and build successors array.
1358         foreach $make (@make) {
1359                 ($targets, $deps) = $make =~ m|(.*):\s*(.*)|;
1360                 $deps =~ s/\+(\w)/$1/g;         # Remove conditional targets
1361                 foreach $target (split(' ', $targets)) {
1362                         $Succ{$target} .= $deps . ' ';
1363                 }
1364         }
1365
1366         # Special setup for the End target, which normally has a $W dependency for
1367         # wanted symbols. In order to detect all the possible cycles, we forge a
1368         # huge dependency by making ALL the regular symbols (i.e. those whose first
1369         # letter is not uppercased) wanted.
1370
1371         local($allwant) = '';
1372         {
1373                 local($sym, $val);
1374                 while (($sym, $val) = each %shmaster) {
1375                         $sym =~ s/^\$//;
1376                         $allwant .= "$sym " if $val ne '';
1377                 }
1378         }
1379
1380         $Succ{'End'} =~ s/\$W/$allwant/;
1381
1382         # Initialize precursors, and spot symbols impossible to 'make', i.e. those
1383         # symbols listed in the successors and with no 'make' target. The data
1384         # structures %Prec and %Succ will also be used by the cycle lookup code,
1385         # in other words, the topological sort.
1386         foreach $target (keys %Succ) {
1387                 $Prec{$target} += 0;    # Ensure key is recorded without disturbing.
1388                 foreach $succ (split(' ', $Succ{$target})) {
1389                         $Prec{$succ}++;         # Successor has one more precursor
1390                         unless (defined $Succ{$succ} || $said{$succ}++) {
1391                                 foreach $unit (split(' ', $symdep{$succ})) {
1392                                         $message{$unit} .= "?$succ ";   # Stale ?MAKE: dependency
1393                                 }
1394                         }
1395                 }
1396         }
1397         undef %symdep;
1398
1399         # Check all ?M: dependencies to spot stale ones
1400         %said = ();
1401         while (($key, $value) = each(%msym)) {
1402                 next if $value eq '';   # Value is unit name where ?M: occurred
1403                 foreach $sym (split(' ', $mdep{$key})) {        # Loop on C dependencies
1404                         next if $cmaster{$sym} || $said{$sym};
1405                         $message{$value} .= "??$sym ";  # Stale ?M: dependency
1406                         $said{$sym}++;
1407                 }
1408         }
1409
1410         undef %said;
1411         undef %mdep;
1412         undef %msym;
1413
1414         # Now actually emit all the warnings
1415         local($uv);                     # Unit defining visible symbol or private file
1416         local($w);                      # Were we are signaling an error
1417         foreach $unit (sort keys %message) {
1418                 undef %said;
1419                 $w = "\"$unit.U\"";
1420                 foreach (split(' ', $message{$unit})) {
1421                         if (s/^#//) {
1422                                 warn "$w: symbol '\$$_' has no default value.\n";
1423                         } elsif (s/^\?\?//) {
1424                                 warn "$w: stale ?M: dependency '$_'.\n";
1425                         } elsif (s/^\?//) {
1426                                 warn "$w: stale ?MAKE: dependency '$_'.\n";
1427                         } elsif (s/^\$//) {
1428                                 if ($shmaster{"\$$_"} ne '') {
1429                                         warn "$w: symbol '\$$_' missing from ?MAKE.\n";
1430                                 } elsif (($uv = $shvisible{$_}) ne '') {
1431                                         warn "$w: missing $uv from ?MAKE for visible '\$$_'.\n";
1432                                 } elsif (($uv = $shvisible{"\$$_"}) ne '') {
1433                                         warn "$w: missing $uv from ?MAKE for visible '\$$_'.\n";
1434                                 } else {
1435                                         warn "\"$unit.U\": unknown symbol '\$$_'.\n";
1436                                 }
1437                                 ++$said{$_};
1438                         } elsif (s/^\&//) {
1439                                 warn "\"$unit.U\": read-only symbol '\$$_' is set.\n";
1440                                 ++$said{$_};
1441                         } elsif (s/^!//) {
1442                                 warn "\"$unit.U\": obsolete symbol '$_' is used.\n";
1443                                 ++$said{$_};
1444                         } elsif (s/^\@\@\@//) {
1445                                 $uv = '?';              # To spot format errors
1446                                 s/^(\w+):// && ($uv = $1);
1447                                 warn "$w: local file '$_' may override the one set by $uv.U.\n";
1448                         } elsif (s/^\@\@//) {
1449                                 $uv = $filemaster{$_};
1450                                 warn "$w: you might not always get file '$_' from $uv.U.\n";
1451                         } elsif (s/^\@//) {
1452                                 if ($uv = $filemaster{$_}) {
1453                                         warn "$w: missing $uv from ?MAKE for private file '$_'.\n";
1454                                 } else {
1455                                         warn "$w: unknown private file '$_'.\n";
1456                                 }
1457                                 ++$said{"\@$_"};
1458                         } else {
1459                                 warn "\"$unit.U\": undeclared symbol '\$$_' is set.\n"
1460                                         unless $said{$_};
1461                         }
1462                 }
1463         }
1464
1465         # Memory cleanup
1466         undef %message;
1467         undef %said;
1468         undef %shused;
1469         undef %shset;
1470         undef %shspecial;
1471         undef %shvisible;
1472         undef %filemaster;
1473
1474         # Spot multiply defined C symbols
1475         foreach $sym (keys %cmaster) {
1476                 @sym = split(' ', $cmaster{$sym});
1477                 if (@sym > 1) {
1478                         warn "C symbol '$sym' is defined in the following units:\n";
1479                         foreach (@sym) {
1480                                 print STDERR "\t$_.U\n";
1481                         }
1482                 }
1483         }
1484         undef %cmaster;         # Memory cleanup
1485
1486         # Warn about multiply defined symbols. There are three kind of symbols:
1487         # target symbols, obsolete symbols and temporary symbols.
1488         # For each of these sets, we make sure the intersection with the other sets
1489         # is empty. Besides, we make sure target symbols are only defined once.
1490
1491         local(@sym);
1492         foreach $sym (keys %shmaster) {
1493                 @sym = split(' ', $shmaster{$sym});
1494                 if (@sym > 1) {
1495                         warn "Shell symbol '$sym' is defined in the following units:\n";
1496                         foreach (@sym) {
1497                                 print STDERR "\t$_.U\n";
1498                         }
1499                 }
1500                 $message{$sym} .= 'so ' if $Obsolete{$sym};
1501                 $message{$sym} .= 'st ' if $tempmaster{$sym};
1502         }
1503         foreach $sym (keys %tempmaster) {
1504                 $message{$sym} .= 'ot ' if $Obsolete{$sym};
1505         }
1506         local($_);
1507         while (($sym, $_) = each %message) {
1508                 if (/so/) {
1509                         if (/ot/) {
1510                                 warn "Shell symbol '$sym' is altogether:\n";
1511                                 @sym = split(' ', $shmaster{$sym});
1512                                 @sym = grep(s/$/.U/, @sym);
1513                                 print STDERR "...defined in: ", join(', ', @sym), "\n";
1514                                 print STDERR "...obsoleted by $Obsolete{$sym}.\n";
1515                                 @sym = split(' ', $tempmaster{$sym});
1516                                 @sym = grep(s/$/.U/, @sym);
1517                                 print STDERR "...used as temporary in:", join(', ', @sym), "\n";
1518                         } else {
1519                                 warn "Shell symbol '$sym' is both defined and obsoleted:\n";
1520                                 @sym = split(' ', $shmaster{$sym});
1521                                 @sym = grep(s/$/.U/, @sym);
1522                                 print STDERR "...defined in: ", join(', ', @sym), "\n";
1523                                 print STDERR "...obsoleted by $Obsolete{$sym}.\n";
1524                         }
1525                 } elsif (/st/) {                # Cannot be ot as it would imply so
1526                         warn "Shell symbol '$sym' is both defined and used as temporary:\n";
1527                         @sym = split(' ', $shmaster{$sym});
1528                         @sym = grep(s/$/.U/, @sym);
1529                         print STDERR "...defined in: ", join(', ', @sym), "\n";
1530                         @sym = split(' ', $tempmaster{$sym});
1531                         @sym = grep(s/$/.U/, @sym);
1532                         print STDERR "...used as temporary in:", join(', ', @sym), "\n";
1533                 } elsif (/ot/) {
1534                         warn "Shell symbol '$sym' obsoleted also used as temporary:\n";
1535                         print STDERR "...obsoleted by $Obsolete{$sym}.\n";
1536                         @sym = split(' ', $tempmaster{$sym});
1537                         @sym = grep(s/$/.U/, @sym);
1538                         print STDERR "...used as temporary in:", join(', ', @sym), "\n";
1539                 }
1540         }
1541
1542         # Spot multiply defined files, either private or public ones
1543         foreach $file (keys %prodfile) {
1544                 @sym = split(' ', $prodfile{$file});
1545                 if (@sym > 1) {
1546                         warn "File '$file' is defined in the following units:\n";
1547                         foreach (@sym) {
1548                                 print STDERR "\t$_\n";
1549                         }
1550                 }
1551         }
1552         undef %prodfile;
1553
1554
1555         # Memory cleanup (we still need %shmaster for tsort)
1556         undef %message;
1557         undef %tempmaster;
1558         undef %Obsolete;
1559
1560         # Make sure there is no dependency cycle
1561         print "Looking for dependency cycles...\n";
1562         &tsort(*Succ, *Prec);   # Destroys info from %Prec
1563 }
1564
1565 # Make sure last declaration ended correctly with a ?S:. or ?C:. line.
1566 # The variable '$where' was correctly positionned by the calling routine.
1567 sub check_last_declaration {
1568         warn "$where: definition of '\$$s_symbol' not closed by '?S:.'.\n"
1569                 if $s_symbol ne '';
1570         warn "$where: definition of '$c_symbol' not closed by '?C:.'.\n"
1571                 if $c_symbol ne '';
1572         warn "$where: magic definition of '$m_symbol' not closed by '?M:.'.\n"
1573                 if $m_symbol ne '';
1574         $s_symbol = $c_symbol = $m_symbol = '';
1575 }
1576
1577 # Make sure the variable is mentionned on the ?MAKE line, if possible in the
1578 # definition section.
1579 # The variable '$where' was correctly positionned by the calling routine.
1580 sub check_definition {
1581         local($var) = @_;
1582         warn "$where: variable '\$$var' not even listed on ?MAKE: line.\n"
1583                 unless $defseen{$var} || $condseen{$var} || $depseen{$var};
1584         warn "$where: variable '\$$var' is defined externally.\n"
1585                 if !$lintextern{$var} && !$defseen{$var} && &wanted($var);
1586 }
1587
1588 # Is symbol declared somewhere?
1589 sub declared {
1590         &defined($_[0]) || &wanted($_[0]);
1591 }
1592
1593 # Is symbol defined by unit?
1594 sub defined {
1595         $tempseen{$_[0]} || $defseen{$_[0]} || $lintseen{$_[0]};
1596 }
1597
1598 # Is symbol wanted by unit?
1599 sub wanted {
1600         $depseen{$_[0]} || $condseen{$_[0]};
1601 }
1602
1603 # Is symbol visible from the unit?
1604 # Locate visible symbols throughout the special units. Each unit having
1605 # some special dependencies (special units wanted) have an entry in the
1606 # %shspecial array, listing all those special dependencies. And each
1607 # symbol made visible by ONE special unit has an entry in the %shvisible
1608 # array.
1609 sub visible {
1610         local($symbol, $unit) = @_;
1611         local(%explored);                               # Special units we've already explored
1612         &explore($symbol, $unit);               # Perform recursive search
1613 }
1614
1615 # Recursively explore the dependencies to locate a visible symbol
1616 sub explore {
1617         local($symbol, $unit) = @_;
1618         # If unit was already explored, we know it has not been found by following
1619         # that path.
1620         return 0 if defined $explored{$unit};
1621         $explored{$unit} = 0;                   # Assume nothing found in this unit
1622         local($specials) = $shspecial{$unit};
1623         # Don't waste any time if unit does not have any special units listed
1624         # in its dependencies.
1625         return 0 unless $specials;
1626         foreach $special (split(' ', $specials)) {
1627                 return 1 if (
1628                         $shvisible{"\$$symbol"} eq $unit ||
1629                         $shvisible{$symbol} eq $unit ||
1630                         &explore($symbol, $special)
1631                 );
1632         }
1633         0;
1634 }
1635
1636 # The %Depend array records the functions we use to process the configuration
1637 # lines in the unit, with a special meaning. It is important that all the
1638 # known control symbols be listed below, so that metalint does not complain.
1639 # The %Lcmp array contains valid layouts and their comparaison value.
1640 sub init_depend {
1641         %Depend = (
1642                 'MAKE', 'p_make',                               # The ?MAKE: line records dependencies
1643                 'INIT', 'p_init',                               # Initializations printed verbatim
1644                 'LINT', 'p_lint',                               # Hints for metalint
1645                 'RCS', 'p_ignore',                              # RCS comments are ignored
1646                 'C', 'p_c',                                             # C symbols
1647                 'D', 'p_default',                               # Default value for conditional symbols
1648                 'E', 'p_example',                               # Example of usage
1649                 'F', 'p_file',                                  # Produced files
1650                 'H', 'p_config',                                # Process the config.h lines
1651                 'I', 'p_include',                               # Added includes
1652                 'L', 'p_library',                               # Added libraries
1653                 'M', 'p_magic',                                 # Process the confmagic.h lines
1654                 'O', 'p_obsolete',                              # Unit obsolescence
1655                 'P', 'p_public',                                # Location of PD implementation file
1656                 'S', 'p_shell',                                 # Shell variables
1657                 'T', 'p_temp',                                  # Shell temporaries used
1658                 'V', 'p_visible',                               # Visible symbols like 'rp', 'dflt'
1659                 'W', 'p_wanted',                                # Wanted value for interpreter
1660                 'X', 'p_ignore',                                # User comment is ignored
1661                 'Y', 'p_layout',                                # User-defined layout preference
1662         );
1663         %Lcmp = (
1664                 'top',          -1,
1665                 'default',      0,
1666                 'bottom',       1,
1667         );
1668 }
1669
1670 # Extract dependencies from units held in @ARGV
1671 sub extract_dependencies {
1672         local($proc);                                           # Procedure used to handle a ctrl line
1673         local($file);                                           # Current file scanned
1674         local($dir, $unit);                                     # Directory and unit's name
1675         local($old_version) = 0;                        # True when old-version unit detected
1676         local($mc) = "$MC/U";                           # Public metaconfig directory
1677         local($line);                                           # Last processed line for metalint
1678
1679         printf "Extracting dependency lists from %d units...\n", $#ARGV+1
1680                 unless $opt_s;
1681
1682         chdir $WD;                                                      # Back to working directory
1683         &init_extraction;                                       # Initialize extraction files
1684         $dependencies = ' ' x (50 * @ARGV);     # Pre-extend
1685         $dependencies = '';
1686
1687         # We do not want to use the <> construct here, because we need the
1688         # name of the opened files (to get the unit's name) and we want to
1689         # reset the line number for each files, and do some pre-processing.
1690
1691         file: while ($file = shift(@ARGV)) {
1692                 close FILE;                                             # Reset line number
1693                 $old_version = 0;                               # True if unit is an old version
1694                 if (open(FILE, $file)) {
1695                         ($dir, $unit) = ('', $file)
1696                                 unless ($dir, $unit) = ($file =~ m|(.*)/(.*)|);
1697                         $unit =~ s|\.U$||;                      # Remove extension
1698                 } else {
1699                         warn("Can't open $file.\n");
1700                 }
1701                 # If unit is in the standard public directory, keep only the unit name
1702                 $file = "$unit.U" if $dir eq $mc;
1703                 print "$dir/$unit.U:\n" if $opt_d;
1704                 line: while (<FILE>) {
1705                         $line = $_;                                     # Save last processed unit line
1706                         if (s/^\?([\w\-]+)://) {        # We may have found a control line
1707                                 my $type = $1;
1708                                 $proc = $Depend{$type}; # Look for a procedure to handle it
1709                                 unless ($proc) {                # Unknown control line
1710                                         $proc = $type;                  # p_unknown expects symbol in '$proc'
1711                                         eval '&p_unknown';      # Signal error (metalint only)
1712                                         next line;                      # And go on next line
1713                                 }
1714                                 if ($type =~ m/^[A-WYZ]$/ && m/^(\s+)\S/) { # No check on :X?, :RCS?
1715                                     my $white = $1;
1716                                     (my $f = $file) =~ s{.*/(?=U/)}{};
1717                                     if ($type eq "O") {
1718                                         # Obsolete, we don't care
1719                                     }
1720                                     elsif ($type =~ m/^[FT]$/) {
1721                                         $white eq " " or
1722                                             warn sprintf "%-32s %3d: Inconsistent whitespace (not a single space) after :$type?: %s", $f, $., $_;
1723                                     }
1724                                     else {
1725                                         $white =~ m/^ / and
1726                                             warn sprintf "%-32s %3d: Blanks after :$type? contain leading space(s): %s",
1727                                                 $f, $., $_;
1728                                     }
1729                                 }
1730                                 # Long lines may be escaped with a final backslash
1731                                 $_ .= &complete_line(FILE) if s/\\\s*$//;
1732                                 # Run macros substitutions
1733                                 s/%</$unit/g;                   # %< expands into the unit's name
1734                                 if (s/%\*/$unit/) {
1735                                         # %* expanded into the entire set of defined symbols
1736                                         # in the old version. Now it is only the unit's name.
1737                                         ++$old_version;
1738                                 }
1739                                 eval { &$proc($_) };            # Process the line
1740                         } else {
1741                                 next file unless $body;         # No procedure to handle body
1742                                 do {
1743                                         $line = $_;                             # Save last processed unit line
1744                                         eval { &$body($_) } ;   # From now on, it's the unit body
1745                                 } while (defined ($_ = <FILE>));
1746                                 next file;
1747                         }
1748                 }
1749         } continue {
1750                 warn("    Warning: $file is a pre-3.0 version.\n") if $old_version;
1751                 &$ending($line) if $ending;                     # Post-processing for metalint
1752         }
1753
1754         &end_extraction;                # End the extraction process
1755 }
1756
1757 # The first line was escaped with a final \ character. Every following line
1758 # is to be appended to it (until we found a real \n not escaped). Note that
1759 # the leading spaces of the continuation line are removed, so any space should
1760 # be added before the former \ if needed.
1761 sub complete_line {
1762         local($file) = @_;              # File where lines come from
1763         local($_);
1764         local($read) = '';              # Concatenation of all the continuation lines found
1765         while (<$file>) {
1766                 s/^\s+//;                               # Remove leading spaces
1767                 if (s/\\\s*$//) {               # Still followed by a continuation line
1768                         $read .= $_;
1769                 } else {                                # We've reached the end of the continuation
1770                         return $read . $_;
1771                 }
1772         }
1773 }
1774
1775 # Record obsolete symbols association (new versus old), that is to say for a
1776 # given old symbol, $Obsolete{'old'} = new symbol to be used. A '$' is prepended
1777 # for all shell variables
1778 sub record_obsolete {
1779         local($_) = @_;
1780         local(@obsoleted);                                      # List of obsolete symbols
1781         local($symbol);                                         # New symbol which must be used
1782         local($dollar) = s/^\$// ? '$':'';      # The '$' or a null string
1783         # Syntax for obsolete symbols specification is
1784         #    list of symbols (obsolete ones):
1785         if (/^(\w+)\s*\((.*)\)\s*:$/) {
1786                 $symbol = "$dollar$1";
1787                 @obsoleted = split(' ', $2);            # List of obsolete symbols
1788         } else {
1789                 if (/^(\w+)\s*\((.*):$/) {
1790                         warn "\"$file\", line $.: final ')' before ':' missing.\n";
1791                         $symbol = "$dollar$1";
1792                         @obsoleted = split(' ', $2);
1793                 } else {
1794                         warn "\"$file\", line $.: syntax error.\n";
1795                         return;
1796                 }
1797         }
1798         foreach $val (@obsoleted) {
1799                 $_ = $dollar . $val;
1800                 if (defined $Obsolete{$_}) {
1801                 warn "\"$file\", line $.: '$_' already obsoleted by '$Obsolete{$_}'.\n";
1802                 } else {
1803                         $Obsolete{$_} = $symbol;        # Record (old, new) tuple
1804                 }
1805         }
1806 }
1807
1808 # Dump obsolete symbols used in file 'Obsolete'. Also write Obsol_h.U and
1809 # Obsol_sh.U to record old versus new mappings if the -o option was used.
1810 sub dump_obsolete {
1811         unless (-f 'Obsolete') {
1812                 open(OBSOLETE, ">Obsolete") || die "Can't create Obsolete.\n";
1813         }
1814         open(OBSOL_H, ">.MT/Obsol_h.U") || die "Can't create .MT/Obsol_h.U.\n";
1815         open(OBSOL_SH, ">.MT/Obsol_sh.U") || die "Can't create .MT/Obsol_sh.U.\n";
1816         local($file);                                           # File where obsolete symbol was found
1817         local($old);                                            # Name of this old symbol
1818         local($new);                                            # Value of the new symbol to be used
1819         # Leave a blank line at the top so that anny added ^L will stand on a line
1820         # by itself (the formatting process adds a ^L when a new page is needed).
1821         format OBSOLETE_TOP =
1822
1823               File                 |      Old symbol      |      New symbol
1824 -----------------------------------+----------------------+---------------------
1825 .
1826         format OBSOLETE =
1827 @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<<
1828 $file,                               $old,                  $new
1829 .
1830         local(%seen);
1831         foreach $key (sort keys %ofound) {
1832                 ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
1833                 write(OBSOLETE) unless $file eq 'XXX';
1834                 next unless $opt_o;                             # Obsolete mapping done only with -o
1835                 next if $seen{$old}++;                  # Already remapped, thank you
1836                 if ($new =~ s/^\$//) {                  # We found an obsolete shell symbol
1837                         $old =~ s/^\$//;
1838                         print OBSOL_SH "$old=\"\$$new\"\n";
1839                 } else {                                                # We found an obsolete C symbol
1840                         print OBSOL_H "#ifdef $new\n";
1841                         print OBSOL_H "#define $old $new\n";
1842                         print OBSOL_H "#endif\n\n";
1843                 }
1844         }
1845         close OBSOLETE;
1846         close OBSOL_H;
1847         close OBSOL_SH;
1848         if (-s 'Obsolete') {
1849                 print "*** Obsolete symbols found -- see file 'Obsolete' for a list.\n";
1850         } else {
1851                 unlink 'Obsolete';
1852         }
1853         undef %ofound;                          # Not needed any more
1854 }
1855
1856 #
1857 # Topological sort of Makefile dependencies with cycle enhancing.
1858 #
1859
1860 package tsort;
1861
1862 # Perform the topological sort of the items and outline cycles.
1863 sub main'tsort {
1864         local(*Succ, *Prec) = @_;       # Tables of succesors and predecessors
1865         local(@Out);                            # The outsider set
1866         local(@keys);                           # Current active precursors
1867         local($item);                           # Item to sort
1868
1869         for (@keys = keys %Prec; @keys || @Out; @keys = keys %Prec) {
1870                 &resync;                        # Resynchronize outsiders
1871                 if (@Out == 0) {        # Cycle detected
1872                         &extract_cycle(*Prec, *Succ);
1873                         next;
1874                 }
1875                 $item = shift(@Out);    # Sort current item (don't care which one)
1876                 &sort($item);           # Update internal structures
1877         }
1878 }
1879
1880 # Resynchronize the outsiders stack (those items that have no more precursors).
1881 # If the outsiders stack becomes empty, then there is a cycle.
1882 sub resync {
1883         foreach $target (keys %Prec) {
1884                 if ($Prec{$target} == 0) {
1885                         delete $Prec{$target};          # We're done with this item
1886                         push(@Out, $target);            # Ready to be sorted
1887                 }
1888         }
1889 }
1890
1891 # Sort item
1892 sub sort {
1893         local($item) = @_;
1894         print "(ok) $item\n" if $main'opt_d && !$Cycle;
1895         print "(fx) $item\n" if $main'opt_d && $Cycle;
1896         foreach $succ (split(' ', $Succ{$item})) {
1897                 # The test for definedness is necessary, since when a cycle is found,
1898                 # one item is forced out of %Prec. If we had the guarantee of no
1899                 # cycle, the the test would not be necessary and no decrementation
1900                 # could go past 0.
1901                 $Prec{$succ}-- if defined $Prec{$succ};
1902         }
1903 }
1904
1905 # Extract cycle... We look through the %Prec array and find all those items
1906 # with the same lowest value. Those are a cycle, so we dump them, and make
1907 # them new outsiders by resetting their count to 0.
1908 sub extract_cycle {
1909         local(*Prec, *Succ) = @_;
1910         local($item) = (&sort_by_value(*Prec))[0];
1911         local($min) = $Prec{$item};                     # Minimum value
1912         local($key, $value);
1913         local(%candidate);      # Superset of the cycle we found
1914         warn "    Cycle found for:\n";
1915         $Cycle++;
1916         while (($key, $value) = each %Prec) {
1917                 $candidate{$key}++ if $value == $min;
1918         }
1919         local(%state);          # State of visited nodes (1 = cycle, -1 = dead)
1920         local($CYCLE) = 1;      # Possible member of a cycle
1921         local($DEAD) = -1;      # Dead end, no cycling possible
1922         foreach $key (keys %candidate) {
1923                 last if $CYCLE == &visit($key, $Succ{$key});
1924         }
1925         while (($key, $value) = each %candidate) {
1926                 next unless $state{$key} == $CYCLE;
1927                 $Prec{$key} = 0;                        # Members of cycle are new outsiders
1928                 warn "\t(#$Cycle) $key\n";
1929         }
1930         local(%involved);        # Items involved in the cycle...
1931         while (($key, $value) = each %state) {
1932                 $involved{$key}++ if $state{$key} == $CYCLE;
1933         }
1934         &outline_cycle(*Succ, *involved);
1935 }
1936
1937 sub outline_cycle {
1938         local(*Succ, *member) = @_;
1939         local($key, $value);
1940         local($depends);
1941         local($unit);
1942         warn "    Cycle involves:\n";
1943         while (($key, $value) = each %Succ) {
1944                 next unless $member{$key};
1945                 $depends = '';
1946                 foreach $item (split(' ', $value)) {
1947                         $depends .= "$item " if $member{$item};
1948                 }
1949                 $unit = $main'shmaster{"\$$key"};
1950                 $unit =~ s/\s+$//;
1951                 $unit = '?' if $unit eq '';
1952                 warn "\t($unit) $key: $depends\n";
1953         }
1954 }
1955
1956 # Visit a tree node, following all its successors, until we find a cycle.
1957 # Return $CYCLE if the exploration of the node leaded to a cycle, $DEAD
1958 # otherwise.
1959 sub visit {
1960         local($node, $children) = @_;   # A node and its children
1961         # If we have already visited the node, return the status value attached
1962         # to it.
1963         return $state{$node} if $state{$node};
1964         $state{$node} = $CYCLE;                 # Assume member of cycle
1965         local($all_dead) = 1;                   # Set to 0 if at least one cycle found
1966         foreach $child (split(' ', $children)) {
1967                 $all_dead = 0 if $CYCLE == &visit($child, $Succ{$child});
1968         }
1969         $state{$node} = $DEAD if $all_dead;
1970         $state{$node};
1971 }
1972
1973 # Sort associative array by value
1974 sub sort_by_value {
1975         local(*x) = @_;
1976         sub _by_value { $x{$a} <=> $x{$b}; }
1977         sort _by_value keys %x;
1978 }
1979
1980 package main;
1981
1982 1;
1983 # Perform ~name expansion ala ksh...
1984 # (banish csh from your vocabulary ;-)
1985 sub tilda_expand {
1986         local($path) = @_;
1987         return $path unless $path =~ /^~/;
1988         $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;                    # ~name
1989         $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;   # ~
1990         $path;
1991 }
1992
1993 # Set up profile components into %Profile, add any profile-supplied options
1994 # into @ARGV and return the command invocation name.
1995 sub profile {
1996         local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
1997         local($me) = $0;                # Command name
1998         $me =~ s|.*/(.*)|$1|;   # Keep only base name
1999         return $me unless -s $profile;
2000         local(*PROFILE);                # Local file descriptor
2001         local($options) = '';   # Options we get back from profile
2002         unless (open(PROFILE, $profile)) {
2003                 warn "$me: cannot open $profile: $!\n";
2004                 return;
2005         }
2006         local($_);
2007         local($component);
2008         while (<PROFILE>) {
2009                 next if /^\s*#/;        # Skip comments
2010                 next unless /^$me/o;
2011                 if (s/^$me://o) {       # progname: options
2012                         chop;
2013                         $options .= $_; # Merge options if more than one line
2014                 }
2015                 elsif (s/^$me-([^:]+)://o) {    # progname-component: value
2016                         $component = $1;
2017                         chop;
2018                         s/^\s+//;               # Trim leading and trailing spaces
2019                         s/\s+$//;
2020                         $Profile{$component} = $_;
2021                 }
2022         }
2023         close PROFILE;
2024         return unless $options;
2025         require 'shellwords.pl';
2026         local(@opts);
2027         eval '@opts = &shellwords($options)';   # Protect against mismatched quotes
2028         unshift(@ARGV, @opts);
2029         return $me;                             # Return our invocation name
2030 }
2031