X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ian/git?p=subdirmk.git;a=blobdiff_plain;f=generate;h=bcbbf79dde7d86b5ad1b3ff5ba3b30b1ca2359d8;hp=486bdc54e1c888b7be9cee539918296651cc8010;hb=b0bdaa30dd60890b5494fab1f3e7f5d70a8ceb8e;hpb=25a516a59e7811b8626b5fe40b49c5ef942db697 diff --git a/generate b/generate index 486bdc5..bcbbf79 100755 --- a/generate +++ b/generate @@ -3,14 +3,15 @@ # 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... # -# generates in each subdirectory from in each subdirectory -# Subdir.mk.tmp Subdir.sd.mk -# Makefile and included files -# and in toplevel and in toplevel -# main.mk.tmp Perdir.sd.mk +# generates in each subdirectory +# Dir.mk.tmp +# Makefile +# and in toplevel +# main.mk.tmp use strict; use POSIX; @@ -19,21 +20,40 @@ print "$0 @ARGV\n" or die $!; our $srcdir='.'; +# error handling methods: +# +# Error in input file, while $err_file and $. set, eg in most of +# process_input_mk: +# err "message"; +# +# Other input or usage errors: +# die "subdirmk: $file:$lno: problem\n"; +# die "subdirmk: some problem not locatable in that way\n"; +# +# Usage error: +# die "subdirmk $0: explanation of problem\n"; +# +# System call error (not ENOENT) accessing input/output files: +# die "description of problem eg maybe erbing noun: $!\n"; +# +# Bug detedcted in `generate': +# die "internal error (some information)?"; # or similar + while (@ARGV && $ARGV[0] =~ m/^-/) { $_ = shift @ARGV; last if $_ eq '--'; if (s/^--srcdir=//) { $srcdir=$'; } else { - die "$0: unknown option \`$_'\n"; + die "subdirmk $0: unknown option \`$_'\n"; } } our @subdirs = @ARGV; s{/+$}{} foreach @subdirs; -our $root = [ '.', [ ] ]; -# each node is [ 'relative subdir name', \@children ] +our $root = [ '.', [ ], 1 ]; +# each node is [ 'relative subdir name', \@children, $mentioned ] sub build_tree () { foreach my $subdir (@subdirs) { @@ -47,6 +67,7 @@ sub build_tree () { } $node = $c; } + $node->[2] = 1; } } @@ -59,6 +80,7 @@ our $writing_output; our $buffering_output; our %output_files; our %input_files; +our @output_makefiles; sub close_any_output_file() { return unless defined $writing_output; @@ -67,22 +89,41 @@ sub close_any_output_file() { $writing_output = undef; } -sub o { +sub oraw { + die 'internal error' unless defined $writing_output; + print O @_ or die "error writing $writing_output.tmp: $!\n"; +} + +sub oud { # undoubled if (defined $buffering_output) { $buffering_output .= $_ foreach @_; return; } - die unless defined $writing_output; - print O @_ or die "error writing $writing_output.tmp: $!\n"; + oraw @_; +} + +our $ddbl; + +sub od { # maybe $-doubled + if (!$ddbl) { + oud @_; + return; + } + foreach (@_) { + my $e = $_; + $e =~ s{\$}{\$\$}g; + oud $e; + } } sub start_output_file ($) { close_any_output_file(); ($writing_output) = @_; - die "$writing_output ?" if $output_files{$writing_output}++; + die "internal error ($writing_output?)" + if $output_files{$writing_output}++; my $tmp = "$writing_output.tmp"; open O, ">", $tmp or die "create $tmp: $!\n"; - o "# autogenerated - do not edit\n"; + oraw "# autogenerated - do not edit\n"; } sub install_output_files () { @@ -97,22 +138,85 @@ sub write_makefile ($$) { #print STDERR "write_makefile @_\n"; start_output_file("${dir_prefix}Makefile"); my $cd = $depth ? join('/', ('..',) x $depth) : '.'; - o < 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 defined $err_file + ? "subdirmk: ${err_file}:$.: $m\n" + : "subdirmk: $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; + err "escape &$e is valid only during \$-doubling"; +} + +sub process_input_mk ($$$$); +sub process_input_mk ($$$$) { + my ($targets, $f, $esclitr, $enoent_ok) = @_; my $caps_re = qr{[A-Z]}; my $lc_re = qr{[a-z]}; @@ -126,55 +230,168 @@ sub process_input_mk ($$$$$$$$) { my $input = new IO::File $f, '<'; if (!$input) { - die "open $f: $!\n" unless $!==ENOENT && $enoent_ok; + err "open $f: $!" unless $!==ENOENT && $enoent_ok; return; } $input_files{$f}++; + local $err_file=$f; + + my %srcdirmap = ( + '^' => "\${top_srcdir}${dir_suffix}", + '~' => "\${top_srcdir}", + ); + my %pfxmap = ( + '' => $dir_prefix, + ); + $pfxmap{$_} = $srcdirmap{$_}.'/' foreach keys %srcdirmap; + + local $ddbl; + my @nest = (['']); + my $evalcall_brackets; + + my $push_nest = sub { + my ($nk, $nndbl, $what) = @_; + unshift @nest, [ $nk, $ddbl, $what, $. ]; + $ddbl = $nndbl; + }; + my $pop_nest = sub { + my ($nk) = @_; + err "unexpectedly closed $nk in middle of $nest[0][0] ($nest[0][2])" + unless $nest[0][0] eq $nk; + $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) = @_; + my $exp = !!$varref_exp{$vn}{$amp}; + $varref{$vn}{$exp}{$amp}{"$f:$."} = 1; + }; + while (<$input>) { - if (s#^\s*$esc\:##) { + 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->(); + next; + } elsif (s#^\s*$esc\:endm\s+$##) { + $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_]*)#) { + err "unknown directive &:$1 or bad argumnt syntax"; + } elsif (s{^\s*${esc}TARGETS(?:_([0-9a-zA-Z_]+))?(?=\W)}{}) { + my $t = $1 // 'all'; + my $vn = target_varname($var_prefix, $t); + $note_varref->($vn,1); + od $vn; + $targets->{$t} //= [ ]; } for (;;) { - unless (s{^(.*?)(\\)?(?=$esc)}{}) { o $_; last; } - o $1; - if ($2) { o $$esclitr; next; } - s{^$esc}{} or die "$_ ?"; - if (s{^$esc}{}) { o "$$esclitr$$esclitr" } - elsif (s{^TARGETS(?:_([0-9a-zA-Z_]+))?(?=\W)}{}) { - my $t = $1 // 'all'; - o target_varname($var_prefix, $t); - $targets->{$t} //= [ ]; + err 'cannot $-double &-processed RHS of directive' + if $ddbl && defined $buffering_output; + unless ($nest[0][0] eq 'eval' + ? s{^(.*?)($esc|\$|[{}])}{} + : s{^(.*?)($esc|\$)}{}) { od $_; last; } + od $1; + if ($2 eq '{') { + od $2; + $evalcall_brackets++; + next; + } elsif ($2 eq '}') { + od $2; + next if --$evalcall_brackets; + $pop_nest->('eval'); + 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" } + elsif (s{^\\\$}{}) { oud '$' } + elsif (s{^\\\s+$}{}) { } + elsif (s{^$esc}{}) { od "$$esclitr$$esclitr" } + elsif (m{^(?=$caps_re)}) { od $var_prefix } + elsif (s{^\$([A-Za-z]\w+)}{}) { + $note_varref->($1,1); + od "\${${var_prefix}$1}"; } - elsif (m{^(?=$caps_re)}) { o $var_prefix } - elsif (m{^(?=$lc_re)}) { o $dir_prefix } - elsif (s{^_}{}) { o $var_prefix } - elsif (s{^/}{}) { o $dir_prefix } - elsif (s{^=_}{}) { o $var_prefix } - elsif (s{^=/}{}) { o $dir_name } - elsif (s{^\^}{}) { o "\$(top_srcdir)${dir_suffix}" } - elsif (s{^\}}{}) { o "\$(abs_top_srcdir)${dir_suffix}" } - elsif (s{^(?:[ \t]+([~^]))?(?=[ \t])}{}) { - my $prefix = - !$1 ? $dir_prefix : - $1 eq '~' ? '$(abs_top_srcdir)'.$dir_suffix : - $1 eq '~' ? '$(abs_top_srcdir)'.$dir_suffix : - die; + elsif (s{^([~^]?)(?=$lc_re)}{}) { od $pfxmap{$1} } + elsif (s{^_}{}) { od $var_prefix } + elsif (s{^=}{}) { od $var_prefix_name } + elsif (s{^([~^]?)/}{}) { od $pfxmap{$1} } + elsif (s{^\.}{}) { od $dir_name } + elsif (s{^([~^])\.}{}) { od $srcdirmap{$1} } + elsif (s{^\$\-}{}) { $ddbl=undef; } + elsif (s{^\$\+}{}) { $ddbl=1; } + 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=''; if (m{([ \t])$esc}) { ($_,$after) = ($`, $1.$'); } s{(?<=[ \t])(?=\S)(?!\\\s*$)}{$prefix}g; - o $_; + od $_; $_ = $after; } elsif (s{^\#}{}) { $_ = ''; } elsif (s{^![ \t]+}{}) { - o $_; + od $_; $_ = ''; - } elsif (s{^!(\S+)(?:[ \t]+|$)}{}) { - $$esclitr = $1; - $set_esc->(); } else { - die "bad escape $$esclitr$_ "; + m{^.{0,5}}; + err "bad &-escape \`$$esclitr$&'"; } } if (defined $buffering_output) { @@ -182,22 +399,24 @@ sub process_input_mk ($$$$$$$$) { $buffering_output=undef; if (m#^(-?)include\s+(\S+)\s+$#) { my $subf = "$srcdir/$2"; - process_input_mk($dir_prefix, $dir_suffix, $dir_name, - $var_prefix, $targets, - $subf, $esclitr, $1); - o "\n"; + process_input_mk($targets, $subf, $esclitr, $1); + od "\n"; + } elsif (m#^macro\s+(\S+)\s+$#) { + od "define $1\n"; + $push_nest->('macro', 1, '&:macro'); } else { - die "unknown directive $_ "; + err "bad directive argument syntax"; } } } + die "subdirmk: $f:$nest[0][3]: unclosed $nest[0][0] ($nest[0][2])\n" + if $nest[0][0]; $input->error and die "read $f: $!\n"; close $input or die "close $f: $!\n"; } -sub filter_subdir_mk ($$$$$) { - my ($dir_prefix, $dir_suffix, $dir_name, - $var_prefix, $targets) = @_; +sub filter_subdir_mk ($) { + my ($targets) = @_; #use Data::Dumper; #print STDERR "filter @_\n"; @@ -206,74 +425,141 @@ sub filter_subdir_mk ($$$$$) { my $pi = sub { my ($f, $enoentok) = @_; - process_input_mk($dir_prefix, $dir_suffix, $dir_name, - $var_prefix, $targets, - "${srcdir}/$f", \$esclit, $enoentok); + process_input_mk($targets, "${srcdir}/$f", \$esclit, $enoentok); }; - $pi->("${dir_prefix}Subdir.sd.mk", 0); - $pi->("Perdir.sd.mk", 1); + $pi->("Prefix.sd.mk", 1); + $pi->("${dir_prefix}Dir.sd.mk", 0); + $pi->("Suffix.sd.mk", 1); } sub process_subtree ($$); sub process_subtree ($$) { - # => list of descendants (in form SUBDIR/) + # => list of targets (in form SUBDIR/) # recursive, children first my ($node, $path) = @_; #use Data::Dumper; #print STDERR Dumper(\@_); - my $dir_prefix = join '', map { "$_/" } @$path; - my $dir_suffix = join '', map { "/$_" } @$path; - my $dir_name = join '/', @$path ? @$path : '.'; - my $var_prefix = join '', map { "${_}_" } @$path ? @$path : qw(TOP); + local %varref_exp; + + my $dir_prefix = dir_prefix($path); + # ^ this is the only var which we need before we come back from + # the recursion. + push @output_makefiles, "${dir_prefix}Dir.mk"; write_makefile($dir_prefix, scalar @$path); my %targets = (all => []); foreach my $child (@{ $node->[1] }) { my @childpath = (@$path, $child->[0]); my $child_subdir = join '/', @childpath; - mkdir $child_subdir or $!==EEXIST or die "mkdir $child_subdir: $!"; + 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); } - start_output_file("${dir_prefix}Subdir.mk.tmp"); - filter_subdir_mk($dir_prefix, $dir_suffix, $dir_name, - $var_prefix, \%targets); + set_dir_vars($path); + start_output_file("${dir_prefix}Dir.mk.tmp"); - o "\n"; + if ($node->[2]) { + filter_subdir_mk(\%targets); + } else { + 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)"; + } elsif ($!==ENOENT) { + } else { + die "stat $sdmk: $!\n"; + } + } + + oraw "\n"; 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) { + oraw ".PHONY:"; + oraw " ${dir_prefix}${_}" foreach @targets; + oraw "\n"; } return @targets; } +sub process_final ($) { + my ($otargets) = @_; + set_dir_vars([]); + push @output_makefiles, "Final.mk"; + start_output_file("Final.mk.tmp"); + my %ntargets; + my $esclit='&'; + process_input_mk(\%ntargets, "${srcdir}/Final.sd.mk", \$esclit, 1); + delete $ntargets{$_} foreach @$otargets; + my @ntargets = sort keys %ntargets; + die "subdirmk: Final.sd.mk may not introduce new top-level targets". + " (@ntargets)\n" if @ntargets; +} + sub process_tree() { - process_subtree($root, [ ]); + my @targets = process_subtree($root, [ ]); + process_final(\@targets); start_output_file("main.mk.tmp"); foreach my $v (qw(top_srcdir abs_top_srcdir)) { - o "$v=\@$v@\n"; + oraw "$v=\@$v@\n"; } - o "MAKEFILES += Subdir.mk\n"; - foreach my $subdir (@subdirs) { - o "MAKEFILES += $subdir/Subdir.mk\n"; + oraw "SUBDIRMK_MAKEFILES :=\n"; + oraw "MAKEFILE_TEMPLATES :=\n"; + foreach my $mf (@output_makefiles) { + oraw "SUBDIRMK_MAKEFILES += $mf\n"; } foreach my $input (sort keys %input_files) { - o "MAKEFILE_TEMPLATES += $input\n"; + oraw "MAKEFILE_TEMPLATES += $input\n"; + } + 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}; + wrncore 'local+global', "saw both $vn and &$vn" or return; + foreach my $exp ('', 1) { + foreach my $amp ('', 1) { + printf STDERR + ($exp + ? " expectedly saw %s%s at %s\n" + : " saw %s%s at %s\n"), + ($amp ? '&' : ''), $vn, $_ + 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'"; } - o "include \$(MAKEFILES)"; } build_tree(); process_tree(); +print_varref_warnings(); +print_warning_warnings(); install_output_files();