chiark / gitweb /
syntax: Support &: literal (for make `grouped' multiple targets)
[subdirmk.git] / generate
index cbc91721473a7bc4de563ea0f6842d3e25aec0b5..b65ba1de66ce0883a63f33dffe6548b88d37921e 100755 (executable)
--- 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,21 +283,44 @@ 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';
-           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 '{') {
                od $2;
@@ -283,13 +332,33 @@ sub process_input_mk ($$$$) {
                $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{^:}{}) { 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+)}{}) { 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 }
@@ -298,13 +367,19 @@ sub process_input_mk ($$$$) {
            elsif (s{^([~^])\.}{}) { od $srcdirmap{$1} }
            elsif (s{^\$\-}{}) { $ddbl=undef; }
            elsif (s{^\$\+}{}) { $ddbl=1; }
-           elsif (s{^\$\(}{}) { ddbl_only($&); oud "\$("; }
-           elsif (s{^\$(\d+)}{}) { ddbl_only($&); oud "\$($1)"; }
-           elsif (s{^\$\{}{}) {
+           elsif (s{^\$\(}{}) {
+               ddbl_only($&); oud "\$(";
+               $note_varref->($2,!!$1) if m{^($esc)?([^()\$]+\))};
+           }
+           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?)";
                my $after='';
@@ -369,6 +444,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.
@@ -381,6 +458,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);
     }
@@ -453,20 +531,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();