X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ian/git?p=subdirmk.git;a=blobdiff_plain;f=generate;h=bae0995bef30dc90fbd19e7cb511d61a0887b99a;hp=d8183d07dd9356e005d90a8160038dae4b9f3047;hb=80097a24dcbc044e36242a7e1d67bd57503e3eec;hpb=4d32a95729b7ae70fc1b65017cd26d22707ea33d

diff --git a/generate b/generate
index d8183d0..bae0995 100755
--- a/generate
+++ b/generate
@@ -173,14 +173,34 @@ sub set_dir_vars ($) {
 
 our $err_file;
 
+our @warn_ena_dfl = map { $_ => 1 } qw(
+    local+global
+    single-char-var
+    unknown-warning
+);
+our %warn_ena = @warn_ena_dfl;
+
+our $warned;
+our %warn_unk;
+
 sub err ($) {
     my ($m) = @_;
     die "subdirmk: ${err_file}:$.: $m\n";
 }
 
-sub wrn ($) {
-    my ($m) = @_;
-    print STDERR "subdirmk: warning: ${err_file}:$.: $m\n";
+sub wrncore ($$) {
+    my ($wk,$m) = @_;
+    return 0 unless $warn_ena{$wk} // warn "internal error $wk ?";
+    $warned++;
+    print STDERR "subdirmk: warning ($wk): $m\n";
+    return 1;
+}
+
+sub wrn ($$) {
+    my ($wk,$m) = @_;
+    our %warn_dedupe;
+    return 0 if $warn_dedupe{$err_file,$.,$wk,$m}++;
+    wrncore($wk, "${err_file}:$.: $m");
 }
 
 sub ddbl_only ($) {
@@ -257,13 +277,35 @@ sub process_input_mk ($$$$) {
 	    $pop_nest->('macro');
 	    od "endef\n";
 	    next;
+	} elsif (s#^\s*$esc\:warn\s+(\S.*)$##) {
+	    foreach my $wk (split /\s+/, $1) {
+		my $yes = $wk !~ s{^!}{};
+		if (defined $warn_ena{$wk}) {
+		    $warn_ena{$wk} = $yes;
+		    next;
+		} elsif ($yes) {
+		    wrn 'unknown-warning',
+			"unknown warning $wk requested";
+		} else {
+		    $warn_unk{$wk} //= "$f:$.";
+		}
+	    }
+	    next;
+	} elsif (s#^\s*$esc\:local\+global\s+(\S.*)$##) {
+	    foreach my $vn (split /\s+/, $1) {
+		$vn =~ s{^$esc}{};
+		$varref{$vn}{NoWarn} = 1;
+	    }
+	    next;
 	} elsif (s#^\s*$esc\:(?=(-?)include|macro)##) {
 	    $buffering_output='';
-	} elsif (m#^\s*$esc\:([a-z][-0-9a-z_]*)#) {
+	} elsif (m#^\s*$esc\:([a-z][-+0-9a-z_]*)#) {
 	    err "unknown directive &:$1 or bad argumnt syntax";
 	} elsif (s{^\s*${esc}TARGETS(?:_([0-9a-zA-Z_]+))?(?=\W)}{}) {
 	    my $t = $1 // 'all';
-	    od target_varname($var_prefix, $t);
+	    my $vn = target_varname($var_prefix, $t);
+	    $note_varref->($vn,1);
+	    od $vn;
 	    $targets->{$t} //= [ ];
 	}
 	for (;;) {
@@ -286,6 +328,10 @@ sub process_input_mk ($$$$) {
 	    } elsif ($2 eq '$') {
 		od $2;
 		if (s{^\$}{}) { od $&; }
+		elsif (m{^[a-zA-Z]\w}) {
+		    wrn 'single-char-var',
+		    'possibly confusing unbracketed single-char $-expansion';
+		}
 		elsif (m{^\(($esc)?([^()\$]+)\)} ||
 		       m{^\{($esc)?([^{}\$]+)\}}) {
 		    $note_varref->($2,!!$1);
@@ -297,7 +343,10 @@ sub process_input_mk ($$$$) {
 	    elsif (s{^\\\s+$}{}) { }
 	    elsif (s{^$esc}{}) { od "$$esclitr$$esclitr" }
 	    elsif (m{^(?=$caps_re)}) { od $var_prefix }
-	    elsif (s{^\$([A-Za-z]\w+)}{}) { od "\$(${var_prefix}$1)" }
+	    elsif (s{^\$([A-Za-z]\w+)}{}) {
+		$note_varref->($1,1);
+		od "\$(${var_prefix}$1)";
+	    }
 	    elsif (s{^([~^]?)(?=$lc_re)}{}) { od $pfxmap{$1} }
 	    elsif (s{^_}{}) { od $var_prefix }
 	    elsif (s{^=}{}) { od $var_prefix_name }
@@ -306,13 +355,17 @@ sub process_input_mk ($$$$) {
 	    elsif (s{^([~^])\.}{}) { od $srcdirmap{$1} }
 	    elsif (s{^\$\-}{}) { $ddbl=undef; }
 	    elsif (s{^\$\+}{}) { $ddbl=1; }
-	    elsif (s{^\$\(}{}) { ddbl_only($&); oud "\$("; }
+	    elsif (s{^\$\(}{}) {
+		ddbl_only($&); oud "\$(";
+		$note_varref->($2,!!$1) if m{^($esc)?([^()\$]+\))};
+	    }
 	    elsif (s{^\$(\d+)}{}) { ddbl_only($&); oud "\$($1)"; }
 	    elsif (s{^\$\{}{}) {
 		err 'macro invocation cannot be re-$-doubled' if $ddbl;
 		od '${eval ${call ';
 		$evalcall_brackets = 1;
 		$push_nest->('eval',1, '&${...}');
+		$note_varref->($2,!!$1) if m{^\s*($esc)?([^,{}\$]+)};
 	    } elsif (s{^([~^]?)(?=[ \t])}{}) {
 		my $prefix = $pfxmap{$1} // die "internal error ($1?)";
 		my $after='';
@@ -389,6 +442,7 @@ sub process_subtree ($$) {
 	my @childpath = (@$path, $child->[0]);
 	my $child_subdir = join '/', @childpath;
 	mkdir $child_subdir or $!==EEXIST or die "mkdir $child_subdir: $!\n";
+	local %warn_ena = @warn_ena_dfl;
 	push @{ $targets{$_} }, $child_subdir foreach
 	    process_subtree($child, \@childpath);
     }
@@ -461,20 +515,34 @@ sub process_tree() {
     oraw "include \$(SUBDIRMK_MAKEFILES)\n";
 }
 
+sub flmap ($) { local ($_) = @_; s{:(\d+)$}{ sprintf ":%10d", $1 }e; $_; }
+
 sub print_varref_warnings () {
     foreach my $vn (sort keys %varref) {
 	my $vv = $varref{$vn};
 	next unless $vv->{''} && $vv->{1};
-	print STDERR "subdirmk: warning: saw both $vn and &$vn\n";
+	next if $vv->{NoWarn};
+	wrncore 'local+global', "saw both $vn and &$vn" or return;
 	foreach my $amp ('', 1) {
 	    printf STDERR " saw %s%s at %s\n",
 		($amp ? '&' : ''), $vn, $_
-		foreach sort keys %{ $vv->{$amp} };
+		foreach
+		sort { flmap($a) cmp flmap($b) }
+		keys %{ $vv->{$amp} };
 	}
     }
 }
 
+sub print_warning_warnings () {
+    return unless $warned;
+    foreach my $wk (sort keys %warn_unk) {
+	wrncore 'unknown-warning',
+	    "$warn_unk{$wk}: attempt to suppress unknown warning(s) \`$wk'";
+    }
+}
+
 build_tree();
 process_tree();
 print_varref_warnings();
+print_warning_warnings();
 install_output_files();