lib/Automake/Channels.pm

   1 # Copyright (C) 2002-2024 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2, or (at your option)
   6 # any later version.
   7
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 ##################################################################
  17 # The master copy of this file is in Automake's source repository.
  18 # Please send updates to automake-patches@gnu.org.
  19 ##################################################################
  20
  21 package Automake::Channels;
  22
  23 =head1 NAME
  24
  25 Automake::Channels - support functions for error and warning management
  26
  27 =head1 SYNOPSIS
  28
  29   use Automake::Channels;
  30
  31   # Register a channel to output warnings about unused variables.
  32   register_channel 'unused', type => 'warning';
  33
  34   # Register a channel for system errors.
  35   register_channel 'system', type => 'error', exit_code => 4;
  36
  37   # Output a message on channel 'unused'.
  38   msg 'unused', "$file:$line", "unused variable '$var'";
  39
  40   # Make the 'unused' channel silent.
  41   setup_channel 'unused', silent => 1;
  42
  43   # Turn on all channels of type 'warning'.
  44   setup_channel_type 'warning', silent => 0;
  45
  46   # Redirect all channels to push messages on a Thread::Queue using
  47   # the specified serialization key.
  48   setup_channel_queue $queue, $key;
  49
  50   # Output a message pending in a Thread::Queue.
  51   pop_channel_queue $queue;
  52
  53   # Treat all warnings as errors.
  54   $warnings_are_errors = 1;
  55
  56   # Exit with the greatest exit code encountered so far.
  57   exit $exit_code;
  58
  59 =head1 DESCRIPTION
  60
  61 This perl module provides support functions for handling diagnostic
  62 channels in programs.  Channels can be registered to convey fatal,
  63 error, warning, or debug messages.  Each channel has various options
  64 (e.g. is the channel silent, should duplicate messages be removed,
  65 etc.) that can also be overridden on a per-message basis.
  66
  67 =cut
  68
  69 use 5.006;
  70 use strict;
  71 use warnings FATAL => 'all';
  72
  73 use Carp;
  74 use Exporter;
  75 use File::Basename;
  76
  77 our @ISA = qw (Exporter);
  78 our @EXPORT = qw ($exit_code $warnings_are_errors
  79                   &reset_local_duplicates &reset_global_duplicates
  80                   &register_channel &msg &exists_channel &channel_type
  81                   &setup_channel &setup_channel_type
  82                   &dup_channel_setup &drop_channel_setup
  83                   &buffer_messages &flush_messages
  84                   &setup_channel_queue &pop_channel_queue
  85                   US_GLOBAL US_LOCAL
  86                   UP_NONE UP_TEXT UP_LOC_TEXT);
  87
  88 our %channels;
  89 our $me = basename $0;
  90
  91 =head2 Global Variables
  92
  93 =over 4
  94
  95 =item C<$exit_code>
  96
  97 The greatest exit code seen so far. C<$exit_code> is updated from
  98 the C<exit_code> options of C<fatal> and C<error> channels.
  99
 100 =cut
 101
 102 our $exit_code = 0;
 103
 104 =item C<$warnings_are_errors>
 105
 106 Set this variable to 1 if warning messages should be treated as
 107 errors (i.e. if they should update C<$exit_code>).
 108
 109 =cut
 110
 111 our $warnings_are_errors = 0;
 112
 113 =back
 114
 115 =head2 Constants
 116
 117 =over 4
 118
 119 =item C<UP_NONE>, C<UP_TEXT>, C<UP_LOC_TEXT>
 120
 121 Possible values for the C<uniq_part> options.  This selects the part
 122 of the message that should be considered when filtering out duplicates.
 123 If C<UP_LOC_TEXT> is used, the location and the explanation message
 124 are used for filtering.  If C<UP_TEXT> is used, only the explanation
 125 message is used (so the same message will be filtered out if it appears
 126 at different locations).  C<UP_NONE> means that duplicate messages
 127 should be output.
 128
 129 =cut
 130
 131 use constant UP_NONE => 0;
 132 use constant UP_TEXT => 1;
 133 use constant UP_LOC_TEXT => 2;
 134
 135 =item C<US_LOCAL>, C<US_GLOBAL>
 136
 137 Possible values for the C<uniq_scope> options.
 138 Use C<US_GLOBAL> for error messages that should be printed only
 139 once during the execution of the program, C<US_LOCAL> for message that
 140 should be printed only once per file.  (Actually, C<Channels> does not
 141 do this now when files are changed, it relies on you calling
 142 C<reset_local_duplicates> when this happens.)
 143
 144 =cut
 145
 146 # possible values for uniq_scope
 147 use constant US_LOCAL => 0;
 148 use constant US_GLOBAL => 1;
 149
 150 =back
 151
 152 =head2 Options
 153
 154 Channels accept the options described below.  These options can be
 155 passed as a hash to the C<register_channel>, C<setup_channel>, and C<msg>
 156 functions.  The possible keys, with their default value are:
 157
 158 =over
 159
 160 =item C<type =E<gt> 'warning'>
 161
 162 The type of the channel.  One of C<'debug'>, C<'warning'>, C<'error'>, or
 163 C<'fatal'>.  Fatal messages abort the program when they are output.
 164 Error messages update the exit status.  Debug and warning messages are
 165 harmless, except that warnings are treated as errors if
 166 C<$warnings_are_errors> is set.
 167
 168 =item C<exit_code =E<gt> 1>
 169
 170 The value to update C<$exit_code> with when a fatal or error message
 171 is emitted.  C<$exit_code> is also updated for warnings output
 172 when C<$warnings_are_errors> is set.
 173
 174 =item C<file =E<gt> \*STDERR>
 175
 176 The file where the error should be output.
 177
 178 =item C<silent =E<gt> 0>
 179
 180 Whether the channel should be silent.  Use this do disable a
 181 category of warning, for instance.
 182
 183 =item C<ordered =E<gt> 1>
 184
 185 Whether, with multi-threaded execution, the message should be queued
 186 for ordered output.
 187
 188 =item C<uniq_part =E<gt> UP_LOC_TEXT>
 189
 190 The part of the message subject to duplicate filtering.  See the
 191 documentation for the C<UP_NONE>, C<UP_TEXT>, and C<UP_LOC_TEXT>
 192 constants above.
 193
 194 C<uniq_part> can also be set to an arbitrary string that will be used
 195 instead of the message when considering duplicates.
 196
 197 =item C<uniq_scope =E<gt> US_LOCAL>
 198
 199 The scope of duplicate filtering.  See the documentation for the
 200 C<US_LOCAL>, and C<US_GLOBAL> constants above.
 201
 202 =item C<header =E<gt> ''>
 203
 204 A string to prepend to each message emitted through this channel.
 205 With partial messages, only the first part will have C<header>
 206 prepended.
 207
 208 =item C<footer =E<gt> ''>
 209
 210 A string to append to each message emitted through this channel.
 211 With partial messages, only the final part will have C<footer>
 212 appended.
 213
 214 =item C<backtrace =E<gt> 0>
 215
 216 Die with a stack backtrace after displaying the message.
 217
 218 =item C<partial =E<gt> 0>
 219
 220 When set, indicates a partial message that should
 221 be output along with the next message with C<partial> unset.
 222 Several partial messages can be stacked this way.
 223
 224 Duplicate filtering will apply to the I<global> message resulting from
 225 all I<partial> messages, using the options from the last (non-partial)
 226 message.  Linking associated messages is the main reason to use this
 227 option.
 228
 229 For instance the following messages
 230
 231   msg 'channel', 'foo:2', 'redefinition of A ...';
 232   msg 'channel', 'foo:1', '... A previously defined here';
 233   msg 'channel', 'foo:3', 'redefinition of A ...';
 234   msg 'channel', 'foo:1', '... A previously defined here';
 235
 236 will result in
 237
 238  foo:2: redefinition of A ...
 239  foo:1: ... A previously defined here
 240  foo:3: redefinition of A ...
 241
 242 where the duplicate "I<... A previously defined here>" has been
 243 filtered out.
 244
 245 Linking these messages using C<partial> as follows will prevent the
 246 fourth message to disappear.
 247
 248   msg 'channel', 'foo:2', 'redefinition of A ...', partial => 1;
 249   msg 'channel', 'foo:1', '... A previously defined here';
 250   msg 'channel', 'foo:3', 'redefinition of A ...', partial => 1;
 251   msg 'channel', 'foo:1', '... A previously defined here';
 252
 253 Note that because the stack of C<partial> messages is printed with the
 254 first non-C<partial> message, most options of C<partial> messages will
 255 be ignored.
 256
 257 =back
 258
 259 =cut
 260
 261 # Default options for a channel.
 262 our %_default_options =
 263   (
 264    type => 'warning',
 265    exit_code => 1,
 266    file => \*STDERR,
 267    silent => 0,
 268    ordered => 1,
 269    queue => 0,
 270    queue_key => undef,
 271    uniq_scope => US_LOCAL,
 272    uniq_part => UP_LOC_TEXT,
 273    header => '',
 274    footer => '',
 275    backtrace => 0,
 276    partial => 0,
 277    );
 278
 279 # Filled with output messages as keys, to detect duplicates.
 280 # The value associated with each key is the number of occurrences
 281 # filtered out.
 282 our %_local_duplicate_messages = ();
 283 our %_global_duplicate_messages = ();
 284
 285 sub _reset_duplicates (\%)
 286 {
 287   my ($ref) = @_;
 288   my $dup = 0;
 289   foreach my $k (keys %$ref)
 290     {
 291       $dup += $ref->{$k};
 292     }
 293   %$ref = ();
 294   return $dup;
 295 }
 296
 297
 298 =head2 Functions
 299
 300 =over 4
 301
 302 =item C<reset_local_duplicates ()>
 303
 304 Reset local duplicate messages (see C<US_LOCAL>), and
 305 return the number of messages that have been filtered out.
 306
 307 =cut
 308
 309 sub reset_local_duplicates ()
 310 {
 311   return _reset_duplicates %_local_duplicate_messages;
 312 }
 313
 314 =item C<reset_global_duplicates ()>
 315
 316 Reset local duplicate messages (see C<US_GLOBAL>), and
 317 return the number of messages that have been filtered out.
 318
 319 =cut
 320
 321 sub reset_global_duplicates ()
 322 {
 323   return _reset_duplicates %_global_duplicate_messages;
 324 }
 325
 326 sub _merge_options (\%%)
 327 {
 328   my ($hash, %options) = @_;
 329   local $_;
 330
 331   foreach (keys %options)
 332     {
 333       if (exists $hash->{$_})
 334         {
 335           $hash->{$_} = $options{$_}
 336         }
 337       else
 338         {
 339           confess "unknown option '$_'";
 340         }
 341     }
 342   if ($hash->{'ordered'})
 343     {
 344       confess "fatal messages cannot be ordered"
 345         if $hash->{'type'} eq 'fatal';
 346       confess "backtrace cannot be output on ordered messages"
 347         if $hash->{'backtrace'};
 348     }
 349 }
 350
 351 =item C<register_channel ($name, [%options])>
 352
 353 Declare channel C<$name>, and override the default options
 354 with those listed in C<%options>.
 355
 356 =cut
 357
 358 sub register_channel ($;%)
 359 {
 360   my ($name, %options) = @_;
 361   my %channel_opts = %_default_options;
 362   _merge_options %channel_opts, %options;
 363   $channels{$name} = \%channel_opts;
 364 }
 365
 366 =item C<exists_channel ($name)>
 367
 368 Returns true iff channel C<$name> has been registered.
 369
 370 =cut
 371
 372 sub exists_channel ($)
 373 {
 374   my ($name) = @_;
 375   return exists $channels{$name};
 376 }
 377
 378 =item C<channel_type ($name)>
 379
 380 Returns the type of channel C<$name> if it has been registered.
 381 Returns the empty string otherwise.
 382
 383 =cut
 384
 385 sub channel_type ($)
 386 {
 387   my ($name) = @_;
 388   return $channels{$name}{'type'} if exists_channel $name;
 389   return '';
 390 }
 391
 392 # _format_sub_message ($LEADER, $MESSAGE)
 393 # ---------------------------------------
 394 # Split $MESSAGE at new lines and add $LEADER to each line.
 395 sub _format_sub_message ($$)
 396 {
 397   my ($leader, $message) = @_;
 398   return $leader . join ("\n" . $leader, split ("\n", $message)) . "\n";
 399 }
 400
 401 # Store partial messages here. (See the 'partial' option.)
 402 our $partial = '';
 403
 404 # _format_message ($LOCATION, $MESSAGE, %OPTIONS)
 405 # -----------------------------------------------
 406 # Format the message.  Return a string ready to print.
 407 sub _format_message ($$%)
 408 {
 409   my ($location, $message, %opts) = @_;
 410   my $msg = ($partial eq '' ? $opts{'header'} : '') . $message
 411             . ($opts{'partial'} ? '' : $opts{'footer'});
 412   if (ref $location)
 413     {
 414       # If $LOCATION is a reference, assume it's an instance of the
 415       # Automake::Location class and display contexts.
 416       my $loc = $location->get || $me;
 417       $msg = _format_sub_message ("$loc: ", $msg);
 418       for my $pair ($location->get_contexts)
 419         {
 420           $msg .= _format_sub_message ($pair->[0] . ":   ", $pair->[1]);
 421         }
 422     }
 423   else
 424     {
 425       $location ||= $me;
 426       $msg = _format_sub_message ("$location: ", $msg);
 427     }
 428   return $msg;
 429 }
 430
 431 # _enqueue ($QUEUE, $KEY, $UNIQ_SCOPE, $TO_FILTER, $MSG, $FILE)
 432 # -------------------------------------------------------------
 433 # Push message on a queue, to be processed by another thread.
 434 sub _enqueue ($$$$$$)
 435 {
 436   my ($queue, $key, $uniq_scope, $to_filter, $msg, $file) = @_;
 437   $queue->enqueue ($key, $msg, $to_filter, $uniq_scope);
 438   confess "message queuing works only for STDERR"
 439     if $file ne \*STDERR;
 440 }
 441
 442 # _dequeue ($QUEUE)
 443 # -----------------
 444 # Pop a message from a queue, and print, similarly to how
 445 # _print_message would do it.  Return 0 if the queue is
 446 # empty.  Note that the key has already been dequeued.
 447 sub _dequeue ($)
 448 {
 449   my ($queue) = @_;
 450   my $msg = $queue->dequeue || return 0;
 451   my $to_filter = $queue->dequeue;
 452   my $uniq_scope = $queue->dequeue;
 453   my $file = \*STDERR;
 454
 455   if ($to_filter ne '')
 456     {
 457       # Do we want local or global uniqueness?
 458       my $dups;
 459       if ($uniq_scope == US_LOCAL)
 460         {
 461           $dups = \%_local_duplicate_messages;
 462         }
 463       elsif ($uniq_scope == US_GLOBAL)
 464         {
 465           $dups = \%_global_duplicate_messages;
 466         }
 467       else
 468         {
 469           confess "unknown value for uniq_scope: " . $uniq_scope;
 470         }
 471
 472       # Update the hash of messages.
 473       if (exists $dups->{$to_filter})
 474         {
 475           ++$dups->{$to_filter};
 476           return 1;
 477         }
 478       else
 479         {
 480           $dups->{$to_filter} = 0;
 481         }
 482     }
 483   print $file $msg;
 484   return 1;
 485 }
 486
 487
 488 # _print_message ($LOCATION, $MESSAGE, %OPTIONS)
 489 # ----------------------------------------------
 490 # Format the message, check duplicates, and print it.
 491 sub _print_message ($$%)
 492 {
 493   my ($location, $message, %opts) = @_;
 494
 495   return 0 if ($opts{'silent'});
 496
 497   my $msg = _format_message ($location, $message, %opts);
 498   if ($opts{'partial'})
 499     {
 500       # Incomplete message.  Store, don't print.
 501       $partial .= $msg;
 502       return;
 503     }
 504   else
 505     {
 506       # Prefix with any partial message send so far.
 507       $msg = $partial . $msg;
 508       $partial = '';
 509     }
 510
 511   msg ('note', '', 'warnings are treated as errors', uniq_scope => US_GLOBAL)
 512     if ($opts{'type'} eq 'warning' && $warnings_are_errors);
 513
 514   # Check for duplicate message if requested.
 515   my $to_filter;
 516   if ($opts{'uniq_part'} ne UP_NONE)
 517     {
 518       # Which part of the error should we match?
 519       if ($opts{'uniq_part'} eq UP_TEXT)
 520         {
 521           $to_filter = $message;
 522         }
 523       elsif ($opts{'uniq_part'} eq UP_LOC_TEXT)
 524         {
 525           $to_filter = $msg;
 526         }
 527       else
 528         {
 529           $to_filter = $opts{'uniq_part'};
 530         }
 531
 532       # Do we want local or global uniqueness?
 533       my $dups;
 534       if ($opts{'uniq_scope'} == US_LOCAL)
 535         {
 536           $dups = \%_local_duplicate_messages;
 537         }
 538       elsif ($opts{'uniq_scope'} == US_GLOBAL)
 539         {
 540           $dups = \%_global_duplicate_messages;
 541         }
 542       else
 543         {
 544           confess "unknown value for uniq_scope: " . $opts{'uniq_scope'};
 545         }
 546
 547       # Update the hash of messages.
 548       if (exists $dups->{$to_filter})
 549         {
 550           ++$dups->{$to_filter};
 551           return 0;
 552         }
 553       else
 554         {
 555           $dups->{$to_filter} = 0;
 556         }
 557     }
 558   my $file = $opts{'file'};
 559   if ($opts{'ordered'} && $opts{'queue'})
 560     {
 561       _enqueue ($opts{'queue'}, $opts{'queue_key'}, $opts{'uniq_scope'},
 562                 $to_filter, $msg, $file);
 563     }
 564   else
 565     {
 566       print $file $msg;
 567     }
 568   return 1;
 569 }
 570
 571 =item C<msg ($channel, $location, $message, [%options])>
 572
 573 Emit a message on C<$channel>, overriding some options of the channel with
 574 those specified in C<%options>.  Obviously C<$channel> must have been
 575 registered with C<register_channel>.
 576
 577 C<$message> is the text of the message, and C<$location> is a location
 578 associated to the message.
 579
 580 For instance to complain about some unused variable C<mumble>
 581 declared at line 10 in F<foo.c>, one could do:
 582
 583   msg 'unused', 'foo.c:10', "unused variable 'mumble'";
 584
 585 If channel C<unused> is not silent (and if this message is not a duplicate),
 586 the following would be output:
 587
 588   foo.c:10: unused variable 'mumble'
 589
 590 C<$location> can also be an instance of C<Automake::Location>.  In this
 591 case, the stack of contexts will be displayed in addition.
 592
 593 If C<$message> contains newline characters, C<$location> is prepended
 594 to each line.  For instance,
 595
 596   msg 'error', 'somewhere', "1st line\n2nd line";
 597
 598 becomes
 599
 600   somewhere: 1st line
 601   somewhere: 2nd line
 602
 603 If C<$location> is an empty string, it is replaced by the name of the
 604 program.  Actually, if you don't use C<%options>, you can even
 605 elide the empty C<$location>.  Thus
 606
 607   msg 'fatal', '', 'fatal error';
 608   msg 'fatal', 'fatal error';
 609
 610 both print
 611
 612   progname: fatal error
 613
 614 =cut
 615
 616
 617 # See buffer_messages() and flush_messages() below.
 618 our %buffering = ();    # The map of channel types to buffer.
 619 our @backlog = ();              # The buffer of messages.
 620
 621 sub msg ($$;$%)
 622 {
 623   my ($channel, $location, $message, %options) = @_;
 624
 625   if (! defined $message)
 626     {
 627       $message = $location;
 628       $location = '';
 629     }
 630
 631   if (!exists $channels{$channel})
 632     {
 633       # This can happen as a result of e.g. m4_warn([nonsense], [message])
 634       # so it should not crash.
 635       report_bad_channel($channel, $location);
 636       $channel = 'syntax';
 637     }
 638
 639   my %opts = %{$channels{$channel}};
 640   _merge_options (%opts, %options);
 641
 642   if (exists $buffering{$opts{'type'}})
 643     {
 644       push @backlog, [$channel, $location->clone, $message, %options];
 645       return;
 646     }
 647
 648   # Print the message if needed.
 649   if (_print_message ($location, $message, %opts))
 650     {
 651       # Adjust exit status.
 652       if ($opts{'type'} eq 'error'
 653           || $opts{'type'} eq 'fatal'
 654           || ($opts{'type'} eq 'warning' && $warnings_are_errors))
 655         {
 656           my $es = $opts{'exit_code'};
 657           $exit_code = $es if $es > $exit_code;
 658         }
 659
 660       # Die on fatal messages.
 661       confess if $opts{'backtrace'};
 662       if ($opts{'type'} eq 'fatal')
 663         {
 664           # flush messages explicitly here, needed in worker threads.
 665           STDERR->flush;
 666           exit $exit_code;
 667         }
 668     }
 669 }
 670
 671 sub report_bad_channel ($$)
 672 {
 673   my ($channel, $location) = @_;
 674   my $message;
 675   my $report_as = 'error';
 676
 677   # quotemeta is both too aggressive (e.g. it escapes '-') and
 678   # too generous (it turns control characters into \ + themselves,
 679   # not into symbolic escapes).
 680   my $q_channel = $channel;
 681   $q_channel =~ s/(?=[\"\$\'\@\`\\])/\\/g;
 682   $q_channel =~ s/([^\x20-\x7e])/sprintf('\\x%02X', ord $1)/eg;
 683   $q_channel = '"' . $q_channel . '"';
 684
 685   if ($channel eq '' || $channel eq 'all')
 686     {
 687       # Prior to version 2.70, the Autoconf manual said it was valid to use
 688       # "all" and the empty string as the category argument to m4_warn, so
 689       # don't treat those cases as errors.
 690       $report_as = 'obsolete';
 691       $message = "use of $q_channel as a diagnostic category is obsolete\n";
 692       $message .= "(see automake --help for a list of valid categories)";
 693     }
 694   elsif ($channel eq 'none'
 695          || ($channel =~ /^no-/ && exists $channels{substr($channel, 3)}))
 696     {
 697       # Also recognize "none" and "no-[category]", as someone might have
 698       # thought anything acceptable to -W is also acceptable to m4_warn.
 699       # Note: m4_warn([error], [...]) does actually issue an error.
 700       $message = "-W accepts $q_channel, but it is not a diagnostic category";
 701     }
 702   else
 703     {
 704       $message = "unknown diagnostic category " . $q_channel;
 705     }
 706
 707   msg $report_as, $location, $message;
 708 }
 709
 710
 711 =item C<setup_channel ($channel, %options)>
 712
 713 Override the options of C<$channel> with those specified by C<%options>.
 714
 715 =cut
 716
 717 sub setup_channel ($%)
 718 {
 719   my ($name, %opts) = @_;
 720   confess "unknown channel $name" unless exists $channels{$name};
 721   _merge_options %{$channels{$name}}, %opts;
 722 }
 723
 724 =item C<setup_channel_type ($type, %options)>
 725
 726 Override the options of any channel of type C<$type>
 727 with those specified by C<%options>.
 728
 729 =cut
 730
 731 sub setup_channel_type ($%)
 732 {
 733   my ($type, %opts) = @_;
 734   foreach my $channel (keys %channels)
 735     {
 736       setup_channel $channel, %opts
 737         if $channels{$channel}{'type'} eq $type;
 738     }
 739 }
 740
 741 =item C<dup_channel_setup ()>, C<drop_channel_setup ()>
 742
 743 Sometimes it is necessary to make temporary modifications to channels.
 744 For instance one may want to disable a warning while processing a
 745 particular file, and then restore the initial setup.  These two
 746 functions make it easy: C<dup_channel_setup ()> saves a copy of the
 747 current configuration for later restoration by
 748 C<drop_channel_setup ()>.
 749
 750 You can think of this as a stack of configurations whose first entry
 751 is the active one.  C<dup_channel_setup ()> duplicates the first
 752 entry, while C<drop_channel_setup ()> just deletes it.
 753
 754 =cut
 755
 756 our @_saved_channels = ();
 757 our @_saved_werrors = ();
 758
 759 sub dup_channel_setup ()
 760 {
 761   my %channels_copy;
 762   foreach my $k1 (keys %channels)
 763     {
 764       $channels_copy{$k1} = {%{$channels{$k1}}};
 765     }
 766   push @_saved_channels, \%channels_copy;
 767   push @_saved_werrors, $warnings_are_errors;
 768 }
 769
 770 sub drop_channel_setup ()
 771 {
 772   my $saved = pop @_saved_channels;
 773   %channels = %$saved;
 774   $warnings_are_errors = pop @_saved_werrors;
 775 }
 776
 777 =item C<buffer_messages (@types)>, C<flush_messages ()>
 778
 779 By default, when C<msg> is called, messages are processed immediately.
 780
 781 Sometimes it is necessary to delay the output of messages.
 782 For instance you might want to make diagnostics before
 783 channels have been completely configured.
 784
 785 After C<buffer_messages(@types)> has been called, messages sent with
 786 C<msg> to a channel whose type is listed in C<@types> will be stored in a
 787 list for later processing.
 788
 789 This backlog of messages is processed when C<flush_messages> is
 790 called, with the current channel options (not the options in effect,
 791 at the time of C<msg>).  So for instance, if some channel was silenced
 792 in the meantime, messages to this channel will not be printed.
 793
 794 C<flush_messages> cancels the effect of C<buffer_messages>.  Following
 795 calls to C<msg> are processed immediately as usual.
 796
 797 =cut
 798
 799 sub buffer_messages (@)
 800 {
 801   foreach my $type (@_)
 802     {
 803       $buffering{$type} = 1;
 804     }
 805 }
 806
 807 sub flush_messages ()
 808 {
 809   %buffering = ();
 810   foreach my $args (@backlog)
 811     {
 812       &msg (@$args);
 813     }
 814   @backlog = ();
 815 }
 816
 817 =item C<setup_channel_queue ($queue, $key)>
 818
 819 Set the queue to fill for each channel that is ordered,
 820 and the key to use for serialization.
 821
 822 =cut
 823 sub setup_channel_queue ($$)
 824 {
 825   my ($queue, $key) = @_;
 826   foreach my $channel (keys %channels)
 827     {
 828       setup_channel $channel, queue => $queue, queue_key => $key
 829         if $channels{$channel}{'ordered'};
 830     }
 831 }
 832
 833 =item C<pop_channel_queue ($queue)>
 834
 835 pop a message off the $queue; the key has already been popped.
 836
 837 =cut
 838 sub pop_channel_queue ($)
 839 {
 840   my ($queue) = @_;
 841   return _dequeue ($queue);
 842 }
 843
 844 =back
 845
 846 =head1 SEE ALSO
 847
 848 L<Automake::Location>
 849
 850 =head1 HISTORY
 851
 852 Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>.
 853
 854 =cut
 855
 856 1;