summaryrefslogtreecommitdiff
path: root/mcon/pl
diff options
context:
space:
mode:
Diffstat (limited to 'mcon/pl')
-rw-r--r--mcon/pl/common.pl2
-rw-r--r--mcon/pl/configure.pl11
-rw-r--r--mcon/pl/cosmetic.pl2
-rw-r--r--mcon/pl/depend.pl5
-rw-r--r--mcon/pl/eval.pl2
-rw-r--r--mcon/pl/extract.pl2
-rw-r--r--mcon/pl/files.pl28
-rw-r--r--mcon/pl/gensym.pl2
-rw-r--r--mcon/pl/init.pl2
-rw-r--r--mcon/pl/lint.pl53
-rw-r--r--mcon/pl/locate.pl4
-rw-r--r--mcon/pl/makefile.pl2
-rw-r--r--mcon/pl/obsolete.pl2
-rw-r--r--mcon/pl/order.pl4
-rw-r--r--mcon/pl/tsort.pl2
-rw-r--r--mcon/pl/wanted.pl2
-rw-r--r--mcon/pl/xref.pl5
-rw-r--r--mcon/pl/xwant.pl10
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 '';
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-20 08:35:48 +0000