From: Ralf Wildenhues Date: Sun, 19 Apr 2009 10:54:31 +0000 (+0200) Subject: Sync autom4te perl modules from Automake. X-Git-Tag: v2.64~74 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=e430ff0ca663b6ebbd9dafa8909ff07cc0273135;p=thirdparty%2Fautoconf.git Sync autom4te perl modules from Automake. * lib/Autom4te/Channels.pm: Sync from Automake. * lib/Autom4te/FileUtils.pm: Likewise. * lib/Autom4te/XFile.pm: Likewise. Signed-off-by: Ralf Wildenhues --- diff --git a/ChangeLog b/ChangeLog index 8829cd187..cfda3aa14 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,10 @@ 2009-04-19 Ralf Wildenhues + Sync autom4te perl modules from Automake. + * lib/Autom4te/Channels.pm: Sync from Automake. + * lib/Autom4te/FileUtils.pm: Likewise. + * lib/Autom4te/XFile.pm: Likewise. + Adjust channel definitions for new Automake `ordered' flag. * lib/Autom4te/ChannelDefs.pm (Autom4te::ChannelDefs): Set `ordered' flag to zero for channels `fatal', `automake', and diff --git a/lib/Autom4te/Channels.pm b/lib/Autom4te/Channels.pm index 7813cbc47..1309d204a 100644 --- a/lib/Autom4te/Channels.pm +++ b/lib/Autom4te/Channels.pm @@ -45,6 +45,13 @@ Autom4te::Channels - support functions for error and warning management # Turn on all channels of type 'warning'. setup_channel_type 'warning', silent => 0; + # Redirect all channels to push messages on a Thread::Queue using + # the specified serialization key. + setup_channel_queue $queue, $key; + + # Output a message pending in a Thread::Queue. + pop_channel_queue $queue; + # Treat all warnings as errors. $warnings_are_errors = 1; @@ -76,6 +83,7 @@ use vars qw (@ISA @EXPORT %channels $me); &setup_channel &setup_channel_type &dup_channel_setup &drop_channel_setup &buffer_messages &flush_messages + &setup_channel_queue &pop_channel_queue US_GLOBAL US_LOCAL UP_NONE UP_TEXT UP_LOC_TEXT); @@ -175,6 +183,11 @@ The file where the error should be output. Whether the channel should be silent. Use this do disable a category of warning, for instance. +=item C 1> + +Whether, with multi-threaded execution, the message should be queued +for ordered output. + =item C UP_LOC_TEXT> The part of the message subject to duplicate filtering. See the @@ -254,6 +267,9 @@ use vars qw (%_default_options %_global_duplicate_messages exit_code => 1, file => \*STDERR, silent => 0, + ordered => 1, + queue => 0, + queue_key => undef, uniq_scope => US_LOCAL, uniq_part => UP_LOC_TEXT, header => '', @@ -325,6 +341,13 @@ sub _merge_options (\%%) confess "unknown option `$_'"; } } + if ($hash->{'ordered'}) + { + confess "fatal messages cannot be ordered" + if $hash->{'type'} eq 'fatal'; + confess "backtrace cannot be output on ordered messages" + if $hash->{'backtrace'}; + } } =item C @@ -405,6 +428,63 @@ sub _format_message ($$%) return $msg; } +# _enqueue ($QUEUE, $KEY, $UNIQ_SCOPE, $TO_FILTER, $MSG, $FILE) +# ------------------------------------------------------------ +# Push message on a queue, to be processed by another thread. +sub _enqueue ($$$$$$) +{ + my ($queue, $key, $uniq_scope, $to_filter, $msg, $file) = @_; + $queue->enqueue ($key, $msg, $to_filter, $uniq_scope); + confess "message queuing works only for STDERR" + if $file ne \*STDERR; +} + +# _dequeue ($QUEUE) +# ----------------- +# Pop a message from a queue, and print, similarly to how +# _print_message would do it. Return 0 if the queue is +# empty. Note that the key has already been dequeued. +sub _dequeue ($) +{ + my ($queue) = @_; + my $msg = $queue->dequeue || return 0; + my $to_filter = $queue->dequeue; + my $uniq_scope = $queue->dequeue; + my $file = \*STDERR; + + if ($to_filter ne '') + { + # Do we want local or global uniqueness? + my $dups; + if ($uniq_scope == US_LOCAL) + { + $dups = \%_local_duplicate_messages; + } + elsif ($uniq_scope == US_GLOBAL) + { + $dups = \%_global_duplicate_messages; + } + else + { + confess "unknown value for uniq_scope: " . $uniq_scope; + } + + # Update the hash of messages. + if (exists $dups->{$to_filter}) + { + ++$dups->{$to_filter}; + return 1; + } + else + { + $dups->{$to_filter} = 0; + } + } + print $file $msg; + return 1; +} + + # Store partial messages here. (See the 'partial' option.) use vars qw ($partial); $partial = ''; @@ -433,10 +513,10 @@ sub _print_message ($$%) } # Check for duplicate message if requested. + my $to_filter; if ($opts{'uniq_part'} ne UP_NONE) { # Which part of the error should we match? - my $to_filter; if ($opts{'uniq_part'} eq UP_TEXT) { $to_filter = $message; @@ -477,7 +557,15 @@ sub _print_message ($$%) } } my $file = $opts{'file'}; - print $file $msg; + if ($opts{'ordered'} && $opts{'queue'}) + { + _enqueue ($opts{'queue'}, $opts{'queue_key'}, $opts{'uniq_scope'}, + $to_filter, $msg, $file); + } + else + { + print $file $msg; + } return 1; } @@ -527,7 +615,7 @@ both print =cut -use vars qw (@backlog %buffering @chain); +use vars qw (@backlog %buffering); # See buffer_messages() and flush_messages() below. %buffering = (); # The map of channel types to buffer. @@ -568,7 +656,12 @@ sub msg ($$;$%) # Die on fatal messages. confess if $opts{'backtrace'}; - exit $exit_code if $opts{'type'} eq 'fatal'; + if ($opts{'type'} eq 'fatal') + { + # flush messages explicitly here, needed in worker threads. + STDERR->flush; + exit $exit_code; + } } } @@ -677,6 +770,33 @@ sub flush_messages () @backlog = (); } +=item C + +Set the queue to fill for each channel that is ordered, +and the key to use for serialization. + +=cut +sub setup_channel_queue ($$) +{ + my ($queue, $key) = @_; + foreach my $channel (keys %channels) + { + setup_channel $channel, queue => $queue, queue_key => $key + if $channels{$channel}{'ordered'}; + } +} + +=item C + +pop a message off the $queue; the key has already been popped. + +=cut +sub pop_channel_queue ($) +{ + my ($queue) = @_; + return _dequeue ($queue); +} + =back =head1 SEE ALSO diff --git a/lib/Autom4te/FileUtils.pm b/lib/Autom4te/FileUtils.pm index 2e2a3a42d..63df0d494 100644 --- a/lib/Autom4te/FileUtils.pm +++ b/lib/Autom4te/FileUtils.pm @@ -50,7 +50,9 @@ use vars qw (@ISA @EXPORT); @EXPORT = qw (&open_quote &contents &find_file &mtime &update_file &up_to_date_p - &xsystem &xsystem_hint &xqx &dir_has_case_matching_file &reset_dir_cache); + &xsystem &xsystem_hint &xqx + &dir_has_case_matching_file &reset_dir_cache + &set_dir_cache_file); =item C @@ -419,6 +421,19 @@ sub reset_dir_cache ($) delete $_directory_cache{$_[0]}; } +=item C + +State that C<$dirname> contains C<$file_name> now. + +=cut + +sub set_dir_cache_file ($$) +{ + my ($dirname, $file_name) = @_; + $_directory_cache{$dirname}{$file_name} = 1 + if exists $_directory_cache{$dirname}; +} + 1; # for require ### Setup "GNU" style for perl-mode and cperl-mode. diff --git a/lib/Autom4te/XFile.pm b/lib/Autom4te/XFile.pm index b333148a2..c19193140 100644 --- a/lib/Autom4te/XFile.pm +++ b/lib/Autom4te/XFile.pm @@ -1,4 +1,4 @@ -# Copyright (C) 2001, 2003, 2004, 2006, 2008 Free Software Foundation, +# Copyright (C) 2001, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, # Inc. # This program is free software: you can redistribute it and/or modify @@ -65,7 +65,7 @@ Autom4te::XFile - supply object methods for filehandles with error handling =head1 DESCRIPTION C inherits from C. It provides the method -C returning the file name. It provides dying version of the +C returning the file name. It provides dying versions of the methods C, C (corresponding to C), C, C, C, and C. It also overrides the C and C methods to translate C<\r\n> to C<\n>. @@ -224,16 +224,18 @@ sub lock # first of flock(2), fcntl(2), or lockf(3) that works. These can fail on # NFS-backed files, with ENOLCK (GNU/Linux) or EOPNOTSUPP (FreeBSD); we # usually ignore these errors. If $ENV{MAKEFLAGS} suggests that a parallel - # invocation of GNU `make' has invoked the tool we serve, report all locking + # invocation of `make' has invoked the tool we serve, report all locking # failures and abort. # # On Unicos, flock(2) and fcntl(2) over NFS hang indefinitely when `lockd' is # not running. NetBSD NFS clients silently grant all locks. We do not # attempt to defend against these dangers. + # + # -j is for parallel BSD make, -P is for parallel HP-UX make. if (!flock ($fh, $mode)) { my $make_j = (exists $ENV{'MAKEFLAGS'} - && " -$ENV{'MAKEFLAGS'}" =~ / (-[BdeikrRsSw]*j|---?jobs)/); + && " -$ENV{'MAKEFLAGS'}" =~ / (-[BdeikrRsSw]*[jP]|--[jP]|---?jobs)/); my $note = "\nforgo `make -j' or use a file system that supports locks"; my $file = $fh->name;