From 0e57f0c510b7d7eb688695359048a1f0a585e26a Mon Sep 17 00:00:00 2001 From: rmanfredi Date: Thu, 24 Aug 2006 12:32:52 +0000 Subject: Moving project to sourceforge. git-svn-id: svn://svn.code.sf.net/p/dist/code/trunk/dist@1 2592e710-e01b-42a5-8df0-11608a6cc53d --- mcon/pl/common.pl | 289 +++++++++++ mcon/pl/configure.pl | 245 +++++++++ mcon/pl/cosmetic.pl | 114 ++++ mcon/pl/depend.pl | 138 +++++ mcon/pl/eval.pl | 300 +++++++++++ mcon/pl/extract.pl | 109 ++++ mcon/pl/files.pl | 109 ++++ mcon/pl/gensym.pl | 22 + mcon/pl/init.pl | 55 ++ mcon/pl/lint.pl | 1411 ++++++++++++++++++++++++++++++++++++++++++++++++++ mcon/pl/locate.pl | 153 ++++++ mcon/pl/makefile.pl | 176 +++++++ mcon/pl/obsolete.pl | 103 ++++ mcon/pl/order.pl | 42 ++ mcon/pl/tsort.pl | 166 ++++++ mcon/pl/wanted.pl | 263 ++++++++++ mcon/pl/xref.pl | 67 +++ mcon/pl/xwant.pl | 149 ++++++ 18 files changed, 3911 insertions(+) create mode 100644 mcon/pl/common.pl create mode 100644 mcon/pl/configure.pl create mode 100644 mcon/pl/cosmetic.pl create mode 100644 mcon/pl/depend.pl create mode 100644 mcon/pl/eval.pl create mode 100644 mcon/pl/extract.pl create mode 100644 mcon/pl/files.pl create mode 100644 mcon/pl/gensym.pl create mode 100644 mcon/pl/init.pl create mode 100644 mcon/pl/lint.pl create mode 100644 mcon/pl/locate.pl create mode 100644 mcon/pl/makefile.pl create mode 100644 mcon/pl/obsolete.pl create mode 100644 mcon/pl/order.pl create mode 100644 mcon/pl/tsort.pl create mode 100644 mcon/pl/wanted.pl create mode 100644 mcon/pl/xref.pl create mode 100644 mcon/pl/xwant.pl (limited to 'mcon/pl') diff --git a/mcon/pl/common.pl b/mcon/pl/common.pl new file mode 100644 index 0000000..0d1ea5a --- /dev/null +++ b/mcon/pl/common.pl @@ -0,0 +1,289 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: common.pl,v $ +;# Revision 3.0.1.4 1994/10/29 16:35:01 ram +;# patch36: metaconfig and metaxref ignore ?F: lines from now on +;# +;# Revision 3.0.1.3 1994/05/13 15:29:04 ram +;# patch27: now understands macro definitions in ?H: lines +;# +;# Revision 3.0.1.2 1994/01/24 14:22:54 ram +;# patch16: can now define "internal use only" variables on ?MAKE: lines +;# +;# Revision 3.0.1.1 1993/10/16 13:53:29 ram +;# patch12: added support for ?M: lines and confmagic.h production +;# +;# Revision 3.0 1993/08/18 12:10:19 ram +;# Baseline for dist 3.0 netwide release. +;# +;# The list of all available units is held in @ARGV. We shall parse them and +;# extract the dependencies. A lot of global data structures are filled in +;# during this phase. +;# +;# The following two H tables are used to record each know symbol (i.e. a +;# symbol known by at least one unit), and also how many times this symbol is +;# found in the sources. If an entry for a given key is positive, then the +;# associated symbol (i.e. the key) is wanted and it will be written in the +;# Wanted file. +;# %shmaster{'$sym'} records how many times '$sym' is found in a .SH file +;# %cmaster{'SYM'} records how many times 'SYM' is found in a .c file +;# %cwanted{'SYM'} records the set of necessary shell symbols needed for SYM +;# %mwanted{'sym'} is set of C symbols needed when sym is found in .c file +;# +;# This data structure records the initializations which are requires at the +;# beginning of a Configure script. The initialization only occurs when the +;# symbol is needed. Those symbols will appear in the produced config.sh file, +;# hence the name of "master" symbols. +;# @Master records shell configuration symbols which will appear in config.sh +;# +;# The @Cond array records the conditional shell symbols, i.e. those whose +;# value may be defaulted. They will appear in the initialization section of +;# the Configure script with the default value if they are not otherwise used +;# but Configure needs a suitable value internally. +;# @Cond records symbols which are flagged as conditional in the dependencies +;# %hasdefault{'sym'} is true when the conditional 'sym' has a default value +;# +;# The %Obsolete array records the obsolecence for units or symbols. The key +;# ends with .U for units, otherwise it is a symbol. Unit's obsolescence is +;# flagged with a ?O: line (the line being the message which will be issued +;# when the unit is used) while symbol obsolecence is indicated on the leading +;# ?C: or ?S: line, between parenthesis. In that case, the value stored is the +;# new symbol which should be used insted. +;# %Obsolete{'unit.U'} is a message to be printed when obsolete unit is used +;# %Obsolete{'sym'} is the symbol to be used in place of the obsoleted 'sym' +;# +;# The $dependencies variable is used to record the dependencies extracted +;# from the units (?MAKE: line). +;# +;# During the dependency extraction. some files are produced in the .MT dir. +;# Init.U records the initialization wanted +;# Config_h.U records the informations which could go in config.h.SH +;# Extern.U records the libraries and includes wanted by each symbol +;# +;# This file is shared by both metaconfig and metaxref +;# +# Initialize the extraction process by setting some variables. +# We return a string to be eval to do more customized initializations. +sub init_extraction { + open(INIT, ">$WD/.MT/Init.U") || + die "Can't create .MT/Init.U\n"; + open(CONF_H, ">$WD/.MT/Config_h.U") || + die "Can't create .MT/Config_h.U\n"; + open(EXTERN, ">$WD/.MT/Extern.U") || + die "Can't create .MT/Extern.U\n"; + open(MAGIC_H, ">$WD/.MT/Magic_h.U") || + die "Can't create .MT/Magic_h.U\n"; + + $c_symbol = ''; # Current symbol seen in ?C: lines + $s_symbol = ''; # Current symbol seen in ?S: lines + $m_symbol = ''; # Current symbol seen in ?M: lines + $heredoc = ''; # Last "here" document symbol seen + $heredoc_nosubst = 0; # True for <<'EOM' here docs + $condlist = ''; # List of conditional symbols + $defined = ''; # List of defined symbols in the unit + $body = ''; # No procedure to handle body + $ending = ''; # No procedure to clean-up +} + +# End the extraction process +sub end_extraction { + close EXTERN; # External dependencies (libraries, includes...) + close CONF_H; # C symbol definition template + close INIT; # Required initializations + close MAGIC; # Magic C symbol redefinition templates + + print $dependencies if $opt_v; # Print extracted dependencies +} + +# Process the ?MAKE: line +sub p_make { + local($_) = @_; + local(@ary); # Locally defined symbols + local(@dep); # Dependencies + if (/^[\w+ ]*:/) { # Main dependency rule + s|^\s*||; # Remove leading spaces + chop; + s/:(.*)//; + @dep = split(' ', $1); # Dependencies + @ary = split(' '); # Locally defined symbols + foreach $sym (@ary) { + # Symbols starting with a '+' are meant for internal use only. + next if $sym =~ s/^\+//; + # Only sumbols starting with a lowercase letter are to + # appear in config.sh, excepted the ones listed in Except. + if ($sym =~ /^[_a-z]/ || $Except{$sym}) { + $shmaster{"\$$sym"} = undef; + push(@Master,"?$unit:$sym=''\n"); # Initializations + } + } + $condlist = ''; # List of conditional symbols + local($sym); # Symbol copy, avoid @dep alteration + foreach $dep (@dep) { + if ($dep =~ /^\+[A-Za-z]/) { + ($sym = $dep) =~ s|^\+||; + $condlist .= "$sym "; + push(@Cond, $sym) unless $condseen{$sym}; + $condseen{$sym}++; # Conditionally wanted + } + } + # Append to already existing dependencies. The 'defined' variable + # is set for &write_out, used to implement ?L: and ?I: canvas. It is + # reset each time a new unit is parsed. + # NB: leading '+' for defined symbols (internal use only) have been + # removed at this point, but conditional dependencies still bear it. + $defined = join(' ', @ary); # Symbols defined by this unit + $dependencies .= $defined . ':' . join(' ', @dep) . "\n"; + $dependencies .= " -cond $condlist\n" if $condlist; + } else { + $dependencies .= $_; # Building rules + } +} + +# Process the ?O: line +sub p_obsolete { + local($_) = @_; + $Obsolete{"$unit.U"} .= $_; # Message(s) to print if unit is used +} + +# Process the ?S: lines +sub p_shell { + local($_) = @_; + unless ($s_symbol) { + if (/^(\w+).*:/) { + $s_symbol = $1; + print " ?S: $s_symbol\n" if $opt_d; + } else { + warn "\"$file\", line $.: syntax error in ?S: construct.\n"; + $s_symbol = $unit; + return; + } + # Deal with obsolete symbol list (enclosed between parenthesis) + &record_obsolete("\$$_") if /\(/; + } + m|^\.\s*$| && ($s_symbol = ''); # End of comment +} + +# Process the ?C: lines +sub p_c { + local($_) = @_; + unless ($c_symbol) { + if (s/^(\w+)\s*~\s*(\S+)\s*(.*):/$1 $3:/) { + # The ~ operator aliases the main C symbol to another symbol which + # is to be used instead for definition in config.h. That is to say, + # the line '?C:SYM ~ other:' would look for symbol 'other' instead, + # and the documentation for symbol SYM would only be included in + # config.h if 'other' were actually wanted. + $c_symbol = $2; # Alias for definition in config.h + print " ?C: $1 ~ $c_symbol\n" if $opt_d; + } elsif (/^(\w+).*:/) { + # Default behaviour. Include in config.h if symbol is needed. + $c_symbol = $1; + print " ?C: $c_symbol\n" if $opt_d; + } else { + warn "\"$file\", line $.: syntax error in ?C: construct.\n"; + $c_symbol = $unit; + return; + } + # Deal with obsolete symbol list (enclosed between parenthesis) and + # make sure that list do not appear in config.h.SH by removing it. + &record_obsolete("$_") if /\(/; + s/\s*\(.*\)//; # Get rid of obsolete symbol list + } + s|^(\w+)\s*|?$c_symbol:/* $1| || # Start of comment + (s|^\.\s*$|?$c_symbol: */\n| && ($c_symbol = '', 1)) || # End of comment + s|^(.*)|?$c_symbol: *$1|; # Middle of comment + &p_config("$_"); # Add comments to config.h.SH +} + +# Process the ?H: lines +sub p_config { + local($_) = @_; + local($constraint); # Constraint to be used for inclusion + ++$old_version if s/^\?%1://; # Old version + if (s/^\?(\w+)://) { # Remove leading '?var:' + $constraint = $1; # Constraint is leading '?var' + } else { + $constraint = ''; # No constraint + } + if (/^#.*\$/) { # Look only for cpp lines + if (m|^#\$(\w+)\s+(\w+).*\$(\w+)|) { + # Case: #$d_var VAR "$var" + $constraint = $2 unless $constraint; + print " ?H: ($constraint) #\$$1 $2 \"\$$3\"\n" if $opt_d; + $cmaster{$2} = undef; + $cwanted{$2} = "$1\n$3"; + } elsif (m|^#define\s+(\w+)\((.*)\)\s+\$(\w+)|) { + # Case: #define VAR(x) $var + $constraint = $1 unless $constraint; + print " ?H: ($constraint) #define $1($2) \$$3\n" if $opt_d; + $cmaster{$1} = undef; + $cwanted{$1} = $3; + } elsif (m|^#\$define\s+(\w+)|) { + # Case: #$define VAR + $constraint = $1 unless $constraint; + print " ?H: ($constraint) #define $1\n" if $opt_d; + $cmaster{$1} = undef; + $cwanted{$1} = "define\n$unit"; + } elsif (m|^#\$(\w+)\s+(\w+)|) { + # Case: #$d_var VAR + $constraint = $2 unless $constraint; + print " ?H: ($constraint) #\$$1 $2\n" if $opt_d; + $cmaster{$2} = undef; + $cwanted{$2} = $1; + } elsif (m|^#define\s+(\w+).*\$(\w+)|) { + # Case: #define VAR "$var" + $constraint = $1 unless $constraint; + print " ?H: ($constraint) #define $1 \"\$$2\"\n" if $opt_d; + $cmaster{$1} = undef; + $cwanted{$1} = $2; + } else { + $constraint = $unit unless $constraint; + print " ?H: ($constraint) $_" if $opt_d; + } + } else { + print " ?H: ($constraint) $_" if $opt_d; + } + # If not a single ?H:. line, add the leading constraint + s/^\.// || s/^/?$constraint:/; + print CONF_H; +} + +# Process the ?M: lines +sub p_magic { + local($_) = @_; + unless ($m_symbol) { + if (/^(\w+):\s*([\w\s]*)\n$/) { + # A '?M:sym:' line implies a '?W:%<:sym' since we'll need to know + # about the wantedness of sym later on when building confmagic.h. + # Buf is sym is wanted, then the C symbol dependencies have to + # be triggered. That is done by introducing sym in the mwanted + # array, known by the Wanted file construction process... + $m_symbol = $1; + print " ?M: $m_symbol\n" if $opt_d; + $mwanted{$m_symbol} = $2; # Record C dependencies + &p_wanted("$unit:$m_symbol"); # Build fake ?W: line + } else { + warn "\"$file\", line $.: syntax error in ?M: construct.\n"; + } + return; + } + (s/^\.\s*$/?$m_symbol:\n/ && ($m_symbol = '', 1)) || # End of block + s/^/?$m_symbol:/; + print MAGIC_H; # Definition goes to confmagic.h + print " ?M: $_" if $opt_d; +} + +sub p_ignore {} # Ignore comment line +sub p_lint {} # Ignore lint directives +sub p_visible {} # No visible checking in metaconfig +sub p_temp {} # No temporary variable control +sub p_file {} # Ignore produced file directives (for now) + diff --git a/mcon/pl/configure.pl b/mcon/pl/configure.pl new file mode 100644 index 0000000..f78925f --- /dev/null +++ b/mcon/pl/configure.pl @@ -0,0 +1,245 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: configure.pl,v $ +;# Revision 3.0.1.5 1995/01/30 14:47:15 ram +;# patch49: removed old "do name()" routine call constructs +;# +;# Revision 3.0.1.4 1995/01/11 15:40:02 ram +;# patch45: now allows @if statements for the add.Config_sh unit inclusion +;# +;# Revision 3.0.1.3 1994/05/06 15:21:23 ram +;# patch23: cleaned up the 'prepend' command +;# +;# Revision 3.0.1.2 1994/01/24 14:23:21 ram +;# patch16: new general <\$variable> macro substitutions in wiped units +;# +;# Revision 3.0.1.1 1993/10/16 13:54:02 ram +;# patch12: added support for ?M: lines and confmagic.h production +;# patch12: new Makefile command cm_h_weed +;# +;# Revision 3.0 1993/08/18 12:10:20 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# This file is the heart of metaconfig. We generate a Configure script using +;# the informations gathered in the @cmdwanted array. A unit is expected to have +;# its path written in the %Unit array (indexing is done with the unit's name +;# without the .U extension). +;# +;# The units are run through a built-in interpreter before being written to +;# the Configure script. +;# +# Create the Configure script +sub create_configure { + print "Creating Configure...\n" unless $opt_s; + open(CONFIGURE,">Configure") || die "Can't create Configure: $!\n"; + open(CONF_H,">config_h.SH") || die "Can't create config_h.SH: $!\n"; + if ($opt_M) { + open(MAGIC_H,">confmagic.h") || die "Can't create confmagic.h: $!\n"; + } + + chdir('.MT') || die "Can't cd to .MT: $!\n"; + for (@cmdwanted) { + &process_command($_); # Run the makefile command + } + chdir($WD) || die "Can't cd back to $WD\n"; + close CONFIGURE; + print CONF_H "#endif\n"; # Close the opened #ifdef (see Config_h.U) + print CONF_H "!GROK!THIS!\n"; + close CONF_H; + if ($opt_M) { + print MAGIC_H "#endif\n"; # Close the opened #ifdef (see Magic_h.U) + close MAGIC_H; + } + `chmod +x Configure`; +} + +# Process a Makefile 'pick' command +sub process_command { + local($cmd, $target, $unit_name) = split(' ', $_[0]); + local($name) = $unit_name . '.U'; # Restore missing .U + local($file) = $name; # Where unit is located + unless ($file =~ m|^\./|) { # Unit produced earlier by metaconfig + $file = $Unit{$unit_name}; # Fetch unit from U directory + } + if (defined $Obsolete{$name}) { # Signal use of an obsolete unit + warn "\tObsolete unit $name is used:\n"; + local(@msg) = split(/\n/, $Obsolete{$name}); + foreach $msg (@msg) { + warn "\t $msg\n"; + } + } + die "Can't open $file.\n" unless open(UNIT, $file); + print "\t$cmd $file\n" if $opt_v; + &init_interp; # Initializes the interpreter + + # The 'add' command adds the unit to Configure. + if ($cmd eq 'add') { + while () { + print CONFIGURE unless &skipped || !&interpret($_); + } + } + + # The 'weed' command adds the unit to Configure, but + # makes some tests for the lines starting with '?' or '%'. + # These lines are kept only if the symbol is wanted. + elsif ($cmd eq 'weed') { + while () { + if (/^\?(\w+):/) { + s/^\?\w+:// if $symwanted{$1}; + } + if (/^%(\w+):/) { + s/^%\w+:// if $condwanted{$1}; + } + print CONFIGURE unless &skipped || !&interpret($_); + } + } + + # The 'wipe' command adds the unit to Configure, but + # also substitues some hardwired macros. + elsif ($cmd eq 'wipe') { + while () { + s//$package/g; + s//$maintloc/g; + s//$version/g; # This is metaconfig's version + s//$patchlevel/g; # And patchlevel information + s//$date/g; + s//$baserev/g; + s/<\$(\w+)>/eval("\$$1")/ge; # <$var> -> $var substitution + print CONFIGURE unless &skipped || !&interpret($_); + } + } + + # The 'add.Null' command adds empty initializations + # to Configure for all the shell variable used. + elsif ($cmd eq 'add.Null') { + for (sort @Master) { + if (/^\?(\w+):/) { + s/^\?\w+:// if $symwanted{$1}; + } + print CONFIGURE unless &skipped; + } + for (sort @Cond) { + print CONFIGURE "$_=''\n" + unless $symwanted{$_} || $hasdefault{$_}; + } + while () { + print CONFIGURE unless &skipped || !&interpret($_); + } + print CONFIGURE "CONFIG=''\n\n"; + } + + # The 'add.Config_sh' command fills in the production of + # the config.sh script within Configure. Only the used + # variable are added, the conditional ones are skipped. + elsif ($cmd eq 'add.Config_sh') { + while () { + print CONFIGURE unless &skipped || !&interpret($_); + } + for (sort @Master) { + if (/^\?(\w+):/) { + # Can't use $shmaster, because config.sh must + # also contain some internal defaults used by + # Configure (e.g. nm_opt, libc, etc...). + s/^\?\w+:// if $symwanted{$1}; + } + s/^(\w+)=''/$1='\$$1'/; + print CONFIGURE unless &skipped; + } + } + + # The 'close.Config_sh' command adds the final EOT line at + # the end of the here-document construct which produces the + # config.sh file within Configure. + elsif ($cmd eq 'close.Config_sh') { + print CONFIGURE "EOT\n\n"; # Ends up file + } + + # The 'c_h_weed' command produces the config_h.SH file. + # Only the necessary lines are kept. If no conditional line is + # ever printed, then the file is useless and will be removed. + elsif ($cmd eq 'c_h_weed') { + $printed = 0; + while () { + if (/^\?(\w+):/) { + s/^\?\w+:// if $cmaster{$1} || $symwanted{$1}; + } + unless (&skipped || !&interpret($_)) { + if (/^$/) { + print CONF_H "\n" if $printed; + $printed = 0; + } else { + print CONF_H; + ++$printed; + } + } + } + } + + # The 'cm_h_weed' command produces the confmagic.h file. + # Only the necessary lines are kept. If no conditional line is + # ever printed, then the file is useless and will be removed. + elsif ($cmd eq 'cm_h_weed') { + if ($opt_M) { + $printed = 0; + while () { + if (/^\?(\w+):/) { + s/^\?\w+:// if $cmaster{$1} || $symwanted{$1}; + } + unless (&skipped || !&interpret($_)) { + if (/^$/) { + print MAGIC_H "\n" if $printed; + $printed = 0; + } else { + print MAGIC_H; + ++$printed; + } + } + } + } + } + + # The 'prepend' command will add the content of the target to + # the current file (held in $file, the one which UNIT refers to), + # if the file is not empty. + elsif ($cmd eq 'prepend') { + if (-s $file) { + open(PREPEND, ">.prepend") || + die "Can't create .MT/.prepend.\n"; + open(TARGET, $Unit{$target}) || + die "Can't open $Unit{$target}.\n"; + while () { + print PREPEND unless &skipped; + } + print PREPEND ; # Now add original file contents + close PREPEND; + close TARGET; + rename('.prepend', $file) || + die "Can't rename .prepend into $file.\n"; + } + } + + # Command not found + else { + die "Unrecognized command from Makefile: $cmd\n"; + } + &check_state; # Make sure there are no pending statements + close UNIT; +} + +# Skip lines starting with ? or %, including all the following continuation +# lines, if any. Return 0 if the line was not to be skipped, 1 otherwise. +sub skipped { + return 0 unless /^\?|^%/; + &complete_line(UNIT) if /\\\s*$/; # Swallow continuation lines + 1; +} + diff --git a/mcon/pl/cosmetic.pl b/mcon/pl/cosmetic.pl new file mode 100644 index 0000000..bfb9575 --- /dev/null +++ b/mcon/pl/cosmetic.pl @@ -0,0 +1,114 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: cosmetic.pl,v $ +;# Revision 3.0.1.3 1995/07/25 14:19:16 ram +;# patch56: added support for new -G option +;# +;# Revision 3.0.1.2 1995/01/30 14:47:52 ram +;# patch49: forgot to localize the spaces variable +;# +;# Revision 3.0.1.1 1993/11/10 17:39:10 ram +;# patch14: now also adds confmagic.h if not in MANIFEST.new already +;# patch14: new functions mani_add and mani_remove to factorize code +;# +;# Revision 3.0 1993/08/18 12:10:20 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +# Update the MANIFEST.new file if necessary +sub cosmetic_update { + # Check for an "empty" config_h.SH (2 blank lines only). This test relies + # on the actual text held in Config_h.U. If the unit is modified, then the + # following might need adjustments. + local($blank_lines) = 0; + local($spaces) = 0; + open(CONF_H, 'config_h.SH') || die "Can't open config_h.SH\n"; + while() { + ++$blank_lines if /^$/; + } + unlink 'config_h.SH' unless $blank_lines > 3; + + open(NEWMANI,$NEWMANI); + $_ = ; + /(\S+\s+)\S+/ && ($spaces = length($1)); # Spaces wanted + close NEWMANI; + $spaces = 29 if ($spaces < 12); # Default value + open(NEWMANI,$NEWMANI); + $/ = "\001"; # Swallow the whole file + $_ = ; + $/ = "\n"; + close NEWMANI; + + $* = 1; # Multi-line matching + + &mani_add('Configure', 'Portability tool', $spaces) unless /^Configure\b/; + &mani_add('config_h.SH', 'Produces config.h', $spaces) + unless /^config_h\.SH\b/ || !-f 'config_h.SH'; + &mani_add('confmagic.h', 'Magic symbol remapping', $spaces) + if $opt_M && !/^confmagic\.h\b/; + + &mani_remove('config_h.SH') if /^config_h\.SH\b/ && !-f 'config_h.SH'; + &mani_remove('confmagic.h') if /^confmagic.h\b/ && !$opt_M; + + if ($opt_G) { # Want a GNU-like configure wrapper + &add_configure; + &mani_add('configure', 'GNU configure-like wrapper', $spaces) + if !/^configure\s/ && -f 'configure'; + } else { + &mani_remove('configure') if /^configure\s/ && !-f 'configure'; + } + + $* = 0; +} + +# Add file to MANIFEST.new, with properly indented comment +sub mani_add { + local($file, $comment, $spaces) = @_; + print "Adding $file to your $NEWMANI file...\n" unless $opt_s; + open(NEWMANI, ">>$NEWMANI") || warn "Can't add $file to $NEWMANI: $!\n"; + local($blank) = ' ' x ($spaces - length($file)); + print NEWMANI "${file}${blank}${comment}\n"; + close NEWMANI; +} + +# Remove file from MANIFEST.new +sub mani_remove { + local($file) = @_; + print "Removing $file from $NEWMANI...\n" unless $opt_s; + unless (open(NEWMANI, ">$NEWMANI.x")) { + warn "Can't create backup $NEWMANI copy: $!\n"; + return; + } + unless (open(OLDMANI, $NEWMANI)) { + warn "Can't open $NEWMANI: $!\n"; + return; + } + local($_); + while () { + print NEWMANI unless /^$file\b/ + } + close OLDMANI; + close NEWMANI; + rename("$NEWMANI.x", $NEWMANI) || + warn "Couldn't restore $NEWMANI from $NEWMANI.x\n"; +} + +# Copy GNU-like configure wrapper to the package root directory +sub add_configure { + if (-f "$MC/configure") { + print "Copying GNU configure-like front end...\n" unless $opt_s; + system "cp $MC/configure ./configure"; + `chmod +x configure`; + } else { + warn "Can't locate $MC/configure: $!\n"; + } +} + diff --git a/mcon/pl/depend.pl b/mcon/pl/depend.pl new file mode 100644 index 0000000..fc88f1a --- /dev/null +++ b/mcon/pl/depend.pl @@ -0,0 +1,138 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: depend.pl,v $ +;# Revision 3.0.1.3 1995/09/25 09:18:56 ram +;# patch59: new ?Y: directive to change unit layout +;# +;# Revision 3.0.1.2 1994/10/29 16:35:23 ram +;# patch36: added various escapes in strings for perl5 support +;# +;# Revision 3.0.1.1 1993/10/16 13:54:35 ram +;# patch12: added minimal support for ?P: lines (not ready yet) +;# +;# Revision 3.0 1993/08/18 12:10:21 ram +;# Baseline for dist 3.0 netwide release. +;# +;# Metaconfig-dependent part of the dependency extraction. +;# +# Process the ?W: lines +sub p_wanted { + # Syntax is ?W:: + local($active) = $_[0] =~ /^([^:]*):/; # Symbols to activate + local($look_symbols) = $_[0] =~ /:(.*)/; # When those are used + local(@syms) = split(/ /, $look_symbols); # Keep original spacing info + $active =~ s/\s+/\n/g; # One symbol per line + + # Concatenate quoted strings, so saying something like 'two words' will + # be introduced as one single symbol "two words". + local(@symbols); # Concatenated symbols to look for + local($concat) = ''; # Concatenation buffer + foreach (@syms) { + if (s/^\'//) { + $concat = $_; + } elsif (s/\'$//) { + push(@symbols, $concat . ' ' . $_); + $concat = ''; + } else { + push(@symbols, $_) unless $concat; + $concat .= ' ' . $_ if $concat; + } + } + + # Now record symbols in master and wanted tables + foreach (@symbols) { + $cmaster{$_} = undef; # Asks for look-up in C files + $cwanted{$_} = "$active" if $active; # Shell symbols to activate + } +} + +# Process the ?INIT: lines +sub p_init { + local($_) = @_; + print INIT "?$unit:", $_; # Wanted only if unit is loaded +} + +# Process the ?D: lines +sub p_default { + local($_) = @_; + s/^([A-Za-z_]+)=(.*)/\@if !$1\n%$1:$1=$2\n\@define $1\n\@end/ + && ($hasdefault{$1}++, print INIT $_); +} + +# Process the ?P: lines +sub p_public { + local($_) = @_; + local($csym); # C symbol(s) we're trying to look at + local($nosym); # List of symbol(s) which mustn't be wanted + local($cfile); # Name of file implementing csym (no .ext) + ($csym, $nosym, $cfile) = /([^()]+)\s*(\(.*\))\s*:\s*(\S+)/; + unless ($csym eq '' || $cfile eq '') { + # Add dependencies for each C symbol, of the form: + # -pick public + # and the file will be added to config.c whenever sym is wanted and + # none of the notdef symbols is wanted. + foreach $sym (split(' ', $csym)) { + $dependencies .= "\t-pick public $sym $cfile $nosym\n"; + } + } +} + +# Process the ?Y: lines +# Valid layouts are for now are: top, bottom, default. +# +# NOTA BENE: +# This routine relies on the $defined variable, a global variable set +# during the ?MAKE: processing, which lists all the defined symbols in +# the unit (the optional leading '+' for internal symbols has been removed +# if present). +# +# The routine fills up a %Layout table, indexed by symbol, yielding the +# layout imposed to this unit. That table will then be used later on when +# we sort wanted symbols for the Makefile. +sub p_layout { + local($_) = @_; + local($layout) = /^\s*(\w+)/; + $layout =~ tr/A-Z/a-z/; # Case is not significant for layouts + unless (defined $Lcmp{$layout}) { + warn "\"$file\", line $.: unknown layout directive '$layout'.\n"; + return; + } + foreach $sym (split(' ', $defined)) { + $Layout{$sym} = $Lcmp{$layout}; + } +} + +# Process the ?L: lines +# There should not be any '-l' in front of the library name +sub p_library { + &write_out("L:$_"); +} + +# Process the ?I: lines +sub p_include { + &write_out("I:$_"); +} + +# Write out line in file Extern.U. The information recorded there has the +# following prototypical format: +# ?symbol:L:inet bsd +# If 'symbol' is wanted, then 'inet bsd' will be added to $libswanted. +sub write_out { + local($_) = @_; + local($target) = $defined; # By default, applies to defined symbols + $target = $1 if s/^(.*)://; # List is qualified "?L:target:symbols" + local(@target) = split(' ', $target); + chop; + foreach $key (@target) { + print EXTERN "?$key:$_\n"; # EXTERN file defined in xref.pl + } +} + diff --git a/mcon/pl/eval.pl b/mcon/pl/eval.pl new file mode 100644 index 0000000..c4c1d76 --- /dev/null +++ b/mcon/pl/eval.pl @@ -0,0 +1,300 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: eval.pl,v $ +;# Revision 3.0.1.1 1995/01/30 14:48:37 ram +;# patch49: removed old "do name()" routine call constructs +;# +;# Revision 3.0 1993/08/18 12:10:22 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# The built-in interpreter +;# +package interpreter; + +# States used by our interpeter -- in sync with @Keep +sub main'init_keep { + # Status in which we keep lines -- $Keep[$status] + @Keep = (0, 1, 1, 0, 1); + + # Available status ($status) + $SKIP = 0; + $IF = 1; + $ELSE = 2; + $NOT = 3; + $OUT = 4; +} + +# Priorities for operators -- magic numbers :-) +sub main'init_priority { + $Priority{'&&'} = 4; + $Priority{'||'} = 3; +} + +# Initializes the state stack of the interpreter +sub main'init_interp { + @state = (); + push(@state, $OUT); +} + +# Print error messages -- asssumes $unit and $. correctly set. +sub error { + warn "\"$main'file\", line $.: @_.\n"; +} + +# If some states are still in the stack, warn the user +sub main'check_state { + &error("one statement pending") if $#state == 1; + &error("$#state statements pending") if $#state > 1; +} + +# Add a value on the stack, modified by all the monadic operators. +# We use the locals @val and @mono from eval_expr. +sub push_val { + local($val) = shift(@_); + while ($#mono >= 0) { + # Cheat... the only monadic operator is '!'. + pop(@mono); + $val = !$val; + } + push(@val, $val); +} + +# Execute a stacked operation, leave result in stack. +# We use the locals @val and @op from eval_expr. +# If the value stack holds only one operand, do nothing. +sub execute { + return unless $#val > 0; + local($op) = pop(@op); + local($val1) = pop(@val); + local($val2) = pop(@val); + push(@val, eval("$val1 $op $val2") ? 1: 0); +} + +# Given an operator, either we add it in the stack @op, because its +# priority is lower than the one on top of the stack, or we first execute +# the stacked operations until we reach the end of stack or an operand +# whose priority is lower than ours. +# We use the locals @val and @op from eval_expr. +sub update_stack { + local($op) = shift(@_); # Operator + if (!$Priority{$op}) { + &error("illegal operator $op"); + return; + } else { + if ($#val < 0) { + &error("missing first operand for '$op' (diadic operator)"); + return; + } + # Because of the special behaviour of do-SUBR with the while modifier, + # I'm using a while-BLOCK construct. I consider this to be a bug of perl + # 4.0 PL19, although it is clearly documented in the man page. + while ( + $Priority{$op[$#op]} > $Priority{$op} # Higher priority op + && $#val > 0 # At least 2 values + ) { + &execute; # Execute an higher priority stacked operation + } + push(@op, $op); # Everything at higher priority has been executed + } +} + +# This is the heart of our little interpreter. Here, we evaluate +# a logical expression and return its value. +sub eval_expr { + local(*expr) = shift(@_); # Expression to parse + local(@val) = (); # Stack of values + local(@op) = (); # Stack of diadic operators + local(@mono) =(); # Stack of monadic operators + local($tmp); + $_ = $expr; + while (1) { + s/^\s+//; # Remove spaces between words + # The '(' construct + if (s/^\(//) { + &push_val(&eval_expr(*_)); + # A final '\' indicates an end of line + &error("missing final parenthesis") if !s/^\\//; + } + # Found a ')' or end of line + elsif (/^\)/ || /^$/) { + s/^\)/\\/; # Signals: left parenthesis found + $expr = $_; # Remove interpreted stuff + &execute() while $#val > 0; # Executed stacked operations + while ($#op >= 0) { + $_ = pop(@op); + &error("missing second operand for '$_' (diadic operator)"); + } + return $val[0]; + } + # A perl statement '{{' + elsif (s/^\{\{//) { + if (s/^(.*)\}\}//) { + &push_val((system + ('perl','-e', "if ($1) {exit 0;} else {exit 1;}" + ))? 0 : 1); + } else { + &error("incomplete perl statement"); + } + } + # A shell statement '{' + elsif (s/^\{//) { + if (s/^(.*)\}//) { + &push_val((system + ("if $1 >/dev/null 2>&1; then exit 0; else exit 1; fi" + ))? 0 : 1); + } else { + &error("incomplete shell statement"); + } + } + # Operator '||' and '&&' + elsif (s/^(\|\||&&)//) { + $tmp = $1; # Save for perl5 (Dataloaded update_stack) + &update_stack($tmp); + } + # Unary operator '!' + elsif (s/^!//) { + push(@mono,'!'); + } + # Everything else is a test for a defined value + elsif (s/^([\?%]?\w+)//) { + $tmp = $1; + # Test for wanted + if ($tmp =~ s/^\?//) { + &push_val(($main'symwanted{$tmp})? 1 : 0); + } + # Test for conditionally wanted + elsif ($tmp =~ s/^%//) { + &push_val(($main'condwanted{$tmp})? 1 : 0); + } + # Default: test for definition (see op @define) + else { + &push_val(( + $main'symwanted{$tmp} || + $main'cmaster{$tmp} || + $main'userdef{$tmp}) ? 1 : 0); + } + } + # An error occured -- we did not recognize the expression + else { + s/^([^\s\(\)\{\|&!]+)//; # Skip until next meaningful char + } + } +} + +# Given an expression in a '@' command, returns a boolean which is +# the result of the evaluation. Evaluate is collecting all the lines +# in the expression into a single string, and then calls eval_expr to +# really evaluate it. +sub evaluate { + local($val); # Value returned + local($expr) = ""; # Expression to be parsed + chop; + while (s/\\$//) { # While end of line escaped + $expr .= $_; + $_ = ; # Fetch next line + unless ($_) { + &error("EOF in expression"); + last; + } + chop; + } + $expr .= $_; + while ($expr ne '') { + $val = &eval_expr(*expr); # Expression will be modified + # We return from eval_expr either when a closing parenthisis + # is found, or when the expression has been fully analysed. + &error("extra closing parenthesis ignored") if $expr ne ''; + } + $val; +} + +# Given a line, we search for commands (lines starting with '@'). +# If there is no command in the line, then we return the boolean state. +# Otherwise, the command is analysed and a new state is computed. +# The returned value of interpret is 1 if the line is to be printed. +sub main'interpret { + local($value); + local($status) = $state[$#state]; # Current status + if (s|^\s*@\s*(\w+)\s*(.*)|$2|) { + local($cmd) = $1; + $cmd =~ y/A-Z/a-z/; # Canonicalize to lower case + # The 'define' command + if ($cmd eq 'define') { + chop; + $userdef{$_}++ if $Keep[$status]; + return 0; + } + # The 'if' command + elsif ($cmd eq 'if') { + # We always evaluate, in order to find possible errors + $value = &evaluate($_); + if (!$Keep[$status]) { + # We have to skip until next 'end' + push(@state, $SKIP); # Record structure + return 0; + } + if ($value) { # True + push(@state, $IF); + return 0; + } else { # False + push(@state, $NOT); + return 0; + } + } + # The 'else' command + elsif ($cmd eq 'else') { + &error("expression after 'else' ignored") if /\S/; + $state[$#state] = $SKIP if $state[$#state] == $IF; + return 0 if $state[$#state] == $SKIP; + if ($state[$#state] == $OUT) { + &error("unexpected 'else'"); + return 0; + } + $state[$#state] = $ELSE; + return 0; + } + # The 'elsif' command + elsif ($cmd eq 'elsif') { + # We always evaluate, in order to find possible errors + $value = &evaluate($_); + $state[$#state] = $SKIP if $state[$#state] == $IF; + return 0 if $state[$#state] == $SKIP; + if ($state[$#state] == $OUT) { + &error("unexpected 'elsif'"); + return 0; + } + if ($value) { # True + $state[$#state] = $IF; + return 0; + } else { # False + $state[$#state] = $NOT; + return 0; + } + } + # The 'end' command + elsif ($cmd eq 'end') { + &error("expression after 'end' ignored") if /\S/; + pop(@state); + &error("unexpected 'end'") if $#state < 0; + return 0; + } + # Unknown command + else { + &error("unknown command '$cmd'"); + return 0; + } + } + $Keep[$status]; +} + +package main; + diff --git a/mcon/pl/extract.pl b/mcon/pl/extract.pl new file mode 100644 index 0000000..385b751 --- /dev/null +++ b/mcon/pl/extract.pl @@ -0,0 +1,109 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: extract.pl,v $ +;# Revision 3.0.1.1 1994/05/06 15:21:43 ram +;# patch23: now saves the last unit line value for metalint +;# +;# Revision 3.0 1993/08/18 12:10:22 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# This is the heart of the dependency extractor. Each control line is +;# processed. The dependencies are stored in $dependencies. +;# +# Extract dependencies from units held in @ARGV +sub extract_dependencies { + local($proc); # Procedure used to handle a ctrl line + local($file); # Current file scanned + local($dir, $unit); # Directory and unit's name + local($old_version) = 0; # True when old-version unit detected + local($mc) = "$MC/U"; # Public metaconfig directory + local($line); # Last processed line for metalint + + printf "Extracting dependency lists from %d units...\n", $#ARGV+1 + unless $opt_s; + + chdir $WD; # Back to working directory + &init_extraction; # Initialize extraction files + $dependencies = ' ' x (50 * @ARGV); # Pre-extend + $dependencies = ''; + + # We do not want to use the <> construct here, because we need the + # name of the opened files (to get the unit's name) and we want to + # reset the line number for each files, and do some pre-processing. + + file: while ($file = shift(@ARGV)) { + close FILE; # Reset line number + $old_version = 0; # True if unit is an old version + if (open(FILE, $file)) { + ($dir, $unit) = ('', $file) + unless ($dir, $unit) = ($file =~ m|(.*)/(.*)|); + $unit =~ s|\.U$||; # Remove extension + } else { + warn("Can't open $file.\n"); + } + # If unit is in the standard public directory, keep only the unit name + $file = "$unit.U" if $dir eq $mc; + print "$dir/$unit.U:\n" if $opt_d; + line: while () { + $line = $_; # Save last processed unit line + if (s/^\?([\w\-]+)://) { # We may have found a control line + $proc = $Depend{$1}; # Look for a procedure to handle it + unless ($proc) { # Unknown control line + $proc = $1; # p_unknown expects symbol in '$proc' + eval '&p_unknown'; # Signal error (metalint only) + next line; # And go on next line + } + # Long lines may be escaped with a final backslash + $_ .= &complete_line(FILE) if s/\\\s*$//; + # Run macros substitutions + s/%)); + next file; + } + } + } continue { + warn(" Warning: $file is a pre-3.0 version.\n") if $old_version; + &$ending($line) if $ending; # Post-processing for metalint + } + + &end_extraction; # End the extraction process +} + +# The first line was escaped with a final \ character. Every following line +# is to be appended to it (until we found a real \n not escaped). Note that +# the leading spaces of the continuation line are removed, so any space should +# be added before the former \ if needed. +sub complete_line { + local($file) = @_; # File where lines come from + local($_); + local($read) = ''; # Concatenation of all the continuation lines found + while (<$file>) { + s/^\s+//; # Remove leading spaces + if (s/\\\s*$//) { # Still followed by a continuation line + $read .= $_; + } else { # We've reached the end of the continuation + return $read . $_; + } + } +} + diff --git a/mcon/pl/files.pl b/mcon/pl/files.pl new file mode 100644 index 0000000..9e6bd08 --- /dev/null +++ b/mcon/pl/files.pl @@ -0,0 +1,109 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: files.pl,v $ +;# Revision 3.0.1.2 1994/10/29 16:35:48 ram +;# patch36: added user-defined file extension support for lookups +;# +;# Revision 3.0.1.1 1993/10/16 13:54:55 ram +;# patch12: now skip confmagic.h when -M option is used +;# +;# Revision 3.0 1993/08/18 12:10:23 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# These two arrays record the file names of the files which may (or may not) +;# contain shell or C symbols known by metaconfig. +;# @SHlist records the .SH files +;# @clist records the C-like files (i.e. .[chyl]) +;# +;# The extensions are actually computed dynamically from the definitions held +;# in the $cext and $shext variables from .package so that people can add new +;# extensions to their packages. For instance, perl5 adds .xs files holding +;# some C symbols. +;# +# Extract filenames from manifest +sub extract_filenames { + &build_filext; # Construct &is_cfile and &is_shfile + print "Extracting filenames (C and SH files) from $NEWMANI...\n" + unless $opt_s; + open(NEWMANI,$NEWMANI) || die "Can't open $NEWMANI.\n"; + local($file); + while () { + ($file) = split(' '); + next if $file eq 'config_h.SH'; # skip config_h.SH + next if $file eq 'Configure'; # also skip Configure + next if $file eq 'confmagic.h' && $opt_M; + push(@SHlist, $file) if &is_shfile($file); + push(@clist, $file) if &is_cfile($file); + } +} + +# Construct two file identifiers based on the file suffix: one for C files, +# and one for SH files (using the $cext and $shext variables) defined in +# the .package file. +# The &is_cfile and &is_shfile routine may then be called to known whether +# a given file is a candidate for holding C or SH symbols. +sub build_filext { + &build_extfun('is_cfile', $cext, '.c .h .y .l'); + &build_extfun('is_shfile', $shext, '.SH'); +} + +# Build routine $name to identify extensions listed in $exts, ensuring +# that $minimum is at least matched (both to be backward compatible with +# older .package and because it is really the minimum requirred). +sub build_extfun { + local($name, $exts, $minimum) = @_; + local(@single); # Single letter dot extensions (may be grouped) + local(@others); # Other extensions + local(%seen); # Avoid duplicate extensions + foreach $ext (split(' ', "$exts $minimum")) { + next if $seen{$ext}++; + if ($ext =~ s/^\.(\w)$/$1/) { + push(@single, $ext); + } else { + # Convert into perl's regexp + $ext =~ s/\./\\./g; # Escape . + $ext =~ s/\?/./g; # ? turns into . + $ext =~ s/\*/.*/g; # * turns into .* + push(@others, $ext); + } + } + local($fn) = &q(< 1; + + # Reset those once for every unit + # (assuming there is only one depend line) + $h_section = 0; # 0 = no ?H: yet, 1 = in ?H:, 2 = ?H:. seen + $h_section_warned = 0; # Whether we warned about terminated ?H: section + $wiped_unit = 0; # Whether macros like " will be wiped + undef %condseen; + undef %depseen; + undef %defseen; + undef %tempseen; + undef %symset; + undef %symused; + undef %csym; + undef %ssym; + undef %hcsym; + undef %hssym; + undef %lintuse; + undef %lintuse_used; + undef %lintseen; + undef %lintchange; + undef %lintchange_used; + undef %lintextern; + undef %lintcreated; + undef %fileseen; + undef %lintseen_used; + undef %filetmp; + undef %filecreated; + undef %linthere; + undef %lintnothere; + undef %lintfused; + undef %lintsdesc; + undef %lintsdesc_used; + undef %lintcdesc; + undef %lintcdesc_used; + undef %lintset; + undef %lintset_used; + + s|^\s*||; # Remove leading spaces + chop; + s/:(.*)//; + @dep = split(' ', $1); # Dependencies + @ary = split(' '); # Locally defined symbols + local($nowarn); # True when +Special is seen + foreach $sym (@ary) { + # Ignore "internal use only" symbols as far as metalint goes. + # Actually, we record the presence of a '+' in front of a special + # unit name and use that as a hint to suppress the presence of that + # special unit in the defined symbol section. + $nowarn = ($sym =~ s/^\+//); + + # We record for each shell symbol the list of units which claim to make + # it, so as to report duplicates. + if ($sym =~ /^[_a-z]/ || $Except{$sym}) { + $shmaster{"\$$sym"} .= "$unit "; + ++$defseen{$sym}; + } else { + warn "$where: special unit '$sym' should not be listed as made.\n" + unless $sym eq $unit || $nowarn; + } + } + # Record dependencies for later perusal + push(@make, join(' ', @ary) . ':' . join(' ', @dep)); + foreach $sym (@dep) { + if ($sym =~ /^\+[_A-Za-z]/) { + $sym =~ s|^\+||; + ++$condseen{$sym}; # Conditional symbol wanted + ++$condsym{$sym}; # %condsym has a greater lifetime + } else { + ++$depseen{$sym}; # Full dependency + } + + # Each 'wanted' special unit (i.e. one starting with a capital letter) + # is remembered, so as to prevent exported symbols from being reported + # as "undefined". For instance, Myread exports $dflt, $ans and $rp. + $shspecial{$unit} .= "$sym " if substr($sym, 0, 1) =~ /^[A-Z]/; + + # Record all known dependencies (special or not) for this unit + $shdepend{$unit} .= "$sym "; + + # Remember where wanted symbol is defined, so that we can report + # stale dependencies later on (i.e. dependencies which refer to non- + # existent symbols). + $symdep{$sym} .= "$unit "; # This symbol is wanted here + } + # Make sure we do not want a symbol twice, nor do we want it once as a full + # dependency and once as a conditional dependency. + foreach $sym (@dep) { + if ($sym =~ /^\+[_A-Za-z]/) { + $sym =~ s|^\+||; + warn "$where: '+$sym' is listed $condseen{$sym} times.\n" + if $condseen{$sym} > 1; + $condseen{$sym} = 1 if $condseen{$sym}; # Avoid multiple messages + } else { + warn "$where: '$sym' is listed $depseen{$sym} times.\n" + if $depseen{$sym} > 1; + $depseen{$sym} = 1 if $depseen{$sym}; # Avoid multiple messages + } + warn "$where: '$sym' listed as both conditional and full dependency.\n" + if $condseen{$sym} && $depseen{$sym}; + } + # Make sure every unit "inherits" from the symbols exported by 'Init'. + $shspecial{$unit} .= 'Init ' unless $shspecial{$unit} =~ /Init\b/; +} + +# Process the ?O: line +sub p_obsolete { + local($_) = @_; + chop; + $Obsolete{"$unit.U"} = $_; # Message to print if unit is used +} + +# Process the ?S: lines +sub p_shell { + local($_) = @_; + local($where) = "\"$file\", line $. (?S:)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + if (/^(\w+)\s*(\(.*\))*\s*:/) { + &check_last_declaration; + $s_symbol = $1; + print " ?S: $s_symbol\n" if $opt_d; + # Make sure we do not define symbol twice and that the symbol is indeed + # listed in the ?MAKE: line. + warn "$where: duplicate description for variable '\$$s_symbol'.\n" + if $ssym{$s_symbol}++; + unless ($defseen{$s_symbol}) { + warn "$where: variable '\$$s_symbol' is not listed " . + "on ?MAKE: line.\n" unless $lintseen{$s_symbol}; + $lintseen_used{$s_symbol}++ if $lintseen{$s_symbol}; + } + # Deal with obsolete symbol list (enclosed between parenthesis) + &record_obsolete("\$$_") if /\(/; + } else { + unless ($s_symbol) { + warn "$where: syntax error in ?S: construct.\n"; + return; + } + } + + m|^\.\s*$| && ($s_symbol = ''); # End of comment +} + +# Process the ?C: lines +sub p_c { + local($_) = @_; + local($where) = "\"$file\", line $. (?C:)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + # The previous ?H: section, if present, must have been closed + if ($h_section && $h_section != 2) { + warn "$where: unclosed ?H: section.\n"; + } + $h_section = 0; + if (s/^(\w+)\s*~\s*(\S+)\s*(.*):/$1 $3:/) { + &check_last_declaration; + $c_symbol = $2; # Alias for definition in config.h + # Record symbol definition for further duplicate spotting + $cmaster{$1} .= "$unit " unless $csym{$1}; + print " ?C: $1 ~ $c_symbol\n" if $opt_d; + # Make sure we do not define symbol twice + warn "$where: duplicate description for symbol '$1'.\n" + if $csym{$1}++; + # Deal with obsolete symbol list (enclosed between parenthesis) + &record_obsolete("$_") if /\(/; + } elsif (/^(\w+)\s*(\(.*\))*\s*:/) { + &check_last_declaration; + $c_symbol = $1; + # Record symbol definition for further duplicate spotting + $cmaster{$c_symbol} .= "$unit " unless $csym{$c_symbol}; + print " ?C: $c_symbol\n" if $opt_d; + # Make sure we do not define symbol twice + warn "$where: duplicate description for symbol '$c_symbol'.\n" + if $csym{$c_symbol}++; + # Deal with obsolete symbol list (enclosed between parenthesis) + &record_obsolete("$_") if /\(/; + } else { + unless ($c_symbol) { + warn "$where: syntax error in ?C: construct.\n"; + return; + } + } + + s|^(\w+)|?$c_symbol:/* $1| || # Start of comment + (s|^\.\s*$|?$c_symbol: */\n| && ($c_symbol = '', 1)) || # End of comment + s|^(.*)|?$c_symbol: *$1|; # Middle of comment +} + +# Process the ?H: lines +sub p_config { + local($_) = @_; + local($where) = "\"$file\", line $. (?H)" unless $where; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + unless ($h_section){ # Entering ?H: section + $h_section = 1; + $h_section_warned = 0; + } + if ($h_section == 2) { + warn "$where: section was already terminated by '?H:.'.\n" + unless $h_section_warned++; + return; + } + if ($_ eq ".\n") { + $h_section = 2; # Marks terminated ?H: section + return; + } + (my $constraint) = m/^\?(\w+):/; + s/^\?\w+://; # Remove leading '?var:' constraint + if (m|^#\$(\w+)\s+(\w+).*\$(\w+)|) { + # Case: #$d_var VAR "$var" + warn "$where: symbol '$2' was already defined.\n" if $hcsym{$2}++; + &check_definition("$1"); + &check_definition("$3"); + } elsif (m|^#define\s+(\w+)\((.*)\)\s+\$(\w+)|) { + # Case: #define VAR(x) $var + warn "$where: symbol '$1' was already defined.\n" if $hcsym{$1}++; + &check_definition("$3"); + } elsif (m|^#\$define\s+(\w+)|) { + # Case: #$define VAR + warn "$where: symbol '$1' was already defined.\n" if $hcsym{$1}++; + } elsif (m|^#\$(\w+)\s+(\w+)|) { + # Case: #$d_var VAR + warn "$where: symbol '$2' was already defined.\n" if $hcsym{$2}++; + &check_definition("$1"); + } elsif (m|^#define\s+(\w+).*\$(\w+)|) { + # Case: #define VAR "$var" + warn "$where: symbol '$1' was already defined.\n" if $hcsym{$1}++; + &check_definition("$2"); + } elsif (m|^#define\s+(\w+)|) { + # Case: #define VAR + $hcsym{$1}++; # Multiple occurrences may be legitimate + } else { + if (/^#/) { + warn "$where: uncommon cpp line should be protected with '?%<:'.\n" + if $constraint eq ''; + } elsif (!/^\@(if|elsif|else|end)\b/) { + warn "$where: line should not be listed here but in '?C:'.\n"; + } + } + + # Ensure the constraint is either %< (unit base name) or a known symbol. + if ($constraint ne '' && $constraint ne $unit) { + warn "$where: constraint '$constraint' is an unknown symbol.\n" + unless $csym{$constraint} || $ssym{$constraint}; + } +} + +# Process the ?M: lines +sub p_magic { + local($_) = @_; + local($where) = "\"$file\", line $. (?M)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + if (/^(\w+):\s*([\w\s]*)\n$/) { + &check_last_declaration; + $m_symbol = $1; + $msym{$1} = "$unit"; # p_wanted ensure we do not define symbol twice + $mdep{$1} = $2; # Save C symbol dependencies + &p_wanted("$unit:$m_symbol"); + } else { + unless ($m_symbol) { + warn "$where: syntax error in ?M: construct.\n"; + return; + } + } + m|^\.\s*$| && ($m_symbol = ''); # End of comment +} + +# Process the ?INIT: lines +sub p_init { + local($_) = @_; + local($where) = "\"$file\", line $. (?INIT)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + &p_body($_, 1); # Pass it along as a body line (leading ?INIT: removed) +} + +# Process the ?D: lines +sub p_default { + local($_) = @_; + local($where) = "\"$file\", line $. (?D)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + local($sym) = /^(\w+)=/; + $hasdefault{$sym}++; + unless ($defseen{$sym}) { + warn "$where: variable '\$$sym' is not listed " . + "on ?MAKE: line.\n" unless $lintseen{$sym}; + $lintseen_used{$sym}++ if $lintseen{$sym}; + } + s/^\w+=//; # So that p_body does not consider variable as being set + &p_body($_, 1); # Pass it along as a body line (leading ?D: + var removed) +} + +# Process the ?V: lines +sub p_visible { + local($where) = "\"$file\", line $. (?V)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + + # A visible symbol can freely be manipulated by any unit which includes the + # current unit in its dependencies. Symbols before ':' may be only used for + # reading while symbols after ':' may be used for both reading and writing. + # The array %shvisible records symbols as keys. Read-only symbols have a + # leading '$' while read-write symbols are recorded as-is. + + unless (substr($unit, 0, 1) =~ /^[A-Z]/) { + warn "$where: visible declaration in non-special unit ignored.\n"; + return; + } + local($read_only) = $_[0] =~ /^([^:]*):?/; + local($read_write) = $_[0] =~ /:(.*)/; + local(@rsym) = split(' ', $read_only); + local(@rwsym) = split(' ', $read_write); + local($w); + foreach (@rsym) { # Read only symbols + warn "$where: wanted variable '\$$_' made visible.\n" if &wanted($_); + warn "$where: defined variable '\$$_' made visible.\n" + if &defined($_) && !$lintseen{$_}; + $w = $shvisible{"\$$_"}; + warn "$where: variable '\$$_' already made visible by unit $w.\n" if $w; + $w = $shvisible{$_}; + warn "$where: variable '\$$_' already read-write visible in $w.\n" if $w; + $shvisible{"\$$_"} = $unit unless $w; + } + foreach (@rwsym) { # Read/write symbols + warn "$where: wanted variable '\$$_' made visible.\n" if &wanted($_); + warn "$where: defined variable '\$$_' made visible.\n" + if &defined($_) && !$lintseen{$_}; + $w = $shvisible{$_}; + warn "$where: variable '\$$_' already made visible by unit $w.\n" if $w; + $w = $shvisible{"\$$_"}; + warn "$where: variable '\$$_' already read-only visible in $w.\n" if $w; + $shvisible{$_} = $unit unless $w; + } +} + +# Process the ?W: lines +sub p_wanted { + local($where) = "\"$file\", line $. (?W)" unless $where; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + # Somehow, we should check that none of the symbols to activate are stale + # ones, i.e. they all finally resolve to some known target -- FIXME + local($active) = $_[0] =~ /^([^:]*):/; # Symbols to activate + local($look_symbols) = $_[0] =~ /:(.*)/; # When those are used + local(@symbols) = split(' ', $look_symbols); + # A "?W:symbol" line asks metaconfig to define 'symbol' in the wanted file + # as a C target iff that word is found within the sources. This is mainly + # intended for the built-in interpreter to check for definedness. + local($w); + foreach (@symbols) { + warn "$where: variable '\$$_' already wanted.\n" if &wanted($_); + warn "$where: variable '\$$_' also locally defined.\n" if &defined($_); + $w = $cwanted{$_}; + if ($msym{$_} ne '') { + warn "$where: symbol '$_' already listed on a ?M: line in '$w'.\n" + if $w; + } else { + warn "$where: variable '\$$_' already listed on a ?W: line in '$w'.\n" + if $w; + } + $cwanted{$_} = $unit unless $w; + } +} + +# Process the ?Y: lines +sub p_layout { + local($where) = "\"$file\", line $. (?Y)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + local($_) = @_; + chop; + s/^\s+//; + tr/A-Z/a-z/; # Layouts are record in lowercase + warn "$where: unknown layout directive '$_'.\n" + unless defined $Lcmp{$_}; +} + +# Process the ?P: lines +sub p_public { + # FIXME +} + +# Process the ?L: lines +sub p_library { + # There should not be any '-l' in front of the library name + # FIXME +} + +# Process the ?I: lines +sub p_include { + # FIXME +} + +# Process the ?T: lines +sub p_temp { + local($where) = "\"$file\", line $. (?T:)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + local($_) = @_; + local(@sym) = split(' ', $_); + foreach $sym (@sym) { + warn "$where: temporary symbol '\$$sym' multiply declared.\n" + if $tempseen{$sym}++ == 1; + $tempmaster{$sym} .= "$unit " if $tempseen{$sym} == 1; + } +} + +# Process the ?F: lines +sub p_file { + local($where) = "\"$file\", line $. (?F:)"; + warn "$where: directive should come after ?MAKE declarations.\n" + unless $makeseen{$unit}; + local($_) = @_; + local(@files) = split(' ', $_); + local($uufile); # Name of file produced in the UU directory + local($tmpfile); # Name of a temporary file + # We care only about UU files, i.e. files produced in the UU directory + # and which are identified by the convention ./filename. Files !filename + # are not produced, i.e. they are temporary or externally provided. + # The %prodfile table records all the files produced, so we may detect + # inconsistencies between units, while %filemaster records the (first) unit + # defining a given UU file to make sure that (special) unit is named in the + # dependency line when that UU file if used. Duplicates will be caught in + # the sanity check phase thanks to %prodfile. + # Temporary files are recorded in %filesetin, so that we may later compare + # the list with the UU files to detect possible overwrites. + my $is_special = substr($unit, 0, 1) =~ /^[A-Z]/; + foreach $file (@files) { + warn "$where: produced file '$file' multiply declared.\n" + if $fileseen{$file}++ == 1; + if (($tmpfile = $file) =~ s/^!//) { + $filetmp{$tmpfile} = 'x '; + $filesetin{$tmpfile} .= "$unit " if $fileseen{$file} == 1; + next; # Is not a UU file for sure, so skip + } + $prodfile{$file} .= "$unit " if $fileseen{$file} == 1; + ($uufile = $file) =~ s|^\./(\S+)$|$1|; + next if $file eq $uufile; # Don't care about non-UU files + unless ($is_special || $lintcreated{$uufile}) { + warn "$where: UU file '$uufile' in non-special unit ignored.\n"; + delete $lintcreated{$uufile}; # Detect spurious LINT + next; + } + delete $lintcreated{$uufile} if !$is_special; # Detect spurious LINT + $filemaster{$uufile} = $unit unless defined $filemaster{$uufile}; + $filecreated{$uufile} = 'a'; # Will be automagically incremented + } +} + +# Process the ?LINT: lines +sub p_lint { + local($_) = @_; + local(@sym); + local($where) = "\"$file\", line $. (?LINT:)"; + s/^\s+//; # Strip leading spaces + unless ($makeseen{$unit}) { + warn "$where: directive should come after ?MAKE declarations.\n" + unless m/^empty/; + } + if (s/^set//) { # Listed variables are set + @sym = split(' ', $_); # Spurious ones will be flagged + foreach (@sym) { + $lintset{$_}++; # Shell variable set + } + } elsif (s/^desc\w+//) { # Listed shell variables are described + @sym = split(' ', $_); # Spurious ones will be flagged + foreach (@sym) { + $lintsdesc{$_}++; # Shell variable described + } + } elsif (s/^creat\w+//) { # Listed created files in regular units + @sym = split(' ', $_); + foreach (@sym) { + $lintcreated{$_}++; # Persistent UU file created + } + } elsif (s/^known//) { # Listed C variables are described + @sym = split(' ', $_); # Spurious ones will be flagged + foreach (@sym) { + $lintcdesc{$_}++; # C symbol described + } + } elsif (s/^change//) { # Shell variable ok to be changed + @sym = split(' ', $_); # Spurious ones will be flagged + foreach (@sym) { + $lintchange{$_}++; # Do not complain if changed + } + } elsif (s/^extern//) { # Variables known to be externally defined + @sym = split(' ', $_); + foreach (@sym) { + $lintextern{$_}++; # Do not complain if used in a ?H: line + } + } elsif (s/^usefile//) { # Files marked as being used + @sym = split(' ', $_); + foreach (@sym) { + $lintfused{$_}++; + } + } elsif (s/^use//) { # Variables declared as used by unit + @sym = split(' ', $_); # Spurious ones will be flagged + foreach (@sym) { + $lintuse{$_}++; # Do not complain if on ?MAKE and not used + } + } elsif (s/^def\w+//) { # Listed variables are defined + @sym = split(' ', $_); # Spurious ones will be flagged + foreach (@sym) { + $lintseen{$_}++; # Shell variable defined in this unit + } + } elsif (m/^empty/) { # Empty unit file + $lintempty{$unit}++; + } elsif (m/^unclosed/) { # Unclosed here-documents + @sym = split(' ', $_); + foreach (@sym) { + $linthere{$_}++; + } + } elsif (s/^nothere//) { # Not a here-document name + @sym = split(' ', $_); + foreach (@sym) { + $lintnothere{$_}++; + } + } elsif (s/^nocomment//) { # OK if leading unit ': comment' missing + $lintnocomment{$unit}++; + } else { + local($where) = "\"$file\", line $." unless $where; + local($word) = /^(\w+)/; + warn "$where: unknown LINT request '$word' ignored.\n"; + } +} + +# Process the body of the unit +sub p_body { + return unless $makeseen{$unit}; + local($_, $special) = @_; + local($where) = "\"$file\", line $." unless $where; + # Ensure there is no control line in the body of the unit + local($control) = /^\?([\w\-]+):/; + local($known) = $control ? $Depend{$control} : ""; + warn "$where: control sequence '?$control:' ignored within body.\n" + if $known && !/^\?X:|^\?LINT:/; + if (s/^\?LINT://) { # ?LINT directives allowed within body + $_ .= &complete_line(FILE) if s/\\\s*$//; + &p_lint($_); + } + return if $known; + # First non-special line should be a ': description' line + unless ($special || /^\?/ || /^@/) { + warn "$where: first body line should be a general ': description'.\n" + unless $past_first_line++ || $lintnocomment{$unit} || /^:\s+\w+/; + } + # Ensure ': comment' lines do not hold any meta-character + # We assume ":)" introduces a case statement. + if (/^\s*:/ && !/^\s*:\)/) { + warn "$where: missing space after ':' to make it a comment.\n" + unless /^\s*:\s/; + s/\\.//g; # simplistic ignoring of "escaped" chars + s/".*?"//g; + s/'.*?'//g; + if ($wiped_unit) { + s/<\$\w+>//g; + foreach my $wipe (@wiping) { + s/<$wipe>//g; + } + } + warn "$where: found unquoted meta-character $1 on comment line.\n" + while s/([`()<>;&\{\}\|])//g; + warn "$where: found dangling quote on ':' comment line.\n" if /['"]/; + return; + } + # Ingnore interpreted lines and their continuations + if ($last_interpreted) { + return if /\\$/; # Still part of the interpreted line + $last_interpreted = 0; # End of interpreted lines + return; # This line was the last interpreted + } + # Look for interpreted lines and ignore them + if (/^@/) { + $last_interpreted = /\\$/; # Set flag if line is continued + return; # And skip this line + } + # Detect ending of "here" documents + if ($heredoc ne '' && $_ eq "$heredoc\n") { + $heredoc = ''; # Close here-document + $heredoc_nosubst = 0; + return; + } + # Detect beginning of "here" document + my $began_here = 0; + if ($heredoc eq '') { + if (/<<\s*''/) { + # Discourage it, because we're not processing those... + warn "$where: empty here-document name discouraged.\n"; + } elsif (/<<\s*'([^']+)'/ && !$lintnothere{$1}) { + $heredoc = $1; + $heredoc_nosubst = 1; + $began_here++; + } elsif (/<<\s*(\S+)/ && !$lintnothere{$1}) { + $heredoc = $1; + $began_here++; + } + # Continue, as we need to look for possible ">file" on the same line + # as a possible here document, as in "cat <file". + } else { + return if $heredoc_nosubst; # Completely opaque to interpretation + } + $heredoc_line = $. if $began_here; + + # If we've just entered a here document and we're generating a file + # that is exported by the unit, then we need to monitor the variables + # used to make sure there's no missing dependency. + $heredoc_nosubst = 0 + if $began_here && />>?\s*(\S+)/ && $filemaster{$1} eq $unit; + + # From now on, do all substitutes with ':' since it would be dangerous + # to remove things plain and simple. It could yields false matches + # afterwards... + + my $check_vars = 1; + $chek_vars = 0 if $heredoc_nosubst && !$began_here; + + # Record any attempt made to set a shell variable + local($sym); + while ($check_vars && s/(\W?)(\w+)=/$1:/) { + my $before = $1; + $sym = $2; + next unless $before eq '' || $before =~ /["'` \t]/; + next if $sym =~ /^\d+/; # Ignore $1 and friends + $symset{$sym}++; # Shell variable set + # Not part of a $cc -DWHATEVER line and not made nor temporary + unless ($sym =~ /^D/ || &defined($sym)) { + if (&wanted($sym)) { + warn "$where: variable '\$$sym' is changed.\n" + unless $lintchange{$sym}; + $lintchange_used{$sym}++ if $lintchange{$sym}; + } else { + # Record that the variable is set but not listed locally. + if ($shset{$unit} !~ /\b$sym\b/) { + $shset{$unit} .= "$sym " unless $lintchange{$sym}; + $lintchange_used{$sym}++ if $lintchange{$sym}; + } + } + } + } + # Now look at the shell variables used: can be $var or ${var} + local($var); + local($line) = $_; + while ($check_vars && s/\$\{?(\w+)\}?/$1/) { + $var = $1; + next if $var =~ /^\d+/; # Ignore $1 and friends + # Record variable as undeclared but do not issue a message right now. + # That variable could be exported via ?V: (as $dflt in Myread) or be + # defined by a special unit (like $inlibc by unit Inlibc). + $shunknown{$unit} .= "$var " unless + $lintextern{$var} || &declared($var) || + $shunknown{$unit} =~ /\b$var\b/; + $shused{$unit} .= "\$$var " unless $shused{$unit} =~ /\$$var\b/; + } + + return if $heredoc ne '' && !$began_here; # Still in here-document + + # Now look at private files used by the unit (./file or ..../UU/file) + # We look at things like '. ./myread' and `./loc ...` as well as "< file" + local($file); + $_ = $line; + s/<\S+?>//g; # would set-off our >file or >file + while (s!>>?\s*([^\$/`\s;]+)\s*!: !) { + $file = $1; + next if $file =~ /&\d+/; # skip >&4 and friends + $filecreated{$file}++; + } + # Look for mentions of known temporary files to avoid complaining + # that they were not used. + while (s!\s+(\S+)!!) { + $file = $1; + $filetmp{$file} .= ' used' + if defined $filetmp{$file} && $filetmp{$file} !~ /\bused/; + } +} + +# Called at the end of each unit +sub p_end { + local($last) = @_; # Last processed line + local($where) = "\"$file\""; + + # The ?H: section, if present, must have been closed + if ($h_section && $h_section != 2) { + warn "$where: unclosed ?H: section.\n"; + } + $h_section = 0; # For next unit, which may be empty + + # All opened here-documents must be closed. + if ($heredoc ne '') { + my $q = $heredoc_nosubst ? "'" : ""; + warn "$where: unclosed here-document $q$heredoc$q " . + "started line $heredoc_line.\n" + unless $linthere{$heredoc}; + } + + # Reinitialize for next unit. + $heredoc = ''; + $heredoc_nosubst = 0; + $past_first_line = 0; + $last_interpreted = 0; + + unless ($makeseen{$unit}) { + warn "$where: no ?MAKE: line describing dependencies.\n" + unless $lintempty{$unit}; + return; + } + + # Each unit should end with a blank line. Unfortunately, some units + # may also end with an '@end' request and have the blank line above it. + # Currently, we do not have enough information to correctly diagnose + # whether it is valid or not so just skip it. + # Same thing for U/Obsol_sh.U which ends with a shell comment. + + warn "$where: not ending with a blank line.\n" unless + $last =~ /^\s*$/ || $last =~ /^\@end/ || $last =~ /^#|\?/; + + # For EMACS users. It would be fatal to the Configure script... + warn "$where: last line not ending with a new-line character.\n" + unless $last =~ /\n$/; + + # Make sure every shell symbol described in ?MAKE had a description + foreach $sym (sort keys %defseen) { + unless ($ssym{$sym}) { + warn "$where: symbol '\$$sym' was not described.\n" + unless $lintsdesc{$sym}; + $lintsdesc_used{$sym}++ if $lintsdesc{$sym}; + } + } + # Ensure all the C symbols defined by ?H: lines have a description + foreach $sym (sort keys %hcsym) { + unless ($csym{$sym}) { + warn "$where: C symbol '$sym' was not described.\n" + unless $lintcdesc{$sym}; + $lintcdesc_used{$sym}++ if $lintcdesc{$sym}; + } + } + # Ensure all the C symbols described by ?C: lines are defined in ?H: + foreach $sym (sort keys %csym) { + warn "$where: C symbol '$sym' was not defined by any ?H: line.\n" + unless $hcsym{$sym}; + } + # Make sure each defined symbol was set, unless it starts with an + # upper-case letter in which case it is not a "true" shell symbol. + # I don't care about the special symbols defined in %Except as I know + # they are handled correctly. + foreach $sym (sort keys %defseen) { + unless ($symset{$sym} || substr($sym, 0, 1) =~ /^[A-Z]/) { + warn "$where: variable '\$$sym' should have been set.\n" + unless $lintset{$sym}; + $lintset_used{$sym}++ if $lintset{$sym}; + } + } + # Make sure every non-special unit declared as wanted is indeed needed + foreach $sym (sort keys %depseen) { + if ($shused{$unit} !~ /\$$sym\b/ && substr($sym, 0, 1) !~ /^[A-Z]/) { + warn "$where: unused dependency variable '\$$sym'.\n" unless + $lintchange{$sym} || $lintuse{$sym}; + $lintchange_used{$sym}++ if $lintchange{$sym}; + $lintuse_used{$sym}++ if $lintuse{$sym}; + } + } + # Idem for conditionally wanted symbols + foreach $sym (sort keys %condseen) { + if ($shused{$unit} !~ /\$$sym\b/ && substr($sym, 0, 1) !~ /^[A-Z]/) { + warn "$where: unused conditional variable '\$$sym'.\n" unless + $lintchange{$sym} || $lintuse{$sym}; + $lintchange_used{$sym}++ if $lintchange{$sym}; + $lintuse_used{$sym}++ if $lintuse{$sym}; + } + } + # Idem for temporary symbols + foreach $sym (sort keys %tempseen) { + if ($shused{$unit} !~ /\$$sym\b/ && !$symset{$sym}) { + warn "$where: unused temporary variable '\$$sym'.\n" unless + $lintuse{$sym}; + $lintuse_used{$sym}++ if $lintuse{$sym}; + } + } + # Idem for local files + foreach $file (sort keys %filetmp) { + warn "$where: mis-used temporary file '$file'.\n" if + $filetmp{$file} =~ /\bmisused/; + warn "$where: unused temporary file '$file'.\n" unless + $lintfused{$file} || + $filetmp{$file} =~ /\bused/ || $filetmp{$file} =~ /\bmisused/; + } + # Make sure each private file listed as created on ?F: is really created. + # When found, a private UU file is entered in the %filecreated array + # with value 'a'. Each time a file creation occurs in the unit, an + # increment is done on that value. Since 'a'++ -> 'b', a numeric value + # in %filecreated means a non-local file, which is skipped. An 'a' means + # the file was not created... + local($value); + foreach $file (sort keys %filecreated) { + $value = $filecreated{$file}; + next if $value > 0; # Skip non UU-files. + warn "$where: file '$file' was not created.\n" if $value eq 'a'; + } + # Check whether some of the LINT directives were useful + foreach my $sym (sort keys %lintcreated) { + warn "$where: spurious 'LINT create $sym' directive.\n"; + } + foreach my $sym (sort keys %lintuse) { + warn "$where: spurious 'LINT use $sym' directive.\n" + unless $lintuse_used{$sym}; + } + foreach my $sym (sort keys %lintchange) { + warn "$where: spurious 'LINT change $sym' directive.\n" + unless $lintchange_used{$sym}; + } + foreach my $sym (sort keys %lintseen) { + warn "$where: spurious 'LINT define $sym' directive.\n" + unless $lintseen_used{$sym}; + } + foreach my $sym (sort keys %lintsdesc) { + warn "$where: spurious 'LINT describe $sym' directive.\n" + unless $lintsdesc_used{$sym}; + } + foreach my $sym (sort keys %lintcdesc) { + warn "$where: spurious 'LINT known $sym' directive.\n" + unless $lintcdesc_used{$sym}; + } + foreach my $sym (sort keys %lintset) { + warn "$where: spurious 'LINT set $sym' directive.\n" + unless $lintset_used{$sym}; + } +} + +# An unknown control line sequence was found (held in $proc) +sub p_unknown { + warn "\"$file\", line $.: unknown control sequence '?$proc:'.\n"; +} + +# Run sanity checks, to make sure every conditional symbol has a suitable +# default value. Also ensure every symbol was defined once. +sub sanity_checks { + print "Sanity checks...\n"; + local($key, $value); + local($w); + local(%message); # Record messages on a per-unit basis + local(%said); # Avoid duplicate messages + # Warn about symbols ever used in conditional dependency with no default + while (($key, $value) = each(%condsym)) { + unless ($hasdefault{$key}) { + $w = (split(' ', $shmaster{"\$$key"}))[0]; + $message{$w} .= "#$key "; + } + } + # Warn about any undeclared variables. They are all listed in %shunknown, + # being the values while the unit where they appear is the key. If the + # symbol is defined by any of the special units included or made visible, + # then no warning is issued. + local($defined); # True if symbol is defined in one unit + local($where); # List of units where symbol is defined + local($myself); # The name of the current unit if itself special + local($visible); # Symbol made visible via a ?V: line + foreach $unit (sort keys %shunknown) { + foreach $sym (split(' ', $shunknown{$unit})) { + $defined = 0; + $where = $shmaster{"\$$sym"}; + $defined = 1 if $tempmaster{"\$$sym"} =~ /$unit\b/; + $myself = substr($unit, 0, 1) =~ /^[A-Z]/ ? $unit : ''; + # Symbol has to be either defined within one of the special units + # listed in the dependencies or exported via a ?V: line. + unless ($defined) { + $defined = &visible($sym, $unit); + $spneeded{$unit}++ if $defined; + } + $message{$unit} .= "\$$sym " unless $defined; + } + } + + # Warn about any undeclared files. Files used in one unit are all within + # the %fileused table, indexed by unit. If a file is used, it must either + # be in the unit that declared it (relying on %filemaster for that) or + # the unit listed in %filemaster must be part of our dependency. + %said = (); + foreach $unit (sort keys %fileused) { + foreach $file (split(' ', $fileused{$unit})) { + $defined = 0; + $where = $filemaster{$file}; # Where file is created + $defined = 1 if $unit eq $where; # We're in the unit defining it + # Private UU files may be only be created by special units + foreach $special (split(' ', $shspecial{$unit})) { + last if $defined; + $defined = 1 if $where eq $special; + } + # Exceptions to above rule possible via a ?LINT:create hint, + # so parse all known dependencies for the unit... + foreach $depend (split(' ', $shdepend{$unit})) { + last if $defined; + $defined = 1 if $where eq $depend; + } + $message{$unit} .= "\@$file " unless + $defined || $said{"$unit/$file"}++; # Unknown file + } + } + undef %fileused; + + # Warn about any misused files, kept in %filemisused + foreach $unit (sort keys %filemisused) { + foreach $file (split(' ', $filemisused{$unit})) { + next unless defined $filemaster{$file}; # Skip non UU-files + $message{$unit} .= "\@\@$file "; # Misused file + } + } + undef %filemisused; + + # Warn about temporary files which could be created and inadvertently + # override a private UU file (listed in %filemaster). + foreach $tmpfile (keys %filesetin) { + next unless defined $filemaster{$tmpfile}; + $where = $filemaster{$tmpfile}; + foreach $unit (split(' ', $filesetin{$tmpfile})) { + $message{$unit} .= "\@\@\@$where:$tmpfile "; + } + } + undef %filesetin; + + # Warn about any set variable which was not listed. + foreach $unit (sort keys %shset) { + symbol: foreach $sym (split(' ', $shset{$unit})) { + next if $shvisible{$sym}; + $defined = 0; + # Symbol has to be either defined within one of the special units + # listed in the dependencies or exported read-write via a ?V: line. + # If symbol is exported read-only, report the attempt to set it. + $where = $shmaster{"\$$sym"}; + study $where; + foreach $special (split(' ', $shspecial{$unit})) { + $defined = 1 if $where =~ /\b$special\b/; + last if $defined; + } + $visible = 0; + $defined = $visible = &visible($sym, $unit) unless $defined; + if ($visible && $shvisible{"\$$sym"} ne '') { + # We are allowed to set a read-only symbol in the unit which + # declared it... + next symbol if $shvisible{"\$$sym"} eq $unit; + $message{$unit} .= "\&$sym "; # Read-only symbol set + next symbol; + } + $message{$unit} .= "$sym " unless $defined; + } + } + # Warn about any obsolete variable which may be used + foreach $unit (sort keys %shused) { + foreach $sym (split(' ', $shused{$unit})) { + $message{$unit} .= "!$sym " if $Obsolete{$sym} ne ''; + } + } + + # Warn about stale dependencies, and prepare successor and predecessor + # tables for later topological sort. + + local($targets, $deps); + local(%Succ); # Successors + local(%Prec); # Predecessors + + # Split dependencies and build successors array. + foreach $make (@make) { + ($targets, $deps) = $make =~ m|(.*):\s*(.*)|; + $deps =~ s/\+(\w)/$1/g; # Remove conditional targets + foreach $target (split(' ', $targets)) { + $Succ{$target} .= $deps . ' '; + } + } + + # Special setup for the End target, which normally has a $W dependency for + # wanted symbols. In order to detect all the possible cycles, we forge a + # huge dependency by making ALL the regular symbols (i.e. those whose first + # letter is not uppercased) wanted. + + local($allwant) = ''; + { + local($sym, $val); + while (($sym, $val) = each %shmaster) { + $sym =~ s/^\$//; + $allwant .= "$sym " if $val ne ''; + } + } + + $Succ{'End'} =~ s/\$W/$allwant/; + + # Initialize precursors, and spot symbols impossible to 'make', i.e. those + # symbols listed in the successors and with no 'make' target. The data + # structures %Prec and %Succ will also be used by the cycle lookup code, + # in other words, the topological sort. + foreach $target (keys %Succ) { + $Prec{$target} += 0; # Ensure key is recorded without disturbing. + foreach $succ (split(' ', $Succ{$target})) { + $Prec{$succ}++; # Successor has one more precursor + unless (defined $Succ{$succ} || $said{$succ}++) { + foreach $unit (split(' ', $symdep{$succ})) { + $message{$unit} .= "?$succ "; # Stale ?MAKE: dependency + } + } + } + } + undef %symdep; + + # Check all ?M: dependencies to spot stale ones + %said = (); + while (($key, $value) = each(%msym)) { + next if $value eq ''; # Value is unit name where ?M: occurred + foreach $sym (split(' ', $mdep{$key})) { # Loop on C dependencies + next if $cmaster{$sym} || $said{$sym}; + $message{$value} .= "??$sym "; # Stale ?M: dependency + $said{$sym}++; + } + } + + undef %said; + undef %mdep; + undef %msym; + + # Now actually emit all the warnings + local($uv); # Unit defining visible symbol or private file + local($w); # Were we are signaling an error + foreach $unit (sort keys %message) { + undef %said; + $w = "\"$unit.U\""; + foreach (split(' ', $message{$unit})) { + if (s/^#//) { + warn "$w: symbol '\$$_' has no default value.\n"; + } elsif (s/^\?\?//) { + warn "$w: stale ?M: dependency '$_'.\n"; + } elsif (s/^\?//) { + warn "$w: stale ?MAKE: dependency '$_'.\n"; + } elsif (s/^\$//) { + if ($shmaster{"\$$_"} ne '') { + warn "$w: symbol '\$$_' missing from ?MAKE.\n"; + } elsif (($uv = $shvisible{$_}) ne '') { + warn "$w: missing $uv from ?MAKE for visible '\$$_'.\n"; + } elsif (($uv = $shvisible{"\$$_"}) ne '') { + warn "$w: missing $uv from ?MAKE for visible '\$$_'.\n"; + } else { + warn "\"$unit.U\": unknown symbol '\$$_'.\n"; + } + ++$said{$_}; + } elsif (s/^\&//) { + warn "\"$unit.U\": read-only symbol '\$$_' is set.\n"; + ++$said{$_}; + } elsif (s/^!//) { + warn "\"$unit.U\": obsolete symbol '$_' is used.\n"; + ++$said{$_}; + } elsif (s/^\@\@\@//) { + $uv = '?'; # To spot format errors + s/^(\w+):// && ($uv = $1); + warn "$w: local file '$_' may override the one set by $uv.U.\n"; + } elsif (s/^\@\@//) { + $uv = $filemaster{$_}; + warn "$w: you might not always get file '$_' from $uv.U.\n"; + } elsif (s/^\@//) { + if ($uv = $filemaster{$_}) { + warn "$w: missing $uv from ?MAKE for private file '$_'.\n"; + } else { + warn "$w: unknown private file '$_'.\n"; + } + ++$said{"\@$_"}; + } else { + warn "\"$unit.U\": undeclared symbol '\$$_' is set.\n" + unless $said{$_}; + } + } + } + + # Memory cleanup + undef %message; + undef %said; + undef %shused; + undef %shset; + undef %shspecial; + undef %shvisible; + undef %filemaster; + + # Spot multiply defined C symbols + foreach $sym (keys %cmaster) { + @sym = split(' ', $cmaster{$sym}); + if (@sym > 1) { + warn "C symbol '$sym' is defined in the following units:\n"; + foreach (@sym) { + print STDERR "\t$_.U\n"; + } + } + } + undef %cmaster; # Memory cleanup + + # Warn about multiply defined symbols. There are three kind of symbols: + # target symbols, obsolete symbols and temporary symbols. + # For each of these sets, we make sure the intersection with the other sets + # is empty. Besides, we make sure target symbols are only defined once. + + local(@sym); + foreach $sym (keys %shmaster) { + @sym = split(' ', $shmaster{$sym}); + if (@sym > 1) { + warn "Shell symbol '$sym' is defined in the following units:\n"; + foreach (@sym) { + print STDERR "\t$_.U\n"; + } + } + $message{$sym} .= 'so ' if $Obsolete{$sym}; + $message{$sym} .= 'st ' if $tempmaster{$sym}; + } + foreach $sym (keys %tempmaster) { + $message{$sym} .= 'ot ' if $Obsolete{$sym}; + } + local($_); + while (($sym, $_) = each %message) { + if (/so/) { + if (/ot/) { + warn "Shell symbol '$sym' is altogether:\n"; + @sym = split(' ', $shmaster{$sym}); + @sym = grep(s/$/.U/, @sym); + print STDERR "...defined in: ", join(', ', @sym), "\n"; + print STDERR "...obsoleted by $Obsolete{$sym}.\n"; + @sym = split(' ', $tempmaster{$sym}); + @sym = grep(s/$/.U/, @sym); + print STDERR "...used as temporary in:", join(', ', @sym), "\n"; + } else { + warn "Shell symbol '$sym' is both defined and obsoleted:\n"; + @sym = split(' ', $shmaster{$sym}); + @sym = grep(s/$/.U/, @sym); + print STDERR "...defined in: ", join(', ', @sym), "\n"; + print STDERR "...obsoleted by $Obsolete{$sym}.\n"; + } + } elsif (/st/) { # Cannot be ot as it would imply so + warn "Shell symbol '$sym' is both defined and used as temporary:\n"; + @sym = split(' ', $shmaster{$sym}); + @sym = grep(s/$/.U/, @sym); + print STDERR "...defined in: ", join(', ', @sym), "\n"; + @sym = split(' ', $tempmaster{$sym}); + @sym = grep(s/$/.U/, @sym); + print STDERR "...used as temporary in:", join(', ', @sym), "\n"; + } elsif (/ot/) { + warn "Shell symbol '$sym' obsoleted also used as temporary:\n"; + print STDERR "...obsoleted by $Obsolete{$sym}.\n"; + @sym = split(' ', $tempmaster{$sym}); + @sym = grep(s/$/.U/, @sym); + print STDERR "...used as temporary in:", join(', ', @sym), "\n"; + } + } + + # Spot multiply defined files, either private or public ones + foreach $file (keys %prodfile) { + @sym = split(' ', $prodfile{$file}); + if (@sym > 1) { + warn "File '$file' is defined in the following units:\n"; + foreach (@sym) { + print STDERR "\t$_\n"; + } + } + } + undef %prodfile; + + + # Memory cleanup (we still need %shmaster for tsort) + undef %message; + undef %tempmaster; + undef %Obsolete; + + # Make sure there is no dependency cycle + print "Looking for dependency cycles...\n"; + &tsort(*Succ, *Prec); # Destroys info from %Prec +} + +# Make sure last declaration ended correctly with a ?S:. or ?C:. line. +# The variable '$where' was correctly positionned by the calling routine. +sub check_last_declaration { + warn "$where: definition of '\$$s_symbol' not closed by '?S:.'.\n" + if $s_symbol ne ''; + warn "$where: definition of '$c_symbol' not closed by '?C:.'.\n" + if $c_symbol ne ''; + warn "$where: magic definition of '$m_symbol' not closed by '?M:.'.\n" + if $m_symbol ne ''; + $s_symbol = $c_symbol = $m_symbol = ''; +} + +# Make sure the variable is mentionned on the ?MAKE line, if possible in the +# definition section. +# The variable '$where' was correctly positionned by the calling routine. +sub check_definition { + local($var) = @_; + warn "$where: variable '\$$var' not even listed on ?MAKE: line.\n" + unless $defseen{$var} || $condseen{$var} || $depseen{$var}; + warn "$where: variable '\$$var' is defined externally.\n" + if !$lintextern{$var} && !$defseen{$var} && &wanted($var); +} + +# Is symbol declared somewhere? +sub declared { + &defined($_[0]) || &wanted($_[0]); +} + +# Is symbol defined by unit? +sub defined { + $tempseen{$_[0]} || $defseen{$_[0]} || $lintseen{$_[0]}; +} + +# Is symbol wanted by unit? +sub wanted { + $depseen{$_[0]} || $condseen{$_[0]}; +} + +# Is symbol visible from the unit? +# Locate visible symbols throughout the special units. Each unit having +# some special dependencies (special units wanted) have an entry in the +# %shspecial array, listing all those special dependencies. And each +# symbol made visible by ONE special unit has an entry in the %shvisible +# array. +sub visible { + local($symbol, $unit) = @_; + local(%explored); # Special units we've already explored + &explore($symbol, $unit); # Perform recursive search +} + +# Recursively explore the dependencies to locate a visible symbol +sub explore { + local($symbol, $unit) = @_; + # If unit was already explored, we know it has not been found by following + # that path. + return 0 if defined $explored{$unit}; + $explored{$unit} = 0; # Assume nothing found in this unit + local($specials) = $shspecial{$unit}; + # Don't waste any time if unit does not have any special units listed + # in its dependencies. + return 0 unless $specials; + foreach $special (split(' ', $specials)) { + return 1 if ( + $shvisible{"\$$symbol"} eq $unit || + $shvisible{$symbol} eq $unit || + &explore($symbol, $special) + ); + } + 0; +} + diff --git a/mcon/pl/locate.pl b/mcon/pl/locate.pl new file mode 100644 index 0000000..ea7d03f --- /dev/null +++ b/mcon/pl/locate.pl @@ -0,0 +1,153 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: locate.pl,v $ +;# Revision 3.0.1.1 1994/10/29 16:36:52 ram +;# patch36: misspelled a 'closedir' as a 'close' statement +;# +;# Revision 3.0 1993/08/18 12:10:25 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# Locate units and put them in the @ARGV array, for later perusal. We first +;# look in the private U directory, then in the public U library. In each U +;# directory, units may be gathered in clusters (directories). These clusters +;# should not have a name ending with .U, as those will never be stat()'ed. +;# +;# NB: Currently, the clusters are only a practical way of grouping a set of +;# closely related units. There must not be any name conflicts. +;# +;# The following variables are used: +;# $WD is assumed to be the working directory (where the process was spawned) +;# $MC is the location of metaconfig's public library +;# @ARGV is the list of all the units full path +;# %Unit maps an unit name (without final .U) to a path +;# @myUlist lists the user's units, which will be appended at the end of @ARGV +;# %myUseen lists the user's units which overwrite public ones +;# +package locate; + +# Locate the units and push their path in @ARGV (sorted alphabetically) +sub main'locate_units { + print "Locating units...\n" unless $main'opt_s; + local(*WD) = *main'WD; # Current working directory + local(*MC) = *main'MC; # Public metaconfig library + undef %myUlist; # Records private units paths + undef %myUseen; # Records private/public conflicts + &private_units; # Locate private units in @myUlist + &public_units; # Locate public units in @ARGV + @ARGV = sort @ARGV; # Sort it alphabetically + push(@ARGV, sort @myUlist); # Append user's units sorted + &dump_list if $main'opt_v; # Dump the list of units +} + +# Dump the list of units on stdout +sub dump_list { + print "\t"; + $, = "\n\t"; + print @ARGV; + $, = ''; + print "\n"; +} + +# Scan private units +sub private_units { + return unless -d 'U'; # Nothing to be done if no 'U' entry + local(*ARGV) = *myUlist; # Really fill in @myUlist + local($MC) = $WD; # We are really in the working directory + &units_path("U"); # Locate units in the U directory + local($unit_name); # Unit's name (without .U) + local(@kept); # Array of kept units + # Loop over the units and remove duplicates (the first one seen is the one + # we keep). Also set the %myUseen H table to record private units seen. + foreach (@ARGV) { + ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path + next if $myUseen{$unit_name}; # Already recorded + $myUseen{$unit_name} = 1; # Record pirvate unit + push(@kept, $_); # Keep this unit + } + @ARGV = @kept; +} + +# Scan public units +sub public_units { + chdir($MC) || die "Can't find directory $MC.\n"; + &units_path("U"); # Locate units in public U directory + chdir($WD) || die "Can't go back to directory $WD.\n"; + local($path); # Relative path from $WD + local($unit_name); # Unit's name (without .U) + local(*Unit) = *main'Unit; # Unit is a global from main package + local(@kept); # Units kept + local(%warned); # Units which have already issued a message + # Loop over all the units and keep only the ones that were not found in + # the user's U directory. As it is possible two or more units with the same + # name be found in + foreach (@ARGV) { + ($unit_name) = m|^.*/(.*)\.U$|; # Get unit's name from path + next if $warned{$unit_name}; # We have already seen this unit + $warned{$unit_name} = 1; # Remember we have warned the user + if ($myUseen{$unit_name}) { # User already has a private unit + $path = $Unit{$unit_name}; # Extract user's unit path + next if $path eq $_; # Same path, we must be in mcon/ + $path =~ s|^$WD/||o; # Weed out leading working dir path + print " Your private $path overrides the public one.\n" + unless $main'opt_s; + } else { + push(@kept, $_); # We may keep this one + } + } + @ARGV = @kept; +} + +# Recursively locate units in the directory. Each file ending with .U has to be +# a unit. Others are stat()'ed, and if they are a directory, they are also +# scanned through. The $MC and @ARGV variable are dynamically set by the caller. +sub units_path { + local($dir) = @_; # Directory where units are to be found + local(@contents); # Contents of the directory + local($unit_name); # Unit's name, without final .U + local($path); # Full path of a unit + local(*Unit) = *main'Unit; # Unit is a global from main package + unless (opendir(DIR, $dir)) { + warn("Cannot open directory $dir.\n"); + return; + } + print "Locating in $MC/$dir...\n" if $main'opt_v; + @contents = readdir DIR; # Slurp the whole thing + closedir DIR; # And close dir, ready for recursion + foreach (@contents) { + next if $_ eq '.' || $_ eq '..'; + if (/\.U$/) { # A unit, definitely + ($unit_name) = /^(.*)\.U$/; + $path = "$MC/$dir/$_"; # Full path of unit + push(@ARGV, $path); # Record its path + if (defined $Unit{$unit_name}) { # Already seen this unit + if ($main'opt_v) { + ($path) = $Unit{$unit_name} =~ m|^(.*)/.*|; + print " We've already seen $unit_name.U in $path.\n"; + } + } else { + $Unit{$unit_name} = $path; # Map name to path + } + next; + } + # We have found a file which does not look like a unit. If it is a + # directory, then scan it. Otherwise skip the file. + unless (-d "$dir/$_") { + print " Skipping file $_ in $dir.\n" if $main'opt_v; + next; + } + &units_path("$dir/$_"); + print "Back to $MC/$dir...\n" if $main'opt_v; + } +} + +package main; + diff --git a/mcon/pl/makefile.pl b/mcon/pl/makefile.pl new file mode 100644 index 0000000..290c995 --- /dev/null +++ b/mcon/pl/makefile.pl @@ -0,0 +1,176 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: makefile.pl,v $ +;# Revision 3.0.1.1 1995/09/25 09:19:42 ram +;# patch59: symbols are now sorted according to the ?Y: layout directive +;# +;# Revision 3.0 1993/08/18 12:10:26 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# Given a list of wanted symbols in the Wanted file, produce a Makefile which +;# will compute the transitive closure of dependencies for us and give the +;# correct layout order in the Configure script. Because some conditional +;# symbols could indeed be truly wanted symbols, we build the makefile in two +;# passes. The first one will give us the complete list of units to be loaded, +;# while the second will determine the correct order. +;# +;# The external $saved_dependencies records the original dependencies we got +;# from the units' ?MAKE: lines while $dependencies is tampered with. +;# +;# Note that when the -w option is supplied, the sources are not parsed. +;# However, the config.h.SH file would be empty, because its building +;# relies on values in cmaster and shmaster arrays. It is okay for values +;# in shmaster, because they are true wanted symbols. The cmaster keys +;# have also been written, but with a leading '>' (because they are +;# not true targets for Makefile). We thus extract all these keys and +;# set the cmaster array accordingly. +;# +;# Obsolete symbols, if any found, are also part of the Wanted file, written on +;# a line starting with a '!', eventually followed by a '>' if the obsolete +;# symbol is a C one. +;# +;# These three data structures record wanted things like commands or symbols. +;# %symwanted{'sym'} is true when the symbol is wanted (transitive closure) +;# %condwanted{'sym'} when the default value of a symbol is requested +;# $wanted records the set of wanted shell symbols (as opposed to C ones) +;# +# Build the private makefile we use to compute the transitive closure of the +# previously determined dependencies. +sub build_makefile { + print "Computing optimal dependency graph...\n" unless $opt_s; + chdir('.MT') || die "Can't chdir to .MT\n"; + local($wanted); # Wanted shell symbols + &build_private; # Build a first makefile from dependencies + &compute_loadable; # Compute loadable units + &update_makefile; # Update makefile using feedback from first pass + chdir($WD) || die "Can't chdir back to $WD\n"; + # Free memory by removing useless data structures + undef $dependencies; + undef $saved_dependencies; +} + +# First pass: build a private makefile from the extracted dependency, changing +# conditional units to truly wanted ones if the symbol is used, removing the +# dependency otherwise. The original dependencies are saved. +sub build_private { + print " Building private make file...\n" unless $opt_s; + open(WANTED,"../Wanted") || die "Can't reopen Wanted.\n"; + $wanted = ' ' x 2000; # Pre-extend string + $wanted = ''; + while () { + chop; + next if /^!/; # Skip obsolete symbols + if (s/^>//) { + $cmaster{$_}++; + } else { + $wanted .= "$_ "; + } + } + close WANTED; + + # The wanted symbols are sorted so that d_* (checking for C library symbol) + # come first and i_* (checking for includes) comes at the end. Grouping the + # d_* symbols together has good chances of improving the locality of the + # other questions and i_* symbols must come last since some depend on h_* + # values which prevent incompatible headers inclusions. + $wanted = join(' ', sort symbols split(' ', $wanted)); + + # Now generate the first makefile, which will be used to determine which + # symbols we really need, so that conditional dependencies may be solved. + open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n"; + print MAKEFILE "SHELL = /bin/sh\n"; + print MAKEFILE "W = $wanted\n"; + $saved_dependencies = $dependencies; + $* = 1; + foreach $sym (@Cond) { + if ($symwanted{$sym}) { + $dependencies =~ s/\+($sym\s)/$1/g; + } else { + $dependencies =~ s/\+$sym(\s)/$1/g; + } + } + $* = 0; + print MAKEFILE $dependencies; + close MAKEFILE; +} + +# Ordering for symbols. Give higher priority to d_* ones and lower to i_* ones. +# If any layout priority is defined in %Layout, it is used to order the +# symbols. +sub symbols { + local($r) = $Layout{$a} <=> $Layout{$b}; + return $r if $r; + # If we come here, both symbols have the same layout priority. + if ($a =~ /^d_/) { + return -1 unless $b =~ /^d_/; + } elsif ($b =~ /^d_/) { + return 1; + } elsif ($a =~ /^i_/) { + return 1 unless $b =~ /^i_/; + } elsif ($b =~ /^i_/) { + return -1; + } + $a cmp $b; +} + +# Run the makefile produced in the first pass to find the whole set of units we +# have to load, filling in the %symwanted and %condwanted structures. +sub compute_loadable { + print " Determining loadable units...\n" unless $opt_s; + open(MAKE, "make -n |") || die "Can't run make"; + while () { + s|^\s+||; # Some make print tabs before command + if (/^pick/) { + print "\t$_" if $opt_v; + ($pick,$cmd,$symbol,$unit) = split(' '); + $symwanted{$symbol}++; + $symwanted{$unit}++; + } elsif (/^cond/) { + print "\t$_" if $opt_v; + ($pick,@symbol) = split(' '); + for (@symbol) { + $condwanted{$_}++; # Default value is requested + } + } + } + close MAKE; +} + +# Now that we know all the desirable symbols, we have to rebuild +# another makefile, in order to have the units in a more optimal +# way. +# Actually, if we have both ?MAKE:a:+b and ?MAKE:d:b and 'd' is +# wanted; then 'b' will be loaded. However, 'b' is a conditional +# dependency for 'a', and it would be better if 'b' were loaded +# before 'a' is, though this is not necessary. +# It is hard to know that 'b' will be loaded *before* the first make. + +# Back to the original dependencies, make loadable units truly wanted ones and +# remove optional ones. +sub update_makefile { + print " Updating make file...\n" unless $opt_s; + open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n"; + print MAKEFILE "SHELL = /bin/sh\n"; + print MAKEFILE "W = $wanted\n"; + $* = 1; + foreach $sym (@Cond) { + if ($symwanted{$sym}) { + $saved_dependencies =~ s/\+($sym\s)/$1/g; + } else { + $saved_dependencies =~ s/\+$sym(\s)/$1/g; + } + } + $* = 0; + print MAKEFILE $saved_dependencies; + close MAKEFILE; +} + diff --git a/mcon/pl/obsolete.pl b/mcon/pl/obsolete.pl new file mode 100644 index 0000000..ba9a601 --- /dev/null +++ b/mcon/pl/obsolete.pl @@ -0,0 +1,103 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: obsolete.pl,v $ +;# Revision 3.0.1.1 1995/01/30 14:49:22 ram +;# patch49: random clean-up in &record_obsolete +;# +;# Revision 3.0 1993/08/18 12:10:27 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# Deal with obsolete symbols. They are recorded in the %Obsolete array. +;# Optionally, the obsolete symbols may be remaped onto the new ones (option +;# -o), which enables smooth evolution from 2.0. +;# +# Record obsolete symbols association (new versus old), that is to say for a +# given old symbol, $Obsolete{'old'} = new symbol to be used. A '$' is prepended +# for all shell variables +sub record_obsolete { + local($_) = @_; + local(@obsoleted); # List of obsolete symbols + local($symbol); # New symbol which must be used + local($dollar) = s/^\$// ? '$':''; # The '$' or a null string + # Syntax for obsolete symbols specification is + # list of symbols (obsolete ones): + if (/^(\w+)\s*\((.*)\)\s*:$/) { + $symbol = "$dollar$1"; + @obsoleted = split(' ', $2); # List of obsolete symbols + } else { + if (/^(\w+)\s*\((.*):$/) { + warn "\"$file\", line $.: final ')' before ':' missing.\n"; + $symbol = "$dollar$1"; + @obsoleted = split(' ', $2); + } else { + warn "\"$file\", line $.: syntax error.\n"; + return; + } + } + foreach $val (@obsoleted) { + $_ = $dollar . $val; + if (defined $Obsolete{$_}) { + warn "\"$file\", line $.: '$_' already obsoleted by '$Obsolete{$_}'.\n"; + } else { + $Obsolete{$_} = $symbol; # Record (old, new) tuple + } + } +} + +# Dump obsolete symbols used in file 'Obsolete'. Also write Obsol_h.U and +# Obsol_sh.U to record old versus new mappings if the -o option was used. +sub dump_obsolete { + unless (-f 'Obsolete') { + open(OBSOLETE, ">Obsolete") || die "Can't create Obsolete.\n"; + } + open(OBSOL_H, ">.MT/Obsol_h.U") || die "Can't create .MT/Obsol_h.U.\n"; + open(OBSOL_SH, ">.MT/Obsol_sh.U") || die "Can't create .MT/Obsol_sh.U.\n"; + local($file); # File where obsolete symbol was found + local($old); # Name of this old symbol + local($new); # Value of the new symbol to be used + # Leave a blank line at the top so that anny added ^L will stand on a line + # by itself (the formatting process adds a ^L when a new page is needed). + format OBSOLETE_TOP = + + File | Old symbol | New symbol +-----------------------------------+----------------------+--------------------- +. + format OBSOLETE = +@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<< | @<<<<<<<<<<<<<<<<<<< +$file, $old, $new +. + local(%seen); + foreach $key (sort keys %ofound) { + ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/); + write(OBSOLETE) unless $file eq 'XXX'; + next unless $opt_o; # Obsolete mapping done only with -o + next if $seen{$old}++; # Already remapped, thank you + if ($new =~ s/^\$//) { # We found an obsolete shell symbol + $old =~ s/^\$//; + print OBSOL_SH "$old=\"\$$new\"\n"; + } else { # We found an obsolete C symbol + print OBSOL_H "#ifdef $new\n"; + print OBSOL_H "#define $old $new\n"; + print OBSOL_H "#endif\n\n"; + } + } + close OBSOLETE; + close OBSOL_H; + close OBSOL_SH; + if (-s 'Obsolete') { + print "*** Obsolete symbols found -- see file 'Obsolete' for a list.\n"; + } else { + unlink 'Obsolete'; + } + undef %ofound; # Not needed any more +} + diff --git a/mcon/pl/order.pl b/mcon/pl/order.pl new file mode 100644 index 0000000..e6ef35a --- /dev/null +++ b/mcon/pl/order.pl @@ -0,0 +1,42 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: order.pl,v $ +;# Revision 3.0 1993/08/18 12:10:28 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# The @cmdwanted array records the output of the makefile (pick commands only). +;# The shell commands are executed right away. +;# @cmdwanted records the output of the make process (solving dependencies) +# Solve dependencies by saving the 'pick' command in @cmdwanted +sub solve_dependencies { + local(%unitseen); # Record already picked units (avoid duplicates) + print "Determining the correct order for the units...\n" unless $opt_s; + chdir('.MT') || die "Can't chdir to .MT: $!.\n"; + open(MAKE, "make -n |") || die "Can't run make"; + while () { + s|^\s+||; # Some make print tabs before command + print "\t$_" if $opt_v; + if (/^pick/) { + ($pick,$cmd,$symbol,$unit) = split(' '); + push(@cmdwanted,"$cmd $symbol $unit") + unless $unitseen{"$cmd:$unit"}++; + } elsif (/^cond/) { + # Ignore conditional symbol request + } else { + chop; + system; + } + } + chdir($WD) || die "Can't chdir to $WD: $!.\n"; + close MAKE; +} + diff --git a/mcon/pl/tsort.pl b/mcon/pl/tsort.pl new file mode 100644 index 0000000..4d56fae --- /dev/null +++ b/mcon/pl/tsort.pl @@ -0,0 +1,166 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: tsort.pl,v $ +;# Revision 3.0 1993/08/18 12:10:28 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# The topological sort is performed using the following algorithm: +;# +;# We have a list of successors for each item; makefile dependencies of +;# the form 'a b: c d' means successors(a) = successors(b) = { c, d }. +;# From that input, we derive a number of precursors for each item. +;# In our simple example above, c and d both have two precursors and +;# a and b have none. Items with no precursors are called outsiders +;# and are left in a pool. The sort is then initiated and will continue +;# until all the items have been sorted or a cycle is found... +;# +;# Outsiders are ready to be sorted; since the topological sort is a partial +;# order, an external criterion is needed to choose one item among the ones +;# in the pool. That item is assigned a number, and the number of precursors +;# for the remaining items is updated (by following the successors of the +;# sorted item and decrementing the value for each successor). Among those, +;# if any item reaches a precursor count of zero, it becomes an outsider. +;# +;# The algorithm ends when the outsider pool is empty. If it becomes empty and +;# some items remain unsorted, then there is one or more cycles among them. +;# One way to outline that cycle first extract all those items whose precursor +;# count is minimal then visit their dependency graph to find the cycle, +;# extract only those items belonging to the cycle into the outsiders set and +;# resume the main processing stream. +;# +# +# Topological sort of Makefile dependencies with cycle enhancing. +# + +package tsort; + +# Perform the topological sort of the items and outline cycles. +sub main'tsort { + local(*Succ, *Prec) = @_; # Tables of succesors and predecessors + local(@Out); # The outsider set + local(@keys); # Current active precursors + local($item); # Item to sort + + for (@keys = keys %Prec; @keys || @Out; @keys = keys %Prec) { + &resync; # Resynchronize outsiders + if (@Out == 0) { # Cycle detected + &extract_cycle(*Prec, *Succ); + next; + } + $item = shift(@Out); # Sort current item (don't care which one) + &sort($item); # Update internal structures + } +} + +# Resynchronize the outsiders stack (those items that have no more precursors). +# If the outsiders stack becomes empty, then there is a cycle. +sub resync { + foreach $target (keys %Prec) { + if ($Prec{$target} == 0) { + delete $Prec{$target}; # We're done with this item + push(@Out, $target); # Ready to be sorted + } + } +} + +# Sort item +sub sort { + local($item) = @_; + print "(ok) $item\n" if $main'opt_d && !$Cycle; + print "(fx) $item\n" if $main'opt_d && $Cycle; + foreach $succ (split(' ', $Succ{$item})) { + # The test for definedness is necessary, since when a cycle is found, + # one item is forced out of %Prec. If we had the guarantee of no + # cycle, the the test would not be necessary and no decrementation + # could go past 0. + $Prec{$succ}-- if defined $Prec{$succ}; + } +} + +# Extract cycle... We look through the %Prec array and find all those items +# with the same lowest value. Those are a cycle, so we dump them, and make +# them new outsiders by resetting their count to 0. +sub extract_cycle { + local(*Prec, *Succ) = @_; + local($item) = (&sort_by_value(*Prec))[0]; + local($min) = $Prec{$item}; # Minimum value + local($key, $value); + local(%candidate); # Superset of the cycle we found + warn " Cycle found for:\n"; + $Cycle++; + while (($key, $value) = each %Prec) { + $candidate{$key}++ if $value == $min; + } + local(%state); # State of visited nodes (1 = cycle, -1 = dead) + local($CYCLE) = 1; # Possible member of a cycle + local($DEAD) = -1; # Dead end, no cycling possible + foreach $key (keys %candidate) { + last if $CYCLE == &visit($key, $Succ{$key}); + } + while (($key, $value) = each %candidate) { + next unless $state{$key} == $CYCLE; + $Prec{$key} = 0; # Members of cycle are new outsiders + warn "\t(#$Cycle) $key\n"; + } + local(%involved); # Items involved in the cycle... + while (($key, $value) = each %state) { + $involved{$key}++ if $state{$key} == $CYCLE; + } + &outline_cycle(*Succ, *involved); +} + +sub outline_cycle { + local(*Succ, *member) = @_; + local($key, $value); + local($depends); + local($unit); + warn " Cycle involves:\n"; + while (($key, $value) = each %Succ) { + next unless $member{$key}; + $depends = ''; + foreach $item (split(' ', $value)) { + $depends .= "$item " if $member{$item}; + } + $unit = $main'shmaster{"\$$key"}; + $unit =~ s/\s+$//; + $unit = '?' if $unit eq ''; + warn "\t($unit) $key: $depends\n"; + } +} + +# Visit a tree node, following all its successors, until we find a cycle. +# Return $CYCLE if the exploration of the node leaded to a cycle, $DEAD +# otherwise. +sub visit { + local($node, $children) = @_; # A node and its children + # If we have already visited the node, return the status value attached + # to it. + return $state{$node} if $state{$node}; + $state{$node} = $CYCLE; # Assume member of cycle + local($all_dead) = 1; # Set to 0 if at least one cycle found + foreach $child (split(' ', $children)) { + $all_dead = 0 if $CYCLE == &visit($child, $Succ{$child}); + } + $state{$node} = $DEAD if $all_dead; + $state{$node}; +} + +# Sort associative array by value +sub sort_by_value { + local(*x) = @_; + sub _by_value { $x{$a} <=> $x{$b}; } + sort _by_value keys %x; +} + +package main; + +1; diff --git a/mcon/pl/wanted.pl b/mcon/pl/wanted.pl new file mode 100644 index 0000000..20d218c --- /dev/null +++ b/mcon/pl/wanted.pl @@ -0,0 +1,263 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: wanted.pl,v $ +;# Revision 3.0.1.2 1995/01/11 15:42:37 ram +;# patch45: added % in front of hash table names for perl5's each() (ADO) +;# patch45: tell users about possible extra file-extension lookups +;# +;# Revision 3.0.1.1 1993/10/16 13:56:05 ram +;# patch12: modified to handle ?M: lines +;# patch12: added warning when magic symbols used without proper config +;# +;# Revision 3.0 1993/08/18 12:10:29 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# These two arrays record the file names of the files which may (or may not) +;# contain shell or C symbols known by metaconfig. +;# @SHlist records the .SH files +;# @clist records the C-like files (i.e. .[chyl]) +;# +;# These files are scanned in turn to see how many symbols known by metaconfig +;# they have. Those symbols are gathered in a Wanted file. As C symbols are +;# not true targets for the forthcoming Makefile, a ">" sign is prepended. +;# Finally, the obsolete symbols are preceded by a "!". +;# +;# When obsolete symbols are found, they are dumped in file 'Obsolete'. Two +;# files are created anyway in the .MT directory. Obsol_h.U and Obsol_sh.U which +;# respectively list the obsoleted symbols (C and shell ones). +;# Obsol_h.U records obsolete C symbols +;# Obsol_sh.U records obsolete shell symbols +;# +;# The manifake() routine has to be provided externally. +;# +# Build a wanted file from the files held in @SHlist and @clist arrays +sub build_wanted { + # If wanted file is already there, parse it to map obsolete if -o option + # was used. Otherwise, build a new one. + if (-f 'Wanted') { + &map_obsolete if $opt_o; # Build Obsol*.U files + &dump_obsolete; # Dump obsolete symbols if any + return; + } + &parse_files; +} + +sub parse_files { + print "Building a Wanted file...\n" unless $opt_s; + open(WANTED,"| sort | uniq >Wanted") || die "Can't create Wanted.\n"; + unless (-f $NEWMANI) { + &manifake; + die "No $NEWMANI--can't build a Wanted file.\n" unless -f $NEWMANI; + } + + local($search); # Where to-be-evaled script is held + local($_) = ' ' x 50000 if $opt_m; # Pre-extend pattern search space + local(%visited); # Records visited files + local(%lastfound); # Where last occurence of key was + + # Now we are a little clever, and build a loop to eval so that we don't + # have to recompile our patterns on every file. We also use "study" since + # we are searching the same string for many different things. Hauls! + + if (@clist) { + local($others) = $cext ? " $cext" : ''; + print " Scanning .[chyl]$others files for symbols...\n" + unless $opt_s; + $search = ' ' x (40 * (@cmaster + @ocmaster)); # Pre-extend + $search = "while (<>) {study;\n"; # Init loop over ARGV + foreach $key (keys(%cmaster)) { + $search .= "&cmaster('$key') if /\\b$key\\b/;\n"; + } + foreach $key (grep(!/^\$/, keys %Obsolete)) { + $search .= "&ofound('$key') if /\\b$key\\b/;\n"; + } + $search .= "}\n"; # terminate loop + print $search if $opt_d; + @ARGV = @clist; + # Swallow each file as a whole, if memory is available + undef $/ if $opt_m; + eval $search; + eval ''; + $/ = "\n"; + while (($key,$value) = each(%cmaster)) { + print WANTED $cwanted{$key}, "\n", ">$key", "\n" if $value; + } + } + + # If they don't use magic but use magically guarded symbols without + # their corresponding C symbol dependency, warn them, since they might + # not know about that portability issue. + + if (@clist && !$opt_M) { + local($nused); # list of non-used symbols + local($warning) = 0; # true when one warning issued + foreach $cmag (keys %mwanted) { # loop over all used magic symbols + next unless $cmaster{$cmag}; + $nused = ''; + foreach $cdep (split(' ', $mwanted{$cmag})) { + $nused .= " $cdep" unless $cmaster{$cdep}; + } + $nused =~ s/^ //; + $nused = "one of " . $nused if $nused =~ s/ /, /g; + if ($nused ne '') { + print " Warning: $cmag is used without $nused.\n"; + $warning++; + } + } + if ($warning) { + local($those) = $warning == 1 ? 'that' : 'those'; + local($s) = $warning == 1 ? '' : 's'; + print "Note: $those previous warning$s may be suppressed by -M.\n"; + } + } + + # Cannot remove $cmaster as it is used later on when building Configure + undef @clist; + undef %cwanted; + undef %mwanted; + %visited = (); + %lastfound = (); + + if (@SHlist) { + local($others) = $shext ? " $shext" : ''; + print " Scanning .SH$others files for symbols...\n" unless $opt_s; + $search = ' ' x (40 * (@shmaster + @oshmaster)); # Pre-extend + $search = "while (<>) {study;\n"; + # All the keys already have a leading '$' + foreach $key (keys(%shmaster)) { + $search .= "&shmaster('$key') if /\\$key\\b/;\n"; + } + foreach $key (grep (/^\$/, keys %Obsolete)) { + $search .= "&ofound('$key') if /\\$key\\b/;\n"; + } + $search .= "}\n"; + print $search if $opt_d; + @ARGV = @SHlist; + # Swallow each file as a whole, if memory is available + undef $/ if $opt_m; + eval $search; + eval ''; + $/ = "\n"; + while (($key,$value) = each(%shmaster)) { + if ($value) { + $key =~ s/^\$//; + print WANTED $key, "\n"; + } + } + } + + # Obsolete symbols, if any, are written in the Wanted file preceded by a + # '!' character. In case -w is used, we'll thus be able to correctly build + # the Obsol_h.U and Obsol_sh.U files. + + &add_obsolete; # Add obsolete symbols in Wanted file + + close WANTED; + + # If obsolete symbols where found, write an Obsolete file which lists where + # each of them appear and the new symbol to be used. Also write Obsol_h.U + # and Obsol_sh.U in .MT for later perusal. + + &dump_obsolete; # Dump obsolete symbols if any + + die "No desirable symbols found--aborting.\n" unless -s 'Wanted'; + + # Clean-up memory by freeing useless data structures + undef @SHlist; + undef %shmaster; +} + +# This routine records matches of C master keys +sub cmaster { + local($key) = @_; + $cmaster{$key}++; # This symbol is wanted + return unless $opt_t || $opt_M; # Return if neither -t nor -M + if ($opt_t && + $lastfound{$key} ne $ARGV # Never mentionned for this file ? + ) { + $visited{$ARGV}++ || print $ARGV,":\n"; + print "\t$key\n"; + $lastfound{$key} = $ARGV; + } + if ($opt_M && + defined($mwanted{$key}) # Found a ?M: symbol + ) { + foreach $csym (split(' ', $mwanted{$key})) { + $cmaster{$csym}++; # Activate C symbol dependencies + } + } +} + +# This routine records matches of obsolete keys (C or shell) +sub ofound { + local($key) = @_; + local($_) = $Obsolete{$key}; # Value of new symbol + $ofound{"$ARGV $key $_"}++; # Record obsolete match + $cmaster{$_}++ unless /^\$/; # A C hit + $shmaster{$_}++ if /^\$/; # Or a shell one + return unless $opt_t; # Continue if trace option on + if ($lastfound{$key} ne $ARGV) { # Never mentionned for this file ? + $visited{$ARGV}++ || print $ARGV,":\n"; + print "\t$key (obsolete, use $_)\n"; + $lastfound{$key} = $ARGV; + } +} + +# This routine records matches of shell master keys +sub shmaster { + local($key) = @_; + $shmaster{$key}++; # This symbol is wanted + return unless $opt_t; # Continue if trace option on + if ($lastfound{$key} ne $ARGV) { # Never mentionned for this file ? + $visited{$ARGV}++ || print $ARGV,":\n"; + print "\t$key\n"; + $lastfound{$key} = $ARGV; + } +} + +# Write obsolete symbols into the Wanted file for later perusal by -w. +sub add_obsolete { + local($file); # File where obsolete symbol was found + local($old); # Name of this old symbol + local($new); # Value of the new symbol to be used + foreach $key (sort keys %ofound) { + ($file, $old, $new) = ($key =~ /^(\S+)\s+(\S+)\s+(\S+)/); + if ($new =~ s/^\$//) { # We found an obsolete shell symbol + print WANTED "!$old\n"; + } else { # We found an obsolete C symbol + print WANTED "!>$old\n"; + } + } +} + +# Map obsolete symbols from Wanted file into %Obsolete and call dump_obsolete +# to actually build the Obsol_sh.U and Obsol_h.U files. Those will be needed +# during the Configure building phase to actually do the remaping. +# The obsolete symbols found are entered in the %ofound array, tagged as from +# file 'XXX', which is specially recognized by dump_obsolete. +sub map_obsolete { + open(WANTED, 'Wanted') || die "Can't open Wanted file.\n"; + local($new); # New symbol to be used instead of obsolete one + while () { + chop; + next unless s/^!//; # Skip non-obsolete symbols + if (s/^>//) { # C symbol + $new = $Obsolete{$_}; # Fetch new symbol + $ofound{"XXX $_ $new"}++; # Record obsolete match (XXX = no file) + } else { # Shell symbol + $new = $Obsolete{"\$$_"}; # Fetch new symbol + $ofound{"XXX \$$_ $new"}++; # Record obsolete match (XXX = no file) + } + } + close WANTED; +} + diff --git a/mcon/pl/xref.pl b/mcon/pl/xref.pl new file mode 100644 index 0000000..02f4164 --- /dev/null +++ b/mcon/pl/xref.pl @@ -0,0 +1,67 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: xref.pl,v $ +;# Revision 3.0.1.2 1995/09/25 09:20:05 ram +;# patch59: added empty p_layout stub for new ?Y: directives +;# +;# Revision 3.0.1.1 1993/10/16 13:56:23 ram +;# patch12: declared p_public for ?P: lines +;# +;# Revision 3.0 1993/08/18 12:10:31 ram +;# Baseline for dist 3.0 netwide release. +;# +;# Metaxref-dependent part of the dependency extranction. +;# +# Process the ?W: lines +sub p_wanted { + # Syntax is ?W:: + local($active) = $_[0] =~ /^([^:]*):/; # Symbols to activate + local($look_symbols) = $_[0] =~ /:(.*)/; # When those are used + local(@syms) = split(/ /, $look_symbols); # Keep original spacing info + $active =~ s/\s+/\n/g; # One symbol per line + + # Concatenate quoted strings, so saying something like 'two words' will + # be introduced as one single symbol "two words". + local(@symbols); # Concatenated symbols to look for + local($concat) = ''; # Concatenation buffer + foreach (@syms) { + if (s/^\'//) { + $concat = $_; + } elsif (s/\'$//) { + push(@symbols, $concat . ' ' . $_); + $concat = ''; + } else { + push(@symbols, $_) unless $concat; + $concat .= ' ' . $_ if $concat; + } + } + + local($fake); # Fake unique shell symbol to reparent C symbol + + # Now record symbols in master and wanted tables + foreach (@symbols) { + $cmaster{$_} = undef; # Asks for look-up in C files + # Make a fake C symbol and associate that with the wanted symbol + # so that later we know were it comes from + $fake = &gensym; + $cwanted{$_} = "$fake"; # Attached to this symbol + push(@Master, "?$unit:$fake=''"); # Fake initialization + } +} + +# Ingnore the following: +sub p_init {} +sub p_default {} +sub p_library {} +sub p_include {} +sub p_public {} +sub p_layout {} + diff --git a/mcon/pl/xwant.pl b/mcon/pl/xwant.pl new file mode 100644 index 0000000..31508eb --- /dev/null +++ b/mcon/pl/xwant.pl @@ -0,0 +1,149 @@ +;# $Id$ +;# +;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi +;# +;# You may redistribute only under the terms of the Artistic Licence, +;# as specified in the README file that comes with the distribution. +;# You may reuse parts of this distribution only within the terms of +;# that same Artistic Licence; a copy of which may be found at the root +;# of the source tree for dist 4.0. +;# +;# $Log: xwant.pl,v $ +;# Revision 3.0 1993/08/18 12:10:32 ram +;# Baseline for dist 3.0 netwide release. +;# +;# +;# These two arrays record the file names of the files which may (or may not) +;# contain shell or C symbols known by metaconfig. +;# @SHlist records the .SH files +;# @clist records the C-like files (i.e. .[chyl]) +;# +# Parse files and build cross references +sub build_xref { + print "Building cross-reference files...\n" unless $opt_s; + unless (-f $NEWMANI) { + &manifake; + die "No $NEWMANI--don't know who to scan.\n" unless -f $NEWMANI; + } + + open(FUI, "|sort | uniq >I.fui") || die "Can't create I.fui.\n"; + open(UIF, "|sort | uniq >I.uif") || die "Can't create I.uif.\n"; + + local($search); # Where to-be-evaled script is held + local($_) = ' ' x 50000 if $opt_m; # Pre-extend pattern search space + local(%visited); # Records visited files + local(%lastfound); # Where last occurence of key was + + # Map shell symbol names to units by reverse engineering the @Master array + # which records all the known shell symbols and the units where they + # are defined. + foreach $init (@Master) { + $init =~ /^\?(.*):(.*)=''/ && ($shwanted{"\$$2"} = $1); + } + + # Now we are a little clever, and build a loop to eval so that we don't + # have to recompile our patterns on every file. We also use "study" since + # we are searching the same string for many different things. Hauls! + + if (@clist) { + print " Scanning .[chyl] files for symbols...\n" unless $opt_s; + $search = ' ' x (40 * (@cmaster + @ocmaster)); # Pre-extend + $search = "while (<>) {study;\n"; # Init loop over ARGV + foreach $key (keys(cmaster)) { + $search .= "\$cmaster{'$key'} .= \"\$ARGV#\" if /\\b$key\\b/;\n"; + } + foreach $key (grep(!/^\$/, keys %Obsolete)) { + $search .= "&ofound('$key') if /\\b$key\\b/;\n"; + } + $search .= "}\n"; # terminate loop + print $search if $opt_d; + @ARGV = @clist; + # Swallow each file as a whole, if memory is available + undef $/ if $opt_m; + eval $search; + eval ''; + $/ = "\n"; + while (($key,$value) = each(cmaster)) { + next if $value eq ''; + foreach $file (sort(split(/#/, $value))) { + next if $file eq ''; + # %cwanted may contain value separated by \n -- take last one + @sym = split(/\n/, $cwanted{$key}); + $sym = pop(@sym); + $shell = "\$$sym"; + print FUI + pack("A35", $file), + pack("A20", "$shwanted{$shell}.U"), + $key, "\n"; + print UIF + pack("A20", "$shwanted{$shell}.U"), + pack("A25", $key), + $file, "\n"; + } + } + } + + undef @clist; + undef %cwanted; + undef %cmaster; # We're not building Configure, we may delete this + %visited = (); + %lastfound = (); + + if (@SHlist) { + print " Scanning .SH files for symbols...\n" unless $opt_s; + $search = ' ' x (40 * (@shmaster + @oshmaster)); # Pre-extend + $search = "while (<>) {study;\n"; + # All the keys already have a leading '$' + foreach $key (keys(shmaster)) { + $search .= "\$shmaster{'$key'} .= \"\$ARGV#\" if /\\$key\\b/;\n"; + } + foreach $key (grep (/^\$/, keys %Obsolete)) { + $search .= "&ofound('$key') if /\\$key\\b/;\n"; + } + $search .= "}\n"; + print $search if $opt_d; + @ARGV = @SHlist; + # Swallow each file as a whole, if memory is available + undef $/ if $opt_m; + eval $search; + eval ''; + $/ = "\n"; + while (($key,$value) = each(shmaster)) { + next if $value eq ''; + foreach $file (sort(split(/#/, $value))) { + next if $file eq ''; + print FUI + pack("A35", $file), + pack("A20", "$shwanted{$key}.U"), + $key, "\n"; + print UIF + pack("A20", "$shwanted{$key}.U"), + pack("A25", $key), + $file, "\n"; + } + } + } + + close FUI; + close UIF; + + # If obsolete symbols where found, write an Obsolete file which lists where + # each of them appear and the new symbol to be used. Also write Obsol_h.U + # and Obsol_sh.U in .MT for later perusal. + + &dump_obsolete; # Dump obsolete symbols if any + + # Clean-up memory by freeing useless data structures + undef @SHlist; + undef %shmaster; +} + +# This routine records matches of obsolete keys (C or shell) +sub ofound { + local($key) = @_; + local($_) = $Obsolete{$key}; # Value of new symbol + $ofound{"$ARGV $key $_"}++; # Record obsolete match + $cmaster{$_} .= "$ARGV#" unless /^\$/; # A C hit + $shmaster{$_} .= "$ARGV#" if /^\$/; # Or a shell one +} + -- cgit v1.2.3 From 80f66fdd1d400ef2d592680beec4871e4e023b95 Mon Sep 17 00:00:00 2001 From: rmanfredi Date: Fri, 4 Jan 2008 23:14:00 +0000 Subject: Applied diff from H.Merijn Brand to keep it working with perl 5.10, which no longer supports the old $* perl4 variable to request multiline matching. git-svn-id: svn://svn.code.sf.net/p/dist/code/trunk/dist@20 2592e710-e01b-42a5-8df0-11608a6cc53d --- mcon/pl/cosmetic.pl | 18 +++++++----------- mcon/pl/makefile.pl | 12 ++++-------- 2 files changed, 11 insertions(+), 19 deletions(-) (limited to 'mcon/pl') diff --git a/mcon/pl/cosmetic.pl b/mcon/pl/cosmetic.pl index bfb9575..d8b535b 100644 --- a/mcon/pl/cosmetic.pl +++ b/mcon/pl/cosmetic.pl @@ -47,26 +47,22 @@ sub cosmetic_update { $/ = "\n"; close NEWMANI; - $* = 1; # Multi-line matching - - &mani_add('Configure', 'Portability tool', $spaces) unless /^Configure\b/; + &mani_add('Configure', 'Portability tool', $spaces) unless /^Configure\b/m; &mani_add('config_h.SH', 'Produces config.h', $spaces) - unless /^config_h\.SH\b/ || !-f 'config_h.SH'; + unless /^config_h\.SH\b/m || !-f 'config_h.SH'; &mani_add('confmagic.h', 'Magic symbol remapping', $spaces) - if $opt_M && !/^confmagic\.h\b/; + if $opt_M && !/^confmagic\.h\b/m; - &mani_remove('config_h.SH') if /^config_h\.SH\b/ && !-f 'config_h.SH'; - &mani_remove('confmagic.h') if /^confmagic.h\b/ && !$opt_M; + &mani_remove('config_h.SH') if /^config_h\.SH\b/m && !-f 'config_h.SH'; + &mani_remove('confmagic.h') if /^confmagic.h\b/m && !$opt_M; if ($opt_G) { # Want a GNU-like configure wrapper &add_configure; &mani_add('configure', 'GNU configure-like wrapper', $spaces) - if !/^configure\s/ && -f 'configure'; + if !/^configure\s/m && -f 'configure'; } else { - &mani_remove('configure') if /^configure\s/ && !-f 'configure'; + &mani_remove('configure') if /^configure\s/m && !-f 'configure'; } - - $* = 0; } # Add file to MANIFEST.new, with properly indented comment diff --git a/mcon/pl/makefile.pl b/mcon/pl/makefile.pl index 290c995..434fbeb 100644 --- a/mcon/pl/makefile.pl +++ b/mcon/pl/makefile.pl @@ -90,15 +90,13 @@ sub build_private { print MAKEFILE "SHELL = /bin/sh\n"; print MAKEFILE "W = $wanted\n"; $saved_dependencies = $dependencies; - $* = 1; foreach $sym (@Cond) { if ($symwanted{$sym}) { - $dependencies =~ s/\+($sym\s)/$1/g; + $dependencies =~ s/\+($sym\s)/$1/gm; } else { - $dependencies =~ s/\+$sym(\s)/$1/g; + $dependencies =~ s/\+$sym(\s)/$1/gm; } } - $* = 0; print MAKEFILE $dependencies; close MAKEFILE; } @@ -161,15 +159,13 @@ sub update_makefile { open(MAKEFILE,">Makefile") || die "Can't create .MT/Makefile.\n"; print MAKEFILE "SHELL = /bin/sh\n"; print MAKEFILE "W = $wanted\n"; - $* = 1; foreach $sym (@Cond) { if ($symwanted{$sym}) { - $saved_dependencies =~ s/\+($sym\s)/$1/g; + $saved_dependencies =~ s/\+($sym\s)/$1/gm; } else { - $saved_dependencies =~ s/\+$sym(\s)/$1/g; + $saved_dependencies =~ s/\+$sym(\s)/$1/gm; } } - $* = 0; print MAKEFILE $saved_dependencies; close MAKEFILE; } -- cgit v1.2.3 From 316f5201b71af3ca6c244879a74089ac366cce20 Mon Sep 17 00:00:00 2001 From: rmanfredi Date: Wed, 28 May 2008 08:05:12 +0000 Subject: Removed last instance of $*, no longer supported in Perl 5.10. git-svn-id: svn://svn.code.sf.net/p/dist/code/trunk/dist@23 2592e710-e01b-42a5-8df0-11608a6cc53d --- mcon/pl/files.pl | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'mcon/pl') diff --git a/mcon/pl/files.pl b/mcon/pl/files.pl index 9e6bd08..3962fa6 100644 --- a/mcon/pl/files.pl +++ b/mcon/pl/files.pl @@ -102,8 +102,7 @@ EOF # Remove ':' quotations in front of the lines sub q { local($_) = @_; - local($*) = 1; - s/^://g; + s/^://gm; $_; } -- cgit v1.2.3 From a04a204b963bf8dbf7bd385c07c59df40f57fedf Mon Sep 17 00:00:00 2001 From: rmanfredi Date: Wed, 28 May 2008 11:19:25 +0000 Subject: SVN revision number is now automatically generated in "revision.h". The old patchlevel information is no longer used, and is deprecated in unit files, replaced by . git-svn-id: svn://svn.code.sf.net/p/dist/code/trunk/dist@25 2592e710-e01b-42a5-8df0-11608a6cc53d --- mcon/pl/configure.pl | 4 +++- mcon/pl/lint.pl | 1 + 2 files changed, 4 insertions(+), 1 deletion(-) (limited to 'mcon/pl') diff --git a/mcon/pl/configure.pl b/mcon/pl/configure.pl index f78925f..a5aed29 100644 --- a/mcon/pl/configure.pl +++ b/mcon/pl/configure.pl @@ -110,7 +110,9 @@ sub process_command { s//$package/g; s//$maintloc/g; s//$version/g; # This is metaconfig's version - s//$patchlevel/g; # And patchlevel information + s//$revision/g; # And revision information + warn "\"$file\": usage of is deprecated\n" + if s//$patchlevel/g; s//$date/g; s//$baserev/g; s/<\$(\w+)>/eval("\$$1")/ge; # <$var> -> $var substitution diff --git a/mcon/pl/lint.pl b/mcon/pl/lint.pl index ba5c407..c790011 100644 --- a/mcon/pl/lint.pl +++ b/mcon/pl/lint.pl @@ -115,6 +115,7 @@ sub init_extraction { MAINTLOC VERSION PATCHLEVEL + REVISION DATE BASEREV ); -- cgit v1.2.3 From 194d1db97053d853d5f81c362c461d71c05ea80e Mon Sep 17 00:00:00 2001 From: rmanfredi Date: Mon, 22 Nov 2010 17:34:39 +0000 Subject: Taught metalint about "${var:" type syntax. git-svn-id: svn://svn.code.sf.net/p/dist/code/trunk/dist@33 2592e710-e01b-42a5-8df0-11608a6cc53d --- mcon/pl/lint.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'mcon/pl') diff --git a/mcon/pl/lint.pl b/mcon/pl/lint.pl index c790011..1e435bf 100644 --- a/mcon/pl/lint.pl +++ b/mcon/pl/lint.pl @@ -778,10 +778,10 @@ sub p_body { } } } - # Now look at the shell variables used: can be $var or ${var} + # Now look at the shell variables used: can be $var or ${var} or ${var: local($var); local($line) = $_; - while ($check_vars && s/\$\{?(\w+)\}?/$1/) { + while ($check_vars && s/\$\{?(\w+)[\}:]?/$1/) { $var = $1; next if $var =~ /^\d+/; # Ignore $1 and friends # Record variable as undeclared but do not issue a message right now. -- cgit v1.2.3 From 7d48ec10a3a13b12e5bafba199b27307e9d38c7c Mon Sep 17 00:00:00 2001 From: rmanfredi Date: Sat, 28 Jan 2012 13:14:02 +0000 Subject: Make sure $file starts with a letter to avoid regexp warning in /\b$file/. git-svn-id: svn://svn.code.sf.net/p/dist/code/trunk/dist@115 2592e710-e01b-42a5-8df0-11608a6cc53d --- mcon/pl/lint.pl | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'mcon/pl') diff --git a/mcon/pl/lint.pl b/mcon/pl/lint.pl index 1e435bf..1e4cad3 100644 --- a/mcon/pl/lint.pl +++ b/mcon/pl/lint.pl @@ -812,8 +812,10 @@ sub p_body { # Record file as used. Later on, we will make sure we had the right # to use that file: either we are in the unit that defines it, or we # include the unit that creates it in our dependencies, relying on ?F:. - $fileused{$unit} .= "$file " unless - $filetmp{$file} || $fileused{$unit} =~ /\b$file\b/; + if ($file =~ /^\w/) { + $fileused{$unit} .= "$file " unless + $filetmp{$file} || $fileused{$unit} =~ /\b$file\b/; + } # Mark temporary file as being used, to spot useless local declarations $filetmp{$file} .= ' used' if defined $filetmp{$file} && $filetmp{$file} !~ /\bused/; @@ -827,8 +829,10 @@ sub p_body { s!(if|\|\||&&)\s+([^\$/`\s;]+)\s*!: ! # if prog, || prog, && prog ) { $file = $2; - $filemisused{$unit} .= "$file " unless - $filetmp{$file} || $filemisused{$unit} =~ /\b$file\b/; + if ($file =~ /^\w/) { + $filemisused{$unit} .= "$file " unless + $filetmp{$file} || $filemisused{$unit} =~ /\b$file\b/; + } # Temporary files should be used with ./ anyway $filetmp{$file} .= ' misused' if defined $filetmp{$file} && $filetmp{$file} !~ /\bmisused/; -- cgit v1.2.3 From 8160f5523cbbb37197732ea645d02f884e180f3c Mon Sep 17 00:00:00 2001 From: rmanfredi Date: Thu, 9 Feb 2012 19:15:13 +0000 Subject: Make Assert.U explicitly claim it creates a local "static_assert.h" file. Taught metalint to look for #include files in here-documents to catch missing dependencies on Assert, or other special units that would create such locally-defined includes. git-svn-id: svn://svn.code.sf.net/p/dist/code/trunk/dist@132 2592e710-e01b-42a5-8df0-11608a6cc53d --- mcon/pl/lint.pl | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) (limited to 'mcon/pl') diff --git a/mcon/pl/lint.pl b/mcon/pl/lint.pl index 1e4cad3..64bb466 100644 --- a/mcon/pl/lint.pl +++ b/mcon/pl/lint.pl @@ -793,14 +793,26 @@ sub p_body { $shused{$unit} .= "\$$var " unless $shused{$unit} =~ /\$$var\b/; } - return if $heredoc ne '' && !$began_here; # Still in here-document + local($file); + + if ($heredoc ne '' && !$began_here) { + # Still in here-document + # Just look for included files from C programs expected to be local + # in case they missed the special unit that produces these files. + if (s!#(\s*)include(\s+)"([\w.]+)"!!) { + $file = $3; + $fileused{$unit} .= "$file " unless + $filetmp{$file} || $fileused{$unit} =~ /\b$file\b/; + } + return; + } # Now look at private files used by the unit (./file or ..../UU/file) # We look at things like '. ./myread' and `./loc ...` as well as "< file" - local($file); $_ = $line; s/<\S+?>//g; # would set-off our Date: Sat, 23 Apr 2016 11:43:25 +0100 Subject: Don't rely on directory order when locating units Without this change, it's more likely for different machines to produce a Configure script with spurious unit reorderings (especially if they're running different OSes). --- mcon/pl/locate.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'mcon/pl') diff --git a/mcon/pl/locate.pl b/mcon/pl/locate.pl index ea7d03f..46c1078 100644 --- a/mcon/pl/locate.pl +++ b/mcon/pl/locate.pl @@ -122,7 +122,7 @@ sub units_path { print "Locating in $MC/$dir...\n" if $main'opt_v; @contents = readdir DIR; # Slurp the whole thing closedir DIR; # And close dir, ready for recursion - foreach (@contents) { + foreach (sort @contents) { next if $_ eq '.' || $_ eq '..'; if (/\.U$/) { # A unit, definitely ($unit_name) = /^(.*)\.U$/; -- cgit v1.2.3 From 6eb0900c6559e23d6409f4434dffdba33b9ecdd8 Mon Sep 17 00:00:00 2001 From: Aaron Crane Date: Sat, 23 Apr 2016 11:48:05 +0100 Subject: Fix incorrect invocation of Perl system builtin It doesn't default to $_, but this code apparently assumes it does. This doesn't seem to actually affect anything, because all the units I've encountered have only the "pick" pseudo-command in the actions of their "?MAKE:" sections. But I think it's worth fixing nonetheless. --- mcon/pl/order.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'mcon/pl') diff --git a/mcon/pl/order.pl b/mcon/pl/order.pl index e6ef35a..1616beb 100644 --- a/mcon/pl/order.pl +++ b/mcon/pl/order.pl @@ -33,7 +33,7 @@ sub solve_dependencies { # Ignore conditional symbol request } else { chop; - system; + system $_; } } chdir($WD) || die "Can't chdir to $WD: $!.\n"; -- cgit v1.2.3 From e17476b806aad1f8da32470141419a79a9fe1a78 Mon Sep 17 00:00:00 2001 From: Raphael Manfredi Date: Sat, 13 May 2017 13:50:42 +0200 Subject: process_command: be more explicit about errors when opening units. --- mcon/pl/configure.pl | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'mcon/pl') diff --git a/mcon/pl/configure.pl b/mcon/pl/configure.pl index a5aed29..d99d74b 100644 --- a/mcon/pl/configure.pl +++ b/mcon/pl/configure.pl @@ -77,7 +77,8 @@ sub process_command { warn "\t $msg\n"; } } - die "Can't open $file.\n" unless open(UNIT, $file); + die "Can't open $file.($name for target $target): $!\n" + unless open(UNIT, $file); print "\t$cmd $file\n" if $opt_v; &init_interp; # Initializes the interpreter @@ -215,9 +216,9 @@ sub process_command { elsif ($cmd eq 'prepend') { if (-s $file) { open(PREPEND, ">.prepend") || - die "Can't create .MT/.prepend.\n"; + die "Can't create .MT/.prepend: $!\n"; open(TARGET, $Unit{$target}) || - die "Can't open $Unit{$target}.\n"; + die "Can't open unit $Unit{$target}: $!\n"; while () { print PREPEND unless &skipped; } @@ -225,7 +226,7 @@ sub process_command { close PREPEND; close TARGET; rename('.prepend', $file) || - die "Can't rename .prepend into $file.\n"; + die "Can't rename .prepend into $file: $!\n"; } } -- cgit v1.2.3 From 400b5416d705dfa1c25eaefa9f2dcccf142a77c6 Mon Sep 17 00:00:00 2001 From: Raphael Manfredi Date: Sat, 13 May 2017 14:59:32 +0200 Subject: Enhanced metalint to better validate ?MAKE: lines. In particular, validate the special "pick" command further to avoid nasty surprises when running metaconfig. --- mcon/pl/lint.pl | 44 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) (limited to 'mcon/pl') diff --git a/mcon/pl/lint.pl b/mcon/pl/lint.pl index 64bb466..3762e3d 100644 --- a/mcon/pl/lint.pl +++ b/mcon/pl/lint.pl @@ -125,6 +125,48 @@ sub init_extraction { sub end_extraction { } +# Process the command line of ?MAKE: lines +sub p_make_command { + local ($_) = @_; + my $where = "\"$file\", line $. (?MAKE:)"; + unless (s/^\t+//) { + warn "$where: command line must start with a leading TAB character.\n"; + s/^\s+//; # Remove spaces and continue + } + return unless s/^-?pick\b//; + # Validate the special "pick" make command, processed internally + # by metaconfig. + my %valid = map { $_ => 1 } qw( + add add.Config_sh add.Null + c_h_weed cm_h_weed close.Config_sh + prepend weed wipe + + ); + my $cmd; + $cmd = $1 if s/^\s+(\S+)//; + unless (defined $cmd) { + warn "$where: pick needs a command argument.\n"; + return; + } + $wiped_unit++ if $cmd eq 'wipe'; + warn "$where: unknown pick command '$cmd'.\n" unless $valid{$cmd}; + s/^\s+//; + unless (s/^\$\@//) { + warn "$where: third pick argument must be \$\@\n"; + return; + } + s/^\s+//; + my $target; + $target = $1 if s/^(\S+)//; + unless (defined $target) { + warn "$where: fourth pick argument is missing\n"; + return; + } + return if $target =~ m|^\./|; + warn "$where: weird fourth argument '$target' to pick.\n" + unless $target =~ /^\w+$/; +} + # Process the ?MAKE: line sub p_make { local($_) = @_; @@ -132,7 +174,7 @@ sub p_make { local(@dep); # Dependencies local($where) = "\"$file\", line $. (?MAKE:)"; unless (/^[\w+ ]*:/) { - $wiped_unit++ if /^\t+-pick\s+wipe\b/; + &p_make_command; return; # We only want the main dependency rule } warn "$where: ignoring duplicate dependency listing line.\n" -- cgit v1.2.3 From 769f306c6c3fb3d5f39a1666932b71452879bdbc Mon Sep 17 00:00:00 2001 From: Raphael Manfredi Date: Sun, 14 May 2017 09:14:17 +0200 Subject: Further enhanced ?MAKE: checks for pick to watch for %<. The last argument of the pick command is the target, usually the current unit name, or an explicit relative path. If it is the unit name, then it is better represented by using the %< macro in case the unit file is copied or renamed later. --- mcon/pl/lint.pl | 2 ++ 1 file changed, 2 insertions(+) (limited to 'mcon/pl') diff --git a/mcon/pl/lint.pl b/mcon/pl/lint.pl index 3762e3d..5a70598 100644 --- a/mcon/pl/lint.pl +++ b/mcon/pl/lint.pl @@ -165,6 +165,8 @@ sub p_make_command { return if $target =~ m|^\./|; warn "$where: weird fourth argument '$target' to pick.\n" unless $target =~ /^\w+$/; + warn "$where: fourth pick argument should probably be the %< macro.\n" + unless $target eq $unit; } # Process the ?MAKE: line -- cgit v1.2.3 From 910e8f31933d2737de501a445b0cb6ddf9e2251f Mon Sep 17 00:00:00 2001 From: mauke Date: Fri, 13 Oct 2017 16:21:21 +0200 Subject: fix @wiping initialization (#12) qw(...) cannot contain comments. The previous "comment" was interpreted as part of the qw list. --- mcon/pl/lint.pl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'mcon/pl') diff --git a/mcon/pl/lint.pl b/mcon/pl/lint.pl index 5a70598..08acb28 100644 --- a/mcon/pl/lint.pl +++ b/mcon/pl/lint.pl @@ -110,7 +110,8 @@ sub init_extraction { @make = (); # Records make dependency lines $body = 'p_body'; # Procedure to handle body $ending = 'p_end'; # Called at the end of each unit - @wiping = qw( # The keywords we recognize for "wiped" units + @wiping = # The keywords we recognize for "wiped" units + qw( PACKAGENAME MAINTLOC VERSION -- cgit v1.2.3 From 06e93d9d534a84de9902164cc75d9b98bfadc452 Mon Sep 17 00:00:00 2001 From: mauke Date: Fri, 13 Oct 2017 17:47:00 +0200 Subject: fix typo in variable name (#13) --- mcon/pl/lint.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'mcon/pl') diff --git a/mcon/pl/lint.pl b/mcon/pl/lint.pl index 08acb28..0120c51 100644 --- a/mcon/pl/lint.pl +++ b/mcon/pl/lint.pl @@ -798,7 +798,7 @@ sub p_body { # afterwards... my $check_vars = 1; - $chek_vars = 0 if $heredoc_nosubst && !$began_here; + $check_vars = 0 if $heredoc_nosubst && !$began_here; # Record any attempt made to set a shell variable local($sym); -- cgit v1.2.3 From 4522d060c8e2be12b054d1e883f66879cc610a77 Mon Sep 17 00:00:00 2001 From: Aaron Crane Date: Mon, 23 Oct 2017 18:13:51 +0100 Subject: New "-X exclusions-file" option for mconfig Packages can use this option to list symbols that shouldn't bring in the corresponding units. For example, Perl need not provide support for BSD index(3) as an alternative to C89 strchr(3), but "index" is the name of a Perl builtin, so that string in the source files is misunderstood by metaconfig as an attempt to use the BSD function. With this change, Perl can deal with this situation by adding "index" (and "rindex") to an exclusion list. --- mcon/pl/depend.pl | 3 +++ mcon/pl/wanted.pl | 19 +++++++++++++++++++ 2 files changed, 22 insertions(+) (limited to 'mcon/pl') diff --git a/mcon/pl/depend.pl b/mcon/pl/depend.pl index fc88f1a..e31eded 100644 --- a/mcon/pl/depend.pl +++ b/mcon/pl/depend.pl @@ -52,6 +52,9 @@ sub p_wanted { $cmaster{$_} = undef; # Asks for look-up in C files $cwanted{$_} = "$active" if $active; # Shell symbols to activate } + + delete @cmaster{keys %excluded_symbol}; + delete @cwanted{keys %excluded_symbol}; } # Process the ?INIT: lines diff --git a/mcon/pl/wanted.pl b/mcon/pl/wanted.pl index 20d218c..6a44039 100644 --- a/mcon/pl/wanted.pl +++ b/mcon/pl/wanted.pl @@ -39,6 +39,25 @@ ;# ;# The manifake() routine has to be provided externally. ;# +sub read_exclusions { + my ($filename) = @_; + print "Reading exclusions from $filename...\n" unless $opt_s; + open(EXCLUSIONS, "< $filename\0") || die "Can't read $filename: $!\n"; + local $_; + while () { + if (/^\s*#|^\s*$/) { + # comment or blank line, ignore + } + elsif (/^\s*(\w+)\s*$/) { + $excluded_symbol{$1} = 1; + } + else { + die "$filename:$.: unrecognised line\n"; + } + } + close(EXCLUSIONS) || die "Can't close $filename: $!\n"; +} + # Build a wanted file from the files held in @SHlist and @clist arrays sub build_wanted { # If wanted file is already there, parse it to map obsolete if -o option -- cgit v1.2.3 From cb2b5788e3a043ab23b2ec54670723c93ef70e1b Mon Sep 17 00:00:00 2001 From: Aaron Crane Date: Tue, 24 Oct 2017 18:20:04 +0100 Subject: Use a "%" sigil when calling Perl keys() / each() This usage has produced a depreaction warning since Perl 5.000, and was finally removed in Perl 5.22. --- mcon/pl/xwant.pl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'mcon/pl') diff --git a/mcon/pl/xwant.pl b/mcon/pl/xwant.pl index 31508eb..e1bbf20 100644 --- a/mcon/pl/xwant.pl +++ b/mcon/pl/xwant.pl @@ -49,7 +49,7 @@ sub build_xref { print " Scanning .[chyl] files for symbols...\n" unless $opt_s; $search = ' ' x (40 * (@cmaster + @ocmaster)); # Pre-extend $search = "while (<>) {study;\n"; # Init loop over ARGV - foreach $key (keys(cmaster)) { + foreach $key (keys(%cmaster)) { $search .= "\$cmaster{'$key'} .= \"\$ARGV#\" if /\\b$key\\b/;\n"; } foreach $key (grep(!/^\$/, keys %Obsolete)) { @@ -63,7 +63,7 @@ sub build_xref { eval $search; eval ''; $/ = "\n"; - while (($key,$value) = each(cmaster)) { + while (($key,$value) = each(%cmaster)) { next if $value eq ''; foreach $file (sort(split(/#/, $value))) { next if $file eq ''; @@ -94,7 +94,7 @@ sub build_xref { $search = ' ' x (40 * (@shmaster + @oshmaster)); # Pre-extend $search = "while (<>) {study;\n"; # All the keys already have a leading '$' - foreach $key (keys(shmaster)) { + foreach $key (keys(%shmaster)) { $search .= "\$shmaster{'$key'} .= \"\$ARGV#\" if /\\$key\\b/;\n"; } foreach $key (grep (/^\$/, keys %Obsolete)) { @@ -108,7 +108,7 @@ sub build_xref { eval $search; eval ''; $/ = "\n"; - while (($key,$value) = each(shmaster)) { + while (($key,$value) = each(%shmaster)) { next if $value eq ''; foreach $file (sort(split(/#/, $value))) { next if $file eq ''; -- cgit v1.2.3 From 9a6a95281df0a1aae6bb08e9f8dbdd226d33db28 Mon Sep 17 00:00:00 2001 From: Aaron Crane Date: Tue, 24 Oct 2017 18:36:14 +0100 Subject: Move read_exclusions() function to files.pl --- mcon/pl/files.pl | 19 +++++++++++++++++++ mcon/pl/wanted.pl | 19 ------------------- 2 files changed, 19 insertions(+), 19 deletions(-) (limited to 'mcon/pl') diff --git a/mcon/pl/files.pl b/mcon/pl/files.pl index 3962fa6..b983832 100644 --- a/mcon/pl/files.pl +++ b/mcon/pl/files.pl @@ -106,3 +106,22 @@ sub q { $_; } +sub read_exclusions { + my ($filename) = @_; + print "Reading exclusions from $filename...\n" unless $opt_s; + open(EXCLUSIONS, "< $filename\0") || die "Can't read $filename: $!\n"; + local $_; + while () { + if (/^\s*#|^\s*$/) { + # comment or blank line, ignore + } + elsif (/^\s*(\w+)\s*$/) { + $excluded_symbol{$1} = 1; + } + else { + die "$filename:$.: unrecognised line\n"; + } + } + close(EXCLUSIONS) || die "Can't close $filename: $!\n"; +} + diff --git a/mcon/pl/wanted.pl b/mcon/pl/wanted.pl index 6a44039..20d218c 100644 --- a/mcon/pl/wanted.pl +++ b/mcon/pl/wanted.pl @@ -39,25 +39,6 @@ ;# ;# The manifake() routine has to be provided externally. ;# -sub read_exclusions { - my ($filename) = @_; - print "Reading exclusions from $filename...\n" unless $opt_s; - open(EXCLUSIONS, "< $filename\0") || die "Can't read $filename: $!\n"; - local $_; - while () { - if (/^\s*#|^\s*$/) { - # comment or blank line, ignore - } - elsif (/^\s*(\w+)\s*$/) { - $excluded_symbol{$1} = 1; - } - else { - die "$filename:$.: unrecognised line\n"; - } - } - close(EXCLUSIONS) || die "Can't close $filename: $!\n"; -} - # Build a wanted file from the files held in @SHlist and @clist arrays sub build_wanted { # If wanted file is already there, parse it to map obsolete if -o option -- cgit v1.2.3 From e66b85ddbd27bb2a83eb28de957a3a0a276b7056 Mon Sep 17 00:00:00 2001 From: Aaron Crane Date: Tue, 24 Oct 2017 18:36:29 +0100 Subject: Support "-X exclusions-file" option in metaxref Otherwise, when mconfig is run with that option, the metaxref would confusingly refer to excluded symbols. --- mcon/pl/xref.pl | 3 +++ 1 file changed, 3 insertions(+) (limited to 'mcon/pl') diff --git a/mcon/pl/xref.pl b/mcon/pl/xref.pl index 02f4164..f077139 100644 --- a/mcon/pl/xref.pl +++ b/mcon/pl/xref.pl @@ -55,6 +55,9 @@ sub p_wanted { $cwanted{$_} = "$fake"; # Attached to this symbol push(@Master, "?$unit:$fake=''"); # Fake initialization } + + delete @cmaster{keys %excluded_symbol}; + delete @cwanted{keys %excluded_symbol}; } # Ingnore the following: -- cgit v1.2.3 From 4db77aeffc4cd0e969c6379e621a6931027976f7 Mon Sep 17 00:00:00 2001 From: Aaron Crane Date: Tue, 24 Oct 2017 19:27:43 +0100 Subject: Allow exclusions file to be named in .package --- mcon/pl/files.pl | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'mcon/pl') diff --git a/mcon/pl/files.pl b/mcon/pl/files.pl index b983832..a7d26a6 100644 --- a/mcon/pl/files.pl +++ b/mcon/pl/files.pl @@ -29,6 +29,9 @@ ;# extensions to their packages. For instance, perl5 adds .xs files holding ;# some C symbols. ;# +;# The read_exclusions() routine honours the .package $exclusions_file +;# variable if its argument is undefined. +;# # Extract filenames from manifest sub extract_filenames { &build_filext; # Construct &is_cfile and &is_shfile @@ -108,6 +111,10 @@ sub q { sub read_exclusions { my ($filename) = @_; + if (!defined $filename) { + $filename = $exclusions_file; # default to name from .package + return if !defined $filename || $filename eq ''; + } print "Reading exclusions from $filename...\n" unless $opt_s; open(EXCLUSIONS, "< $filename\0") || die "Can't read $filename: $!\n"; local $_; -- cgit v1.2.3 From 15e25d59057b78f00042640defd1f8c76b8d4d06 Mon Sep 17 00:00:00 2001 From: Raphael Manfredi Date: Mon, 16 Mar 2020 17:23:24 +0100 Subject: metalint: warn if several units claim to export the same file. --- mcon/pl/lint.pl | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'mcon/pl') diff --git a/mcon/pl/lint.pl b/mcon/pl/lint.pl index 0120c51..3f212af 100644 --- a/mcon/pl/lint.pl +++ b/mcon/pl/lint.pl @@ -78,6 +78,7 @@ sub init_extraction { %filetmp = (); # Local temporary files in ?F: directives %filesetin = (); # Lists units defining a temporary file %filecreated = (); # Records files created in this unit + %filedefined = (); # Records units that export a given file %prodfile = (); # Unit where a given file is said to be created %defseen = (); # Symbol defintions claimed %lintset = (); # Symbols declared set by a ?LINT: line @@ -622,7 +623,17 @@ sub p_file { } $prodfile{$file} .= "$unit " if $fileseen{$file} == 1; ($uufile = $file) =~ s|^\./(\S+)$|$1|; - next if $file eq $uufile; # Don't care about non-UU files + if ($file eq $uufile) { + # This is a non-UU files created and not a temporary file + # It is meant to be exported by Configure + if (exists $filedefined{$file}) { + my $other = $filedefined{$file}; + warn "$where: file '$file' already exported by $other.U.\n"; + } else { + $filedefined{$file} = $unit; + } + next; + } unless ($is_special || $lintcreated{$uufile}) { warn "$where: UU file '$uufile' in non-special unit ignored.\n"; delete $lintcreated{$uufile}; # Detect spurious LINT @@ -1308,6 +1319,7 @@ sub sanity_checks { undef %shspecial; undef %shvisible; undef %filemaster; + undef %filedefined; # Spot multiply defined C symbols foreach $sym (keys %cmaster) { -- cgit v1.2.3 From f0b8d8aca8989710c49512ec0457539c8460f43b Mon Sep 17 00:00:00 2001 From: Raphael Manfredi Date: Mon, 16 Mar 2020 17:13:12 +0100 Subject: metalint: warn if defining a UU-file already claimed. --- mcon/pl/lint.pl | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'mcon/pl') diff --git a/mcon/pl/lint.pl b/mcon/pl/lint.pl index 3f212af..e73f0fd 100644 --- a/mcon/pl/lint.pl +++ b/mcon/pl/lint.pl @@ -640,8 +640,13 @@ sub p_file { next; } delete $lintcreated{$uufile} if !$is_special; # Detect spurious LINT - $filemaster{$uufile} = $unit unless defined $filemaster{$uufile}; - $filecreated{$uufile} = 'a'; # Will be automagically incremented + if (exists $filemaster{$uufile}) { + my $other = $filemaster{$uufile}; + warn "$where: UU file '$uufile' already created by $other.U.\n"; + } else { + $filemaster{$uufile} = $unit; + $filecreated{$uufile} = 'a'; # Will be automagically incremented + } } } -- cgit v1.2.3