X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ian/git?p=subdirmk.git;a=blobdiff_plain;f=generate;h=b564260dea4c02e4385fc0b36974e04efbddf718;hp=c9ade62c3299518c72847b8f8528ffb4764df199;hb=2c8db0f89fdcb949f0e8f82a223bca194a7a28c8;hpb=32261735a134418b3bc26fc49d816e487b8338e5 diff --git a/generate b/generate index c9ade62..b564260 100755 --- a/generate +++ b/generate @@ -3,6 +3,7 @@ # subdirmk - &-filter (makefile generation program) # Copyright 2019 Ian Jackson # SPDX-License-Identifier: LGPL-2.0-or-later +# There is NO WARRANTY. # # $(srcdir)/subdirmk/generate [--srcdir=SRCDIR] [--] SUBDIR... # @@ -153,6 +154,7 @@ END } our %varref; +our %varref_exp; our ($dir_prefix, $dir_suffix, $dir_name, $var_prefix, $var_prefix_name); @@ -173,14 +175,37 @@ sub set_dir_vars ($) { our $err_file; +our @warn_ena_dfl = map { $_ => 1 } qw( + local+global + single-char-var + unknown-warning + broken-var-ref +); +our %warn_ena = @warn_ena_dfl; + +our $warned; +our %warn_unk; + sub err ($) { my ($m) = @_; - die "subdirmk: ${err_file}:$.: $m\n"; + die defined $err_file + ? "subdirmk: ${err_file}:$.: $m\n" + : "subdirmk: $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 ($) { @@ -213,8 +238,8 @@ sub process_input_mk ($$$$) { local $err_file=$f; my %srcdirmap = ( - '^' => "\$(top_srcdir)${dir_suffix}", - '~' => "\$(top_srcdir)", + '^' => "\${top_srcdir}${dir_suffix}", + '~' => "\${top_srcdir}", ); my %pfxmap = ( '' => $dir_prefix, @@ -241,7 +266,8 @@ sub process_input_mk ($$$$) { # accurate, since it is only going to be used for advice to the user. my $note_varref = sub { my ($vn,$amp) = @_; - $varref{$vn}{$amp}{"$f:$."} = 1; + my $exp = !!$varref_exp{$vn}{$amp}; + $varref{$vn}{$exp}{$amp}{"$f:$."} = 1; }; while (<$input>) { @@ -257,9 +283,30 @@ 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) { + my $pos = !($vn =~ s{^!}{}); + my $amp = $vn =~ s{^$esc}{}; + $varref_exp{$vn}{!!$amp} = $pos; + } + 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'; @@ -289,9 +336,13 @@ sub process_input_mk ($$$$) { od $2; if (s{^\$}{}) { od $&; } elsif (m{^[a-zA-Z]\w}) { - wrn + wrn 'single-char-var', 'possibly confusing unbracketed single-char $-expansion'; } + elsif (m{^$esc}) { + wrn 'broken-var-ref', + 'broken $&... expansion; you probably meant &$'; + } elsif (m{^\(($esc)?([^()\$]+)\)} || m{^\{($esc)?([^{}\$]+)\}}) { $note_varref->($2,!!$1); @@ -305,7 +356,7 @@ sub process_input_mk ($$$$) { elsif (m{^(?=$caps_re)}) { od $var_prefix } elsif (s{^\$([A-Za-z]\w+)}{}) { $note_varref->($1,1); - od "\$(${var_prefix}$1)"; + od "\${${var_prefix}$1}"; } elsif (s{^([~^]?)(?=$lc_re)}{}) { od $pfxmap{$1} } elsif (s{^_}{}) { od $var_prefix } @@ -316,15 +367,17 @@ sub process_input_mk ($$$$) { elsif (s{^\$\-}{}) { $ddbl=undef; } elsif (s{^\$\+}{}) { $ddbl=1; } elsif (s{^\$\(}{}) { - ddbl_only($&); oud "\$("; + ddbl_only($&); oud "\${"; $note_varref->($2,!!$1) if m{^($esc)?([^()\$]+\))}; } - elsif (s{^\$(\d+)}{}) { ddbl_only($&); oud "\$($1)"; } - elsif (s{^\$\{}{}) { + elsif (s{^\$(\d+)}{}) { ddbl_only($&); oud "\${$1}"; } + elsif (s{^\(\s*$esc(?=$lc_re)}{}) { od "\$(call ${var_prefix}" } + elsif (s{^\(\s*(?=\S)}{} ) { od "\$(call " } + elsif (s{^\{}{}) { err 'macro invocation cannot be re-$-doubled' if $ddbl; od '${eval ${call '; $evalcall_brackets = 1; - $push_nest->('eval',1, '&${...}'); + $push_nest->('eval',1, '&{...}'); $note_varref->($2,!!$1) if m{^\s*($esc)?([^,{}\$]+)}; } elsif (s{^([~^]?)(?=[ \t])}{}) { my $prefix = $pfxmap{$1} // die "internal error ($1?)"; @@ -390,6 +443,8 @@ sub process_subtree ($$) { #use Data::Dumper; #print STDERR Dumper(\@_); + local %varref_exp; + my $dir_prefix = dir_prefix($path); # ^ this is the only var which we need before we come back from # the recursion. @@ -402,6 +457,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); } @@ -474,20 +530,38 @@ 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 unless $vv->{''}{''} && $vv->{''}{1}; + wrncore 'local+global', "saw both $vn and &$vn" or return; + foreach my $exp ('', 1) { foreach my $amp ('', 1) { - printf STDERR " saw %s%s at %s\n", + printf STDERR + ($exp + ? " expectedly saw %s%s at %s\n" + : " saw %s%s at %s\n"), ($amp ? '&' : ''), $vn, $_ - foreach sort keys %{ $vv->{$amp} }; + foreach + sort { flmap($a) cmp flmap($b) } + keys %{ $vv->{$exp}{$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();