# 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;
&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);
Whether the channel should be silent. Use this do disable a
category of warning, for instance.
+=item C<ordered =E<gt> 1>
+
+Whether, with multi-threaded execution, the message should be queued
+for ordered output.
+
=item C<uniq_part =E<gt> UP_LOC_TEXT>
The part of the message subject to duplicate filtering. See the
exit_code => 1,
file => \*STDERR,
silent => 0,
+ ordered => 1,
+ queue => 0,
+ queue_key => undef,
uniq_scope => US_LOCAL,
uniq_part => UP_LOC_TEXT,
header => '',
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<register_channel ($name, [%options])>
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 = '';
}
# 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;
}
}
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;
}
=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.
# 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;
+ }
}
}
@backlog = ();
}
+=item C<setup_channel_queue ($queue, $key)>
+
+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_channel_queue ($queue)>
+
+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
-# 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
=head1 DESCRIPTION
C<Autom4te::XFile> inherits from C<IO::File>. It provides the method
-C<name> returning the file name. It provides dying version of the
+C<name> returning the file name. It provides dying versions of the
methods C<close>, C<lock> (corresponding to C<flock>), C<new>,
C<open>, C<seek>, and C<truncate>. It also overrides the C<getline>
and C<getlines> methods to translate C<\r\n> to C<\n>.
# 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;
projects / thirdparty / autoconf.git / commitdiff
