X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ian/git?p=subdirmk.git;a=blobdiff_plain;f=generate;h=2a65d991ceb466d193002138abfab1f573d0f4b2;hp=c608e8c6947366711f0c79f345cdbadbae01c0a4;hb=4110b41e20eb2c12fe68cdcb994ee47e7e25ec18;hpb=c5f8817d9d03784e0da59d7957ec49d3dbd8ea48 diff --git a/generate b/generate index c608e8c..2a65d99 100755 --- a/generate +++ b/generate @@ -19,6 +19,22 @@ 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 "$0: $file:$lno: problem\n"; +# die "$0: some problem not locatable in that way\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 '--'; @@ -70,11 +86,11 @@ sub close_any_output_file() { } sub oraw { - die unless defined $writing_output; + die 'internal error' unless defined $writing_output; print O @_ or die "error writing $writing_output.tmp: $!\n"; } -sub od { # maybe $-doubled +sub oud { # undoubled if (defined $buffering_output) { $buffering_output .= $_ foreach @_; return; @@ -82,10 +98,25 @@ sub od { # maybe $-doubled 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"; oraw "# autogenerated - do not edit\n"; @@ -135,6 +166,19 @@ sub set_dir_vars ($) { $var_prefix = "${var_prefix_name}_"; } +our $err_file; + +sub err ($) { + my ($m) = @_; + die "$0: ${err_file}:$.: $m\n"; +} + +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) = @_; @@ -151,11 +195,13 @@ 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)", @@ -165,25 +211,57 @@ sub process_input_mk ($$$$) { ); $pfxmap{$_} = $srcdirmap{$_}.'/' foreach keys %srcdirmap; + local $ddbl; + my @nest = (['']); + + my $push_nest = sub { + my ($nk, $nndbl) = @_; + unshift @nest, [ $nk, $ddbl ]; + $ddbl = $nndbl; + }; + my $pop_nest = sub { + my ($nk) = @_; + die unless $nest[0][0] eq $nk; + # ^ xxx need better message + $ddbl = (shift @nest)[1]; + }; + while (<$input>) { if (s#^\s*$esc\:changequote\s+(\S+)\s+$##) { $$esclitr = $1; $set_esc->(); next; - } elsif (s#^\s*$esc\:(?=(-?)include)##) { + } elsif (s#^\s*$esc\:endm\s+$##) { + $pop_nest->('Macro'); + od "endef\n"; + next; + } elsif (s#^\s*$esc\:(?=(-?)include|macro)##) { $buffering_output=''; } elsif (m#^\s*$esc\:([a-z][-0-9a-z_]*)#) { - die "unknown directive $1"; + err "unknown directive &:$1"; } elsif (s{^\s*${esc}TARGETS(?:_([0-9a-zA-Z_]+))?(?=\W)}{}) { my $t = $1 // 'all'; od target_varname($var_prefix, $t); $targets->{$t} //= [ ]; } for (;;) { - unless (s{^(.*?)$esc}{}) { od $_; last; } + 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 '{') { + $ddbl++; + next; + } elsif ($2 eq '}') { + next if --$ddbl; + $pop_nest->('Eval'); + od '}}'; + next; + } if (s{^\\$esc}{}) { od "$$esclitr" } - elsif (s{^\\\$}{}) { od '$' } + elsif (s{^\\\$}{}) { oud '$' } elsif (s{^\\\s+$}{}) { } elsif (s{^$esc}{}) { od "$$esclitr$$esclitr" } elsif (m{^(?=$caps_re)}) { od $var_prefix } @@ -194,8 +272,16 @@ sub process_input_mk ($$$$) { elsif (s{^([~^]?)/}{}) { od $pfxmap{$1} } elsif (s{^\.}{}) { od $dir_name } elsif (s{^([~^])\.}{}) { od $srcdirmap{$1} } - elsif (s{^([~^]?)(?=[ \t])}{}) { - my $prefix = $pfxmap{$1} // die; + elsif (s{^\$\-}{}) { $ddbl=undef; } + elsif (s{^\$\+}{}) { $ddbl=1; } + elsif (s{^\$\(}{}) { ddbl_only($&); oud "\$("; } + elsif (s{^\$(\d+)}{}) { ddbl_only($&); oud "\$($1)"; } + elsif (s{^\$\{}{}) { + err 'macro invocation cannot be re-$-doubled' if $ddbl; + od '${eval ${call '; + $push_nest->('Eval',1); + } 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; @@ -207,7 +293,7 @@ sub process_input_mk ($$$$) { od $_; $_ = ''; } else { - die "bad escape $$esclitr$_ "; + err "bad &-escape \`$$esclitr$_'"; } } if (defined $buffering_output) { @@ -217,11 +303,15 @@ sub process_input_mk ($$$$) { my $subf = "$srcdir/$2"; process_input_mk($targets, $subf, $esclitr, $1); od "\n"; + } elsif (m#^macro\s+(\S+)\s+$#) { + od "define $1\n"; + $push_nest->('Macro', 1); } else { - die "internal error buffering directive $_ "; + die "internal error ($_?)"; } } } + die "unclosed $nest[0][0]" if $nest[0][0]; $input->error and die "read $f: $!\n"; close $input or die "close $f: $!\n"; } @@ -263,7 +353,7 @@ sub process_subtree ($$) { 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"; push @{ $targets{$_} }, $child_subdir foreach process_subtree($child, \@childpath); } @@ -276,10 +366,11 @@ sub process_subtree ($$) { } else { my $sdmk = "${dir_prefix}Subdir.sd.mk"; if (stat $sdmk) { - die "$sdmk unexpectedly exists (${dir_prefix} not mentioned)"; + die + "$0: $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: $!"; + die "stat $sdmk: $!\n"; } } @@ -313,7 +404,8 @@ sub process_final ($) { process_input_mk(\%ntargets, "${srcdir}/Final.sd.mk", \$esclit, 1); delete $ntargets{$_} foreach @$otargets; my @ntargets = sort keys %ntargets; - die "late new targets @ntargets" if @ntargets; + die "$0: Final.sd.mk may not introduce new top-level targets". + " (@ntargets)\n" if @ntargets; } sub process_tree() {