X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ian/git?p=subdirmk.git;a=blobdiff_plain;f=generate;h=ffd3e5dfdb1e18951ac9771efef71c93e3e64143;hp=4a0450686c61e556227a1134bef5f3d114b7b277;hb=291014f5a360a39bf99e4519e3ffb6c12d90d253;hpb=ecbc3dad2da6cddc7562ce77807231d995f6353a diff --git a/generate b/generate index 4a04506..ffd3e5d 100755 --- a/generate +++ b/generate @@ -7,7 +7,7 @@ # $(srcdir)/subdirmk/generate [--srcdir=SRCDIR] [--] SUBDIR... # # generates in each subdirectory -# Subdir.mk.tmp +# Dir.mk.tmp # Makefile # and in toplevel # main.mk.tmp @@ -152,6 +152,8 @@ Makefile run-main.mk: END } +our %varref; + our ($dir_prefix, $dir_suffix, $dir_name, $var_prefix, $var_prefix_name); @@ -171,11 +173,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"; } +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 ($) { my ($e) = @_; return if $ddbl; @@ -216,6 +244,7 @@ sub process_input_mk ($$$$) { local $ddbl; my @nest = (['']); + my $evalcall_brackets; my $push_nest = sub { my ($nk, $nndbl, $what) = @_; @@ -229,7 +258,18 @@ sub process_input_mk ($$$$) { $ddbl = (shift @nest)[1]; }; + # Our detection of variable settings does not have to be completely + # 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; + }; + while (<$input>) { + if (m#^\s*($esc)?(\w+)\s*(?:=|\+=|\?=|:=)# || + m#^\s*(?:$esc\:macro|define)\s+($esc)?(\S+)\s#) { + $note_varref->($2,!!$1); + } if (s#^\s*$esc\:changequote\s+(\S+)\s+$##) { $$esclitr = $1; $set_esc->(); @@ -238,29 +278,69 @@ 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 (;;) { err 'cannot $-double &-processed RHS of directive' if $ddbl && defined $buffering_output; unless ($nest[0][0] eq 'eval' - ? s{^(.*?)($esc|[{}])}{} - : s{^(.*?)($esc)}{}) { od $_; last; } + ? s{^(.*?)($esc|\$|[{}])}{} + : s{^(.*?)($esc|\$)}{}) { od $_; last; } od $1; if ($2 eq '{') { - $ddbl++; + od $2; + $evalcall_brackets++; next; } elsif ($2 eq '}') { - next if --$ddbl; + od $2; + next if --$evalcall_brackets; $pop_nest->('eval'); - od '}}'; + od '}'; + next; + } 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}) { + wrn 'broken-var-ref', + 'broken $&... expansion; you probably meant &$'; + } + elsif (m{^\(($esc)?([^()\$]+)\)} || + m{^\{($esc)?([^{}\$]+)\}}) { + $note_varref->($2,!!$1); + } next; } if (s{^\\$esc}{}) { od "$$esclitr" } @@ -268,7 +348,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 } @@ -277,12 +360,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=''; @@ -333,9 +421,9 @@ sub filter_subdir_mk ($) { my ($f, $enoentok) = @_; process_input_mk($targets, "${srcdir}/$f", \$esclit, $enoentok); }; - $pi->("Prefix.sd.mk", 1); - $pi->("${dir_prefix}Subdir.sd.mk", 0); - $pi->("Suffix.sd.mk", 1); + $pi->("Prefix.sd.mk", 1); + $pi->("${dir_prefix}Dir.sd.mk", 0); + $pi->("Suffix.sd.mk", 1); } sub process_subtree ($$); @@ -351,7 +439,7 @@ sub process_subtree ($$) { # ^ this is the only var which we need before we come back from # the recursion. - push @output_makefiles, "${dir_prefix}Subdir.mk"; + push @output_makefiles, "${dir_prefix}Dir.mk"; write_makefile($dir_prefix, scalar @$path); my %targets = (all => []); @@ -359,17 +447,18 @@ 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); } set_dir_vars($path); - start_output_file("${dir_prefix}Subdir.mk.tmp"); + start_output_file("${dir_prefix}Dir.mk.tmp"); if ($node->[2]) { filter_subdir_mk(\%targets); } else { - my $sdmk = "${dir_prefix}Subdir.sd.mk"; + my $sdmk = "${dir_prefix}Dir.sd.mk"; if (stat $sdmk) { die "subdirmk: $sdmk unexpectedly exists (${dir_prefix} not mentioned on subdirmk/generate command line, maybe directory is missing from SUBDIRMK_SUBDIRS)"; @@ -384,16 +473,16 @@ sub process_subtree ($$) { my @targets = sort keys %targets; foreach my $target (@targets) { my $target_varname = target_varname($var_prefix, $target); - print O "${dir_prefix}${target}:: \$($target_varname)"; + oraw "${dir_prefix}${target}:: \$($target_varname)"; foreach my $child_subdir (@{ $targets{$target} }) { - print O " $child_subdir/$target"; + oraw " $child_subdir/$target"; } - print O "\n"; + oraw "\n"; } if (@targets) { - print O ".PHONY:"; - print O " ${dir_prefix}${_}" foreach @targets; - print O "\n"; + oraw ".PHONY:"; + oraw " ${dir_prefix}${_}" foreach @targets; + oraw "\n"; } return @targets; @@ -431,6 +520,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}; + 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 { 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();