This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
8411f12bec1d5171fbc7f102ef78e8e4b2260cf4
[metaconfig.git] / bin / mlint
1 #!/usr/bin/perl
2
3 BEGIN { $ENV{LC_ALL} = "C"; }
4
5 use FindBin;
6
7 $p5_metaconfig_base = "$FindBin::Bin/../";
8 chdir "$p5_metaconfig_base/perl" ||
9     die "perl/ directory missing in $p5_metaconfig_base\n";
10
11 -l '.package' && -l 'U' or
12     die ".package and U should be symlinks as per README\n";
13
14 # $Id: mlint.SH 22 2008-05-28 08:01:59Z rmanfredi $
15 #
16 #  Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi
17 #  
18 #  You may redistribute only under the terms of the Artistic Licence,
19 #  as specified in the README file that comes with the distribution.
20 #  You may reuse parts of this distribution only within the terms of
21 #  that same Artistic Licence; a copy of which may be found at the root
22 #  of the source tree for dist 4.0.
23 #
24 # Original Author: Harlan Stenn <harlan@mumps.pfcs.com>
25 #
26 # $Log: mlint.SH,v $
27 # Revision 3.0.1.3  1994/05/06  15:20:42  ram
28 # patch23: added -L switch to override public unit repository path
29 #
30 # Revision 3.0.1.2  1994/01/24  14:21:00  ram
31 # patch16: added ~/.dist_profile awareness
32 #
33 # Revision 3.0.1.1  1993/08/19  06:42:27  ram
34 # patch1: leading config.sh searching was not aborting properly
35 #
36 # Revision 3.0  1993/08/18  12:10:17  ram
37 # Baseline for dist 3.0 netwide release.
38 #
39
40 # Perload ON
41
42 $MC = "$p5_metaconfig_base/dist";
43 $version = '3.5';
44 $patchlevel = '0';
45 $grep = '/usr/bin/grep';
46 &profile;                                               # Read ~/.dist_profile
47 require 'getopts.pl';
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                                 $proc = $Depend{$1};    # Look for a procedure to handle it
1708                                 unless ($proc) {                # Unknown control line
1709                                         $proc = $1;                     # p_unknown expects symbol in '$proc'
1710                                         eval '&p_unknown';      # Signal error (metalint only)
1711                                         next line;                      # And go on next line
1712                                 }
1713                                 # Long lines may be escaped with a final backslash
1714                                 $_ .= &complete_line(FILE) if s/\\\s*$//;
1715                                 # Run macros substitutions
1716                                 s/%</$unit/g;                   # %< expands into the unit's name
1717                                 if (s/%\*/$unit/) {
1718                                         # %* expanded into the entire set of defined symbols
1719                                         # in the old version. Now it is only the unit's name.
1720                                         ++$old_version;
1721                                 }
1722                                 eval { &$proc($_) };            # Process the line
1723                         } else {
1724                                 next file unless $body;         # No procedure to handle body
1725                                 do {
1726                                         $line = $_;                             # Save last processed unit line
1727                                         eval { &$body($_) } ;   # From now on, it's the unit body
1728                                 } while (defined ($_ = <FILE>));
1729                                 next file;
1730                         }
1731                 }
1732         } continue {
1733                 warn("    Warning: $file is a pre-3.0 version.\n") if $old_version;
1734                 &$ending($line) if $ending;                     # Post-processing for metalint
1735         }
1736
1737         &end_extraction;                # End the extraction process
1738 }
1739
1740 # The first line was escaped with a final \ character. Every following line
1741 # is to be appended to it (until we found a real \n not escaped). Note that
1742 # the leading spaces of the continuation line are removed, so any space should
1743 # be added before the former \ if needed.
1744 sub complete_line {
1745         local($file) = @_;              # File where lines come from
1746         local($_);
1747         local($read) = '';              # Concatenation of all the continuation lines found
1748         while (<$file>) {
1749                 s/^\s+//;                               # Remove leading spaces
1750                 if (s/\\\s*$//) {               # Still followed by a continuation line
1751                         $read .= $_;    
1752                 } else {                                # We've reached the end of the continuation
1753                         return $read . $_;
1754                 }
1755         }
1756 }
1757
1758 # Record obsolete symbols association (new versus old), that is to say for a
1759 # given old symbol, $Obsolete{'old'} = new symbol to be used. A '$' is prepended
1760 # for all shell variables
1761 sub record_obsolete {
1762         local($_) = @_;
1763         local(@obsoleted);                                      # List of obsolete symbols
1764         local($symbol);                                         # New symbol which must be used
1765         local($dollar) = s/^\$// ? '$':'';      # The '$' or a null string
1766         # Syntax for obsolete symbols specification is
1767         #    list of symbols (obsolete ones):
1768         if (/^(\w+)\s*\((.*)\)\s*:$/) {
1769                 $symbol = "$dollar$1";
1770                 @obsoleted = split(' ', $2);            # List of obsolete symbols
1771         } else {
1772                 if (/^(\w+)\s*\((.*):$/) {
1773                         warn "\"$file\", line $.: final ')' before ':' missing.\n";
1774                         $symbol = "$dollar$1";
1775                         @obsoleted = split(' ', $2);
1776                 } else {
1777                         warn "\"$file\", line $.: syntax error.\n";
1778                         return;
1779                 }
1780         }
1781         foreach $val (@obsoleted) {
1782                 $_ = $dollar . $val;
1783                 if (defined $Obsolete{$_}) {
1784                 warn "\"$file\", line $.: '$_' already obsoleted by '$Obsolete{$_}'.\n";
1785                 } else {
1786                         $Obsolete{$_} = $symbol;        # Record (old, new) tuple
1787                 }
1788         }
1789 }
1790
1791 # Dump obsolete symbols used in file 'Obsolete'. Also write Obsol_h.U and
1792 # Obsol_sh.U to record old versus new mappings if the -o option was used.
1793 sub dump_obsolete {
1794         unless (-f 'Obsolete') {
1795                 open(OBSOLETE, ">Obsolete") || die "Can't create Obsolete.\n";
1796         }
1797         open(OBSOL_H, ">.MT/Obsol_h.U") || die "Can't create .MT/Obsol_h.U.\n";
1798         open(OBSOL_SH, ">.MT/Obsol_sh.U") || die "Can't create .MT/Obsol_sh.U.\n";
1799         local($file);                                           # File where obsolete symbol was found
1800         local($old);                                            # Name of this old symbol
1801         local($new);                                            # Value of the new symbol to be used
1802         # Leave a blank line at the top so that anny added ^L will stand on a line
1803         # by itself (the formatting process adds a ^L when a new page is needed).
1804         format OBSOLETE_TOP =
1805
1806               File                 |      Old symbol      |      New symbol
1807 -----------------------------------+----------------------+---------------------
1808 .
1809         format OBSOLETE =
1810 @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<<
1811 $file,                               $old,                  $new
1812 .
1813         local(%seen);
1814         foreach $key (sort keys %ofound) {
1815                 ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/);
1816                 write(OBSOLETE) unless $file eq 'XXX';
1817                 next unless $opt_o;                             # Obsolete mapping done only with -o
1818                 next if $seen{$old}++;                  # Already remapped, thank you
1819                 if ($new =~ s/^\$//) {                  # We found an obsolete shell symbol
1820                         $old =~ s/^\$//;
1821                         print OBSOL_SH "$old=\"\$$new\"\n";
1822                 } else {                                                # We found an obsolete C symbol
1823                         print OBSOL_H "#ifdef $new\n";
1824                         print OBSOL_H "#define $old $new\n";
1825                         print OBSOL_H "#endif\n\n";
1826                 }
1827         }
1828         close OBSOLETE;
1829         close OBSOL_H;
1830         close OBSOL_SH;
1831         if (-s 'Obsolete') {
1832                 print "*** Obsolete symbols found -- see file 'Obsolete' for a list.\n";
1833         } else {
1834                 unlink 'Obsolete';
1835         }
1836         undef %ofound;                          # Not needed any more
1837 }
1838
1839 #
1840 # Topological sort of Makefile dependencies with cycle enhancing.
1841 #
1842
1843 package tsort;
1844
1845 # Perform the topological sort of the items and outline cycles.
1846 sub main'tsort {
1847         local(*Succ, *Prec) = @_;       # Tables of succesors and predecessors
1848         local(@Out);                            # The outsider set
1849         local(@keys);                           # Current active precursors
1850         local($item);                           # Item to sort
1851
1852         for (@keys = keys %Prec; @keys || @Out; @keys = keys %Prec) {
1853                 &resync;                        # Resynchronize outsiders
1854                 if (@Out == 0) {        # Cycle detected
1855                         &extract_cycle(*Prec, *Succ);
1856                         next;
1857                 }
1858                 $item = shift(@Out);    # Sort current item (don't care which one)
1859                 &sort($item);           # Update internal structures
1860         }
1861 }
1862
1863 # Resynchronize the outsiders stack (those items that have no more precursors).
1864 # If the outsiders stack becomes empty, then there is a cycle.
1865 sub resync {
1866         foreach $target (keys %Prec) {
1867                 if ($Prec{$target} == 0) {
1868                         delete $Prec{$target};          # We're done with this item
1869                         push(@Out, $target);            # Ready to be sorted
1870                 }
1871         }
1872 }
1873
1874 # Sort item
1875 sub sort {
1876         local($item) = @_;
1877         print "(ok) $item\n" if $main'opt_d && !$Cycle;
1878         print "(fx) $item\n" if $main'opt_d && $Cycle;
1879         foreach $succ (split(' ', $Succ{$item})) {
1880                 # The test for definedness is necessary, since when a cycle is found,
1881                 # one item is forced out of %Prec. If we had the guarantee of no
1882                 # cycle, the the test would not be necessary and no decrementation
1883                 # could go past 0.
1884                 $Prec{$succ}-- if defined $Prec{$succ};
1885         }
1886 }
1887
1888 # Extract cycle... We look through the %Prec array and find all those items
1889 # with the same lowest value. Those are a cycle, so we dump them, and make
1890 # them new outsiders by resetting their count to 0.
1891 sub extract_cycle {
1892         local(*Prec, *Succ) = @_;
1893         local($item) = (&sort_by_value(*Prec))[0];
1894         local($min) = $Prec{$item};                     # Minimum value
1895         local($key, $value);
1896         local(%candidate);      # Superset of the cycle we found
1897         warn "    Cycle found for:\n";
1898         $Cycle++;
1899         while (($key, $value) = each %Prec) {
1900                 $candidate{$key}++ if $value == $min;
1901         }
1902         local(%state);          # State of visited nodes (1 = cycle, -1 = dead)
1903         local($CYCLE) = 1;      # Possible member of a cycle
1904         local($DEAD) = -1;      # Dead end, no cycling possible
1905         foreach $key (keys %candidate) {
1906                 last if $CYCLE == &visit($key, $Succ{$key});
1907         }
1908         while (($key, $value) = each %candidate) {
1909                 next unless $state{$key} == $CYCLE;
1910                 $Prec{$key} = 0;                        # Members of cycle are new outsiders
1911                 warn "\t(#$Cycle) $key\n";
1912         }
1913         local(%involved);        # Items involved in the cycle...
1914         while (($key, $value) = each %state) {
1915                 $involved{$key}++ if $state{$key} == $CYCLE;
1916         }
1917         &outline_cycle(*Succ, *involved);
1918 }
1919
1920 sub outline_cycle {
1921         local(*Succ, *member) = @_;
1922         local($key, $value);
1923         local($depends);
1924         local($unit);
1925         warn "    Cycle involves:\n";
1926         while (($key, $value) = each %Succ) {
1927                 next unless $member{$key};
1928                 $depends = '';
1929                 foreach $item (split(' ', $value)) {
1930                         $depends .= "$item " if $member{$item};
1931                 }
1932                 $unit = $main'shmaster{"\$$key"};
1933                 $unit =~ s/\s+$//;
1934                 $unit = '?' if $unit eq '';
1935                 warn "\t($unit) $key: $depends\n";
1936         }
1937 }
1938
1939 # Visit a tree node, following all its successors, until we find a cycle.
1940 # Return $CYCLE if the exploration of the node leaded to a cycle, $DEAD
1941 # otherwise.
1942 sub visit {
1943         local($node, $children) = @_;   # A node and its children
1944         # If we have already visited the node, return the status value attached
1945         # to it.
1946         return $state{$node} if $state{$node};
1947         $state{$node} = $CYCLE;                 # Assume member of cycle
1948         local($all_dead) = 1;                   # Set to 0 if at least one cycle found
1949         foreach $child (split(' ', $children)) {
1950                 $all_dead = 0 if $CYCLE == &visit($child, $Succ{$child});
1951         }
1952         $state{$node} = $DEAD if $all_dead;
1953         $state{$node};
1954 }
1955
1956 # Sort associative array by value
1957 sub sort_by_value {
1958         local(*x) = @_;
1959         sub _by_value { $x{$a} <=> $x{$b}; }
1960         sort _by_value keys %x;
1961 }
1962
1963 package main;
1964
1965 1;
1966 # Perform ~name expansion ala ksh...
1967 # (banish csh from your vocabulary ;-)
1968 sub tilda_expand {
1969         local($path) = @_;
1970         return $path unless $path =~ /^~/;
1971         $path =~ s:^~([^/]+):(getpwnam($1))[$[+7]:e;                    # ~name
1972         $path =~ s:^~:$ENV{'HOME'} || (getpwuid($<))[$[+7]:e;   # ~
1973         $path;
1974 }
1975
1976 # Set up profile components into %Profile, add any profile-supplied options
1977 # into @ARGV and return the command invocation name.
1978 sub profile {
1979         local($profile) = &tilda_expand($ENV{'DIST'} || '~/.dist_profile');
1980         local($me) = $0;                # Command name
1981         $me =~ s|.*/(.*)|$1|;   # Keep only base name
1982         return $me unless -s $profile;
1983         local(*PROFILE);                # Local file descriptor
1984         local($options) = '';   # Options we get back from profile
1985         unless (open(PROFILE, $profile)) {
1986                 warn "$me: cannot open $profile: $!\n";
1987                 return;
1988         }
1989         local($_);
1990         local($component);
1991         while (<PROFILE>) {
1992                 next if /^\s*#/;        # Skip comments
1993                 next unless /^$me/o;
1994                 if (s/^$me://o) {       # progname: options
1995                         chop;
1996                         $options .= $_; # Merge options if more than one line
1997                 }
1998                 elsif (s/^$me-([^:]+)://o) {    # progname-component: value
1999                         $component = $1;
2000                         chop;
2001                         s/^\s+//;               # Trim leading and trailing spaces
2002                         s/\s+$//;
2003                         $Profile{$component} = $_;
2004                 }
2005         }
2006         close PROFILE;
2007         return unless $options;
2008         require 'shellwords.pl';
2009         local(@opts);
2010         eval '@opts = &shellwords($options)';   # Protect against mismatched quotes
2011         unshift(@ARGV, @opts);
2012         return $me;                             # Return our invocation name
2013 }
2014