diff options
Diffstat (limited to 'mcon/pl')
-rw-r--r-- | mcon/pl/common.pl | 2 | ||||
-rw-r--r-- | mcon/pl/configure.pl | 11 | ||||
-rw-r--r-- | mcon/pl/cosmetic.pl | 2 | ||||
-rw-r--r-- | mcon/pl/depend.pl | 5 | ||||
-rw-r--r-- | mcon/pl/eval.pl | 2 | ||||
-rw-r--r-- | mcon/pl/extract.pl | 2 | ||||
-rw-r--r-- | mcon/pl/files.pl | 28 | ||||
-rw-r--r-- | mcon/pl/gensym.pl | 2 | ||||
-rw-r--r-- | mcon/pl/init.pl | 2 | ||||
-rw-r--r-- | mcon/pl/lint.pl | 53 | ||||
-rw-r--r-- | mcon/pl/locate.pl | 4 | ||||
-rw-r--r-- | mcon/pl/makefile.pl | 2 | ||||
-rw-r--r-- | mcon/pl/obsolete.pl | 2 | ||||
-rw-r--r-- | mcon/pl/order.pl | 4 | ||||
-rw-r--r-- | mcon/pl/tsort.pl | 2 | ||||
-rw-r--r-- | mcon/pl/wanted.pl | 2 | ||||
-rw-r--r-- | mcon/pl/xref.pl | 5 | ||||
-rw-r--r-- | mcon/pl/xwant.pl | 10 |
18 files changed, 109 insertions, 31 deletions
diff --git a/mcon/pl/common.pl b/mcon/pl/common.pl index d797b54..0d1ea5a 100644 --- a/mcon/pl/common.pl +++ b/mcon/pl/common.pl @@ -1,4 +1,4 @@ -;# $Id: common.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# diff --git a/mcon/pl/configure.pl b/mcon/pl/configure.pl index cb6c70e..d99d74b 100644 --- a/mcon/pl/configure.pl +++ b/mcon/pl/configure.pl @@ -1,4 +1,4 @@ -;# $Id: configure.pl 25 2008-05-28 11:19:25Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# @@ -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 (<TARGET>) { 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"; } } diff --git a/mcon/pl/cosmetic.pl b/mcon/pl/cosmetic.pl index 66d2168..d8b535b 100644 --- a/mcon/pl/cosmetic.pl +++ b/mcon/pl/cosmetic.pl @@ -1,4 +1,4 @@ -;# $Id: cosmetic.pl 20 2008-01-04 23:14:00Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# diff --git a/mcon/pl/depend.pl b/mcon/pl/depend.pl index 8826aee..e31eded 100644 --- a/mcon/pl/depend.pl +++ b/mcon/pl/depend.pl @@ -1,4 +1,4 @@ -;# $Id: depend.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# @@ -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/eval.pl b/mcon/pl/eval.pl index aa6c4aa..c4c1d76 100644 --- a/mcon/pl/eval.pl +++ b/mcon/pl/eval.pl @@ -1,4 +1,4 @@ -;# $Id: eval.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# diff --git a/mcon/pl/extract.pl b/mcon/pl/extract.pl index 7b84a1f..385b751 100644 --- a/mcon/pl/extract.pl +++ b/mcon/pl/extract.pl @@ -1,4 +1,4 @@ -;# $Id: extract.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# diff --git a/mcon/pl/files.pl b/mcon/pl/files.pl index 2c955c7..a7d26a6 100644 --- a/mcon/pl/files.pl +++ b/mcon/pl/files.pl @@ -1,4 +1,4 @@ -;# $Id: files.pl 23 2008-05-28 08:05:12Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# @@ -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 @@ -106,3 +109,26 @@ 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 $_; + while (<EXCLUSIONS>) { + 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/gensym.pl b/mcon/pl/gensym.pl index 8ffe02a..4f65065 100644 --- a/mcon/pl/gensym.pl +++ b/mcon/pl/gensym.pl @@ -1,4 +1,4 @@ -;# $Id: gensym.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# diff --git a/mcon/pl/init.pl b/mcon/pl/init.pl index f7ac75b..c60d64c 100644 --- a/mcon/pl/init.pl +++ b/mcon/pl/init.pl @@ -1,4 +1,4 @@ -;# $Id: init.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# diff --git a/mcon/pl/lint.pl b/mcon/pl/lint.pl index 5c6db47..0120c51 100644 --- a/mcon/pl/lint.pl +++ b/mcon/pl/lint.pl @@ -1,4 +1,4 @@ -;# $Id: lint.pl 132 2012-02-09 19:15:13Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# @@ -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 @@ -125,6 +126,50 @@ 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+$/; + warn "$where: fourth pick argument should probably be the %< macro.\n" + unless $target eq $unit; +} + # Process the ?MAKE: line sub p_make { local($_) = @_; @@ -132,7 +177,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" @@ -753,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); diff --git a/mcon/pl/locate.pl b/mcon/pl/locate.pl index 77a2cf3..46c1078 100644 --- a/mcon/pl/locate.pl +++ b/mcon/pl/locate.pl @@ -1,4 +1,4 @@ -;# $Id: locate.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# @@ -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$/; diff --git a/mcon/pl/makefile.pl b/mcon/pl/makefile.pl index 8437dda..434fbeb 100644 --- a/mcon/pl/makefile.pl +++ b/mcon/pl/makefile.pl @@ -1,4 +1,4 @@ -;# $Id: makefile.pl 20 2008-01-04 23:14:00Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# diff --git a/mcon/pl/obsolete.pl b/mcon/pl/obsolete.pl index 612c505..ba9a601 100644 --- a/mcon/pl/obsolete.pl +++ b/mcon/pl/obsolete.pl @@ -1,4 +1,4 @@ -;# $Id: obsolete.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# diff --git a/mcon/pl/order.pl b/mcon/pl/order.pl index 5af05f2..1616beb 100644 --- a/mcon/pl/order.pl +++ b/mcon/pl/order.pl @@ -1,4 +1,4 @@ -;# $Id: order.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# @@ -33,7 +33,7 @@ sub solve_dependencies { # Ignore conditional symbol request } else { chop; - system; + system $_; } } chdir($WD) || die "Can't chdir to $WD: $!.\n"; diff --git a/mcon/pl/tsort.pl b/mcon/pl/tsort.pl index ebc49a3..4d56fae 100644 --- a/mcon/pl/tsort.pl +++ b/mcon/pl/tsort.pl @@ -1,4 +1,4 @@ -;# $Id: tsort.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# diff --git a/mcon/pl/wanted.pl b/mcon/pl/wanted.pl index b9626ef..20d218c 100644 --- a/mcon/pl/wanted.pl +++ b/mcon/pl/wanted.pl @@ -1,4 +1,4 @@ -;# $Id: wanted.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# diff --git a/mcon/pl/xref.pl b/mcon/pl/xref.pl index 5f345fd..f077139 100644 --- a/mcon/pl/xref.pl +++ b/mcon/pl/xref.pl @@ -1,4 +1,4 @@ -;# $Id: xref.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# @@ -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: diff --git a/mcon/pl/xwant.pl b/mcon/pl/xwant.pl index 2734494..e1bbf20 100644 --- a/mcon/pl/xwant.pl +++ b/mcon/pl/xwant.pl @@ -1,4 +1,4 @@ -;# $Id: xwant.pl 1 2006-08-24 12:32:52Z rmanfredi $ +;# $Id$ ;# ;# Copyright (c) 1991-1997, 2004-2006, Raphael Manfredi ;# @@ -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 ''; |