autoconf-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

FYI: Download files from CVS Automake


From: Akim Demaille
Subject: FYI: Download files from CVS Automake
Date: Wed, 20 Aug 2003 09:48:25 +0200
User-agent: Gnus/5.1002 (Gnus v5.10.2) Emacs/21.3 (gnu/linux)

Index: ChangeLog
from  Akim Demaille  <address@hidden>

        * lib/Autom4te/Channels.pm, lib/Autom4te/ChannelDefs.pm
        * lib/Autom4te/Configure_ac.pm, lib/Autom4te/FileUtils.pm: New,
        from CVS Automake.

Index: lib/Autom4te/ChannelDefs.pm
===================================================================
RCS file: lib/Autom4te/ChannelDefs.pm
diff -N lib/Autom4te/ChannelDefs.pm
--- lib/Autom4te/ChannelDefs.pm 1 Jan 1970 00:00:00 -0000
+++ lib/Autom4te/ChannelDefs.pm 20 Aug 2003 06:50:20 -0000
@@ -0,0 +1,401 @@
+# Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+package Autom4te::ChannelDefs;
+
+use Autom4te::Channels;
+
+=head1 NAME
+
+Autom4te::ChannelDefs - channel definitions for Automake and helper functions
+
+=head1 SYNOPSIS
+
+  use Autom4te::ChannelDefs;
+
+  Autom4te::ChannelDefs::usage ();
+  prog_error ($MESSAGE, [%OPTIONS]);
+  error ($WHERE, $MESSAGE, [%OPTIONS]);
+  error ($MESSAGE);
+  fatal ($WHERE, $MESSAGE, [%OPTIONS]);
+  fatal ($MESSAGE);
+  verb ($MESSAGE, [%OPTIONS]);
+  switch_warning ($CATEGORY);
+  parse_WARNINGS ();
+  parse_warning ($OPTION, $ARGUMENT);
+  Autom4te::ChannelDefs::set_strictness ($STRICTNESS_NAME);
+
+=head1 DESCRIPTION
+
+This packages defines channels that can be used in Automake to
+output diagnostics and other messages (via C<msg()>).  It also defines
+some helper function to enable or disable these channels, and some
+shorthand function to output on specific channels.
+
+=cut
+
+use 5.005;
+use strict;
+use Exporter;
+
+use vars qw (@ISA @EXPORT);
+
address@hidden = qw (Exporter);
address@hidden = qw (&prog_error &error &fatal &verb
+             &switch_warning &parse_WARNINGS &parse_warnings);
+
+=head2 CHANNELS
+
+The following channels can be used as the first argument of
+C<Autom4te::Channel::msg>.  For some of them we list a shorthand
+function that makes the code more readable.
+
+=over 4
+
+=item C<fatal>
+
+Fatal errors.  Use C<&fatal> to send messages over this channel.
+
+=item C<error>
+
+Common errors.   Use C<&error> to send messages over this channel.
+
+=item C<error-gnu>
+
+Errors related to GNU Standards.
+
+=item C<error-gnu/warn>
+
+Errors related to GNU Standards that should be warnings in `foreign' mode.
+
+=item C<error-gnits>
+
+Errors related to GNITS Standards (silent by default).
+
+=item C<automake>
+
+Internal errors.  Use C<&prog_error> to send messages over this channel.
+
+=item C<gnu>
+
+Warnings related to GNU Coding Standards.
+
+=item C<obsolete>
+
+Warnings about obsolete features (silent by default).
+
+=item C<override>
+
+Warnings about user redefinitions of Automake rules or
+variables (silent by default).
+
+=item C<portability>
+
+Warnings about non-portable constructs.
+
+=item C<syntax>
+
+Warnings about weird syntax, unused variables, typos...
+
+=item C<unsupported>
+
+Warnings about unsupported (or mis-supported) features.
+
+=item C<verb>
+
+Messages output in C<--verbose> mode.  Use C<&verb> to send such messages.
+
+=item C<note>
+
+Informative messages.
+
+=back
+
+=cut
+
+# Initialize our list of error/warning channels.
+# Do not forget to update &usage and the manual
+# if you add or change a warning channel.
+
+register_channel 'fatal', type => 'fatal';
+register_channel 'error', type => 'error';
+register_channel 'error-gnu', type => 'error';
+register_channel 'error-gnu/warn', type => 'error';
+register_channel 'error-gnits', type => 'error', silent => 1;
+register_channel 'automake', type => 'fatal', backtrace => 1,
+  header => ("####################\n" .
+            "## Internal Error ##\n" .
+            "####################\n"),
+  footer => "\nPlease contact <address@hidden>.";
+
+register_channel 'gnu', type => 'warning';
+register_channel 'obsolete', type => 'warning', silent => 1;
+register_channel 'override', type => 'warning', silent => 1;
+register_channel 'portability', type => 'warning', silent => 1;
+register_channel 'syntax', type => 'warning';
+register_channel 'unsupported', type => 'warning';
+
+register_channel 'verb', type => 'debug', silent => 1;
+register_channel 'note', type => 'debug', silent => 0;
+
+=head2 FUNCTIONS
+
+=over 4
+
+=item C<usage ()>
+
+Display warning categories.
+
+=cut
+
+sub usage ()
+{
+  print "Warning categories include:
+  `gnu'           GNU coding standards (default in gnu and gnits modes)
+  `obsolete'      obsolete features or constructions
+  `override'      user redefinitions of Automake rules or variables
+  `portability'   portability issues
+  `syntax'        dubious syntactic constructs (default)
+  `unsupported'   unsupported or incomplete features (default)
+  `all'           all the warnings
+  `no-CATEGORY'   turn off warnings in CATEGORY
+  `none'          turn off all the warnings
+  `error'         treat warnings as errors
+";
+}
+
+=item C<prog_error ($MESSAGE, [%OPTIONS])>
+
+Signal a programming error (on channel C<automake>),
+display C<$MESSAGE>, and exit 1.
+
+=cut
+
+sub prog_error ($;%)
+{
+  my ($msg, %opts) = @_;
+  msg 'automake', '', $msg, %opts;
+}
+
+=item C<error ($WHERE, $MESSAGE, [%OPTIONS])>
+
+=item C<error ($MESSAGE)>
+
+Uncategorized errors.
+
+=cut
+
+sub error ($;$%)
+{
+  my ($where, $msg, %opts) = @_;
+  msg ('error', $where, $msg, %opts);
+}
+
+=item C<fatal ($WHERE, $MESSAGE, [%OPTIONS])>
+
+=item C<fatal ($MESSAGE)>
+
+Fatal errors.
+
+=cut
+
+sub fatal ($;$%)
+{
+  my ($where, $msg, %opts) = @_;
+  msg ('fatal', $where, $msg, %opts);
+}
+
+=item C<verb ($MESSAGE, [%OPTIONS])>
+
+C<--verbose> messages.
+
+=cut
+
+sub verb ($;%)
+{
+  my ($msg, %opts) = @_;
+  msg 'verb', '', $msg, %opts;
+}
+
+=item C<switch_warning ($CATEGORY)>
+
+If C<$CATEGORY> is C<mumble>, turn on channel C<mumble>.
+If it's C<no-mumble>, turn C<mumble> off.
+Else handle C<all> and C<none> for completeness.
+
+=cut
+
+sub switch_warning ($)
+{
+  my ($cat) = @_;
+  my $has_no = 0;
+
+  if ($cat =~ /^no-(.*)$/)
+    {
+      $cat = $1;
+      $has_no = 1;
+    }
+
+  if ($cat eq 'all')
+    {
+      setup_channel_type 'warning', silent => $has_no;
+    }
+  elsif ($cat eq 'none')
+    {
+      setup_channel_type 'warning', silent => ! $has_no;
+    }
+  elsif ($cat eq 'error')
+    {
+      $warnings_are_errors = ! $has_no;
+      # Set exit code if Perl warns about something
+      # (like uninitialized variables).
+      $SIG{"__WARN__"} =
+       $has_no ? 'DEFAULT' : sub { print STDERR @_; $exit_code = 1; };
+    }
+  elsif (channel_type ($cat) eq 'warning')
+    {
+      setup_channel $cat, silent => $has_no;
+    }
+  else
+    {
+      return 1;
+    }
+  return 0;
+}
+
+=item C<parse_WARNINGS ()>
+
+Parse the WARNINGS environment variable.
+
+=cut
+
+sub parse_WARNINGS ()
+{
+  if (exists $ENV{'WARNINGS'})
+    {
+      # Ignore unknown categories.  This is required because WARNINGS
+      # should be honored by many tools.
+      switch_warning $_ foreach (split (',', $ENV{'WARNINGS'}));
+    }
+}
+
+=item C<parse_warning ($OPTION, $ARGUMENT)>
+
+Parse the argument of C<--warning=CATEGORY> or C<-WCATEGORY>.
+
+C<$OPTIONS> is C<"--warning"> or C<"-W">, C<$ARGUMENT> is C<CATEGORY>.
+
+This is meant to be used as a argument to C<Getopt>.
+
+=cut
+
+sub parse_warnings ($$)
+{
+  my ($opt, $categories) = @_;
+
+  foreach my $cat (split (',', $categories))
+    {
+      msg 'unsupported', "unknown warning category `$cat'"
+       if switch_warning $cat;
+    }
+}
+
+=item C<set_strictness ($STRICTNESS_NAME)>
+
+Configure channels for strictness C<$STRICTNESS_NAME>.
+
+=cut
+
+sub set_strictness ($)
+{
+  my ($name) = @_;
+
+  # FIXME: 'portability' warnings are currently disabled by default.
+  # Eventually we want to turn them on in GNU and GNITS modes, but
+  # we don't do this yet in Automake 1.7 to help the 1.6/1.7 transition.
+  #
+  # Indeed there would be only two ways to get rid of these new warnings:
+  #  1. adjusting Makefile.am
+  #     This is not always easy (or wanted).  Consider %-rules or
+  #     $(function args) variables.
+  #  2. using -Wno-portability
+  #     This means there is no way to have the same Makefile.am
+  #     working both with Automake 1.6 and 1.7 (since 1.6 does not
+  #     understand -Wno-portability).
+  #
+  # In Automake 1.8 (or whatever it is called) we can turn these
+  # warnings on, since -Wno-portability will not be an issue for
+  # the 1.7/1.8 transition.
+
+  if ($name eq 'gnu')
+    {
+      setup_channel 'error-gnu', silent => 0;
+      setup_channel 'error-gnu/warn', silent => 0, type => 'error';
+      setup_channel 'error-gnits', silent => 1;
+      # setup_channel 'portability', silent => 0;
+      setup_channel 'gnu', silent => 0;
+    }
+  elsif ($name eq 'gnits')
+    {
+      setup_channel 'error-gnu', silent => 0;
+      setup_channel 'error-gnu/warn', silent => 0, type => 'error';
+      setup_channel 'error-gnits', silent => 0;
+      # setup_channel 'portability', silent => 0;
+      setup_channel 'gnu', silent => 0;
+    }
+  elsif ($name eq 'foreign')
+    {
+      setup_channel 'error-gnu', silent => 1;
+      setup_channel 'error-gnu/warn', silent => 0, type => 'warning';
+      setup_channel 'error-gnits', silent => 1;
+      # setup_channel 'portability', silent => 1;
+      setup_channel 'gnu', silent => 1;
+    }
+  else
+    {
+      prog_error "level `$name' not recognized\n";
+    }
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<Autom4te::Channels>
+
+=head1 HISTORY
+
+Written by Alexandre Duret-Lutz E<lt>F<address@hidden>E<gt>.
+
+=cut
+
+### Setup "GNU" style for perl-mode and cperl-mode.
+## Local Variables:
+## perl-indent-level: 2
+## perl-continued-statement-offset: 2
+## perl-continued-brace-offset: 0
+## perl-brace-offset: 0
+## perl-brace-imaginary-offset: 0
+## perl-label-offset: -2
+## cperl-indent-level: 2
+## cperl-brace-offset: 0
+## cperl-continued-brace-offset: 0
+## cperl-label-offset: -2
+## cperl-extra-newline-before-brace: t
+## cperl-merge-trailing-else: nil
+## cperl-continued-statement-offset: 2
+## End:
Index: lib/Autom4te/Channels.pm
===================================================================
RCS file: lib/Autom4te/Channels.pm
diff -N lib/Autom4te/Channels.pm
--- lib/Autom4te/Channels.pm    1 Jan 1970 00:00:00 -0000
+++ lib/Autom4te/Channels.pm    20 Aug 2003 06:50:20 -0000
@@ -0,0 +1,701 @@
+# Copyright (C) 2002 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+package Autom4te::Channels;
+
+=head1 NAME
+
+Autom4te::Channels - support functions for error and warning management
+
+=head1 SYNOPSIS
+
+  use Autom4te::Channels;
+
+  # Register a channel to output warnings about unused variables.
+  register_channel 'unused', type => 'warning';
+
+  # Register a channel for system errors.
+  register_channel 'system', type => 'error', exit_code => 4;
+
+  # Output a message on channel 'unused'.
+  msg 'unused', "$file:$line", "unused variable `$var'";
+
+  # Make the 'unused' channel silent.
+  setup_channel 'unused', silent => 1;
+
+  # Turn on all channels of type 'warning'.
+  setup_channel_type 'warning', silent => 0;
+
+  # Treat all warnings as errors.
+  $warnings_are_errors = 1;
+
+  # Exit with the greater exist code encountered so far.
+  exit $exit_code;
+
+=head1 DESCRIPTION
+
+This perl module provides support functions for handling diagnostic
+channels in programs.  Channels can be registered to convey fatal,
+error, warning, or debug messages.  Each channel has various options
+(e.g. is the channel silent, should duplicate messages be removed,
+etc.) that can also be overridden on a per-message basis.
+
+=cut
+
+use 5.005;
+use strict;
+use Exporter;
+use Carp;
+use File::Basename;
+
+use vars qw (@ISA @EXPORT %channels $me);
+
address@hidden = qw (Exporter);
address@hidden = qw ($exit_code $warnings_are_errors
+             &reset_local_duplicates &reset_global_duplicates
+             &register_channel &msg &exists_channel &channel_type
+             &setup_channel &setup_channel_type
+             &dup_channel_setup &drop_channel_setup
+             &buffer_messages &flush_messages
+             US_GLOBAL US_LOCAL
+             UP_NONE UP_TEXT UP_LOC_TEXT);
+
+$me = basename $0;
+
+=head2 Global Variables
+
+=over 4
+
+=item C<$exit_code>
+
+The greatest exit code seen so far. C<$exit_code> is updated from
+the C<exit_code> options of C<fatal> and C<error> channels.
+
+=cut
+
+use vars qw ($exit_code);
+$exit_code = 0;
+
+=item C<$warnings_are_errors>
+
+Set this variable to 1 if warning messages should be treated as
+errors (i.e. if they should update C<$exit_code>).
+
+=cut
+
+use vars qw ($warnings_are_errors);
+$warnings_are_errors = 0;
+
+=back
+
+=head2 Constants
+
+=over 4
+
+=item C<UP_NONE>, C<UP_TEXT>, C<UP_LOC_TEXT>
+
+Possible values for the C<uniq_part> options.  This select the part
+of the message that should be considered when filtering out duplicates.
+If C<UP_LOC_TEXT> is used, the location and the explanation message
+are used for filtering.  If C<UP_TEXT> is used, only the explanation
+message is used (so the same message will be filtered out if it appears
+at different locations).  C<UP_NONE> means that duplicate messages
+should be output.
+
+=cut
+
+use constant UP_NONE => 0;
+use constant UP_TEXT => 1;
+use constant UP_LOC_TEXT => 2;
+
+=item C<US_LOCAL>, C<US_GLOBAL>
+
+Possible values for the C<uniq_scope> options.
+Use C<US_GLOBAL> for error messages that should be printed only
+once in the run of the program, C<US_LOCAL> for message that
+should be printed only once per file.  (Actually, C<Channels> does not
+now when files are changed, it relies on you calling C<reset_local_duplicates>
+when this happens.)
+
+=cut
+
+# possible values for uniq_scope
+use constant US_LOCAL => 0;
+use constant US_GLOBAL => 1;
+
+=back
+
+=head2 Options
+
+Channels accept the options described below.  These options can be
+passed as a hash to the C<register_channel>, C<setup_channel>, and C<msg>
+functions.  The possible keys, with there default value are:
+
+=over
+
+=item C<type =E<gt> 'warning'>
+
+The type of the channel.  One of C<'debug'>, C<'warning'>, C<'error'>, or
+C<'fatal'>.  Fatal messages abort the program when they are output.
+Error messages update the exit status.  Debug and warning messages are
+harmless, except that warnings can be treated as errors of
+C<$warnings_are_errors> is set.
+
+=item C<exit_code =E<gt> 1>
+
+The value to update C<$exit_code> with when a fatal or error message
+is emited.  C<$exit_code> is also updated for warnings output
+when @<$warnings_are_errors> is set.
+
+=item C<file =E<gt> \*STDERR>
+
+The file where the error should be output.
+
+=item C<silent =E<gt> 0>
+
+Whether the channel should be silent.  Use this do disable a
+category of warning, for instance.
+
+=item C<uniq_part =E<gt> UP_LOC_TEXT>
+
+The part of the message subject to duplicate filtering.  See the
+documentation for the C<UP_NONE>, C<UP_TEXT>, and C<UP_LOC_TEXT>
+constants above.
+
+=item C<uniq_scope =E<gt> US_LOCAL>
+
+The scope of duplicate filtering.  See the documentation for the
+C<US_LOCAL>, and C<US_GLOBAL> constants above.
+
+=item C<header =E<gt> ''>
+
+A string to prepend to each message emitted through this channel.
+
+=item C<footer =E<gt> ''>
+
+A string to append to each message emitted through this channel.
+
+=item C<backtrace =E<gt> 0>
+
+Die with a stack backtrace after displaying the message.
+
+=item C<partial =E<gt> 0>
+
+When set, indicates a partial message that should
+be output along with the next message with C<partial> unset.
+Several partial messages can be stacked this way.
+
+Duplicate filtering will apply to the I<global> message resulting from
+all I<partial> messages, using the options from the last (non-partial)
+message.  Linking associated messages is the main reason to use this
+option.
+
+For instance the following messages
+
+  msg 'channel', 'foo:2', 'redefinition of A ...';
+  msg 'channel', 'foo:1', '... A previously defined here';
+  msg 'channel', 'foo:3', 'redefinition of A ...';
+  msg 'channel', 'foo:1', '... A previously defined here';
+
+will result in
+
+ foo:2: redefinition of A ...
+ foo:1: ... A previously defined here
+ foo:3: redefinition of A ...
+
+where the duplicate "I<... A previously defined here>" has been
+filtered out.
+
+Linking these messages using C<partial> as follows will prevent the
+fourth message to disappear.
+
+  msg 'channel', 'foo:2', 'redefinition of A ...', partial => 1;
+  msg 'channel', 'foo:1', '... A previously defined here';
+  msg 'channel', 'foo:3', 'redefinition of A ...', partial => 1;
+  msg 'channel', 'foo:1', '... A previously defined here';
+
+Note that because the stack of C<partial> messages is printed with the
+first non-C<partial> message, most options of C<partial> messages will
+be ignored.
+
+=back
+
+=cut
+
+use vars qw (%_default_options %_global_duplicate_messages
+            %_local_duplicate_messages);
+
+# Default options for a channel.
+%_default_options =
+  (
+   type => 'warning',
+   exit_code => 1,
+   file => \*STDERR,
+   silent => 0,
+   uniq_scope => US_LOCAL,
+   uniq_part => UP_LOC_TEXT,
+   header => '',
+   footer => '',
+   backtrace => 0,
+   partial => 0,
+   );
+
+# Filled with output messages as keys, to detect duplicates.
+# The value associated to each keys is the number of occurences
+# filtered out.
+%_local_duplicate_messages = ();
+%_global_duplicate_messages = ();
+
+sub _reset_duplicates (\%)
+{
+  my ($ref) = @_;
+  my $dup = 0;
+  foreach my $k (keys %$ref)
+    {
+      $dup += $ref->{$k};
+    }
+  %$ref = ();
+  return $dup;
+}
+
+
+=head2 Functions
+
+=over 4
+
+=item C<reset_local_duplicates ()>
+
+Reset local duplicate messages (see C<US_LOCAL>), and
+return the number of messages that have been filtered out.
+
+=cut
+
+sub reset_local_duplicates ()
+{
+  return _reset_duplicates %_local_duplicate_messages;
+}
+
+=item C<reset_global_duplicates ()>
+
+Reset local duplicate messages (see C<US_GLOBAL>), and
+return the number of messages that have been filtered out.
+
+=cut
+
+sub reset_global_duplicates ()
+{
+  return _reset_duplicates %_global_duplicate_messages;
+}
+
+sub _merge_options (\%%)
+{
+  my ($hash, %options) = @_;
+  local $_;
+
+  foreach (keys %options)
+    {
+      if (exists $hash->{$_})
+       {
+         $hash->{$_} = $options{$_}
+       }
+      else
+       {
+         confess "unknown option `$_'";
+       }
+    }
+}
+
+=item C<register_channel ($name, [%options])>
+
+Declare channel C<$name>, and override the default options
+with those listed in C<%options>.
+
+=cut
+
+sub register_channel ($;%)
+{
+  my ($name, %options) = @_;
+  my %channel_opts = %_default_options;
+  _merge_options %channel_opts, %options;
+  $channels{$name} = \%channel_opts;
+}
+
+=item C<exists_channel ($name)>
+
+Returns true iff channel C<$name> has been registered.
+
+=cut
+
+sub exists_channel ($)
+{
+  my ($name) = @_;
+  return exists $channels{$name};
+}
+
+=item C<channel_type ($name)>
+
+Returns the type of channel C<$name> if it has been registered.
+Returns The empty string otherwise.
+
+=cut
+
+sub channel_type ($)
+{
+  my ($name) = @_;
+  return $channels{$name}{'type'} if exists_channel $name;
+  return '';
+}
+
+# _format_sub_message ($LEADER, $MESSAGE)
+# ---------------------------------------
+# Split $MESSAGE at new lines and add $LEADER to each line.
+sub _format_sub_message ($$)
+{
+  my ($leader, $message) = @_;
+  return $leader . join ("\n" . $leader, split ("\n", $message)) . "\n";
+}
+
+# _format_message ($LOCATION, $MESSAGE, %OPTIONS)
+# -----------------------------------------------
+# Format the message.  Return a string ready to print.
+sub _format_message ($$%)
+{
+  my ($location, $message, %opts) = @_;
+  my $msg = '';
+  if (ref $location)
+    {
+      # If $LOCATION is a reference, assume it's an instance of the
+      # Autom4te::Location class and display contexts.
+      my $loc = $location->get || $me;
+      $msg = _format_sub_message ("$loc: ", $opts{'header'}
+                                 . $message . $opts{'footer'});
+      for my $pair ($location->get_contexts)
+       {
+         $msg .= _format_sub_message ($pair->[0] . ":   ", $pair->[1]);
+       }
+    }
+  else
+    {
+      $location ||= $me;
+      $msg = _format_sub_message ("$location: ", $opts{'header'}
+                                 . $message . $opts{'footer'});
+    }
+  return $msg;
+}
+
+# Store partial messages here. (See the 'partial' option.)
+use vars qw ($partial);
+$partial = '';
+
+# _print_message ($LOCATION, $MESSAGE, %OPTIONS)
+# ----------------------------------------------
+# Format the message, check duplicates, and print it.
+sub _print_message ($$%)
+{
+  my ($location, $message, %opts) = @_;
+
+  return 0 if ($opts{'silent'});
+
+  my $msg = _format_message ($location, $message, %opts);
+  if ($opts{'partial'})
+    {
+      # Incomplete message.   Store, don't print.
+      $partial .= $msg;
+      return;
+    }
+  else
+    {
+      # Prefix with any partial message send so far.
+      $msg = $partial . $msg;
+      $partial = '';
+    }
+
+  # Check for duplicate message if requested.
+  if ($opts{'uniq_part'} != UP_NONE)
+    {
+      # Which part of the error should we match?
+      my $to_filter;
+      if ($opts{'uniq_part'} == UP_TEXT)
+       {
+         $to_filter = $message;
+       }
+      elsif ($opts{'uniq_part'} == UP_LOC_TEXT)
+       {
+         $to_filter = $msg;
+       }
+      else
+       {
+         confess "unknown value for uniq_part: " . $opts{'uniq_part'};
+       }
+
+      # Do we want local or global uniqueness?
+      my $dups;
+      if ($opts{'uniq_scope'} == US_LOCAL)
+       {
+         $dups = \%_local_duplicate_messages;
+       }
+      elsif ($opts{'uniq_scope'} == US_GLOBAL)
+       {
+         $dups = \%_global_duplicate_messages;
+       }
+      else
+       {
+         confess "unknown value for uniq_scope: " . $opts{'uniq_scope'};
+       }
+
+      # Update the hash of messages.
+      if (exists $dups->{$to_filter})
+       {
+         ++$dups->{$to_filter};
+         return 0;
+       }
+      else
+       {
+         $dups->{$to_filter} = 0;
+       }
+    }
+  my $file = $opts{'file'};
+  print $file $msg;
+  return 1;
+}
+
+=item C<msg ($channel, $location, $message, [%options])>
+
+Emit a message on C<$channel>, overriding some options of the channel  with
+those specified in C<%options>.  Obviously C<$channel> must have been
+registered with C<register_channel>.
+
+C<$message> is the text of the message, and C<$location> is a location
+associated to the message.
+
+For instance to complain about some unused variable C<mumble>
+declared at line 10 in F<foo.c>, one could do:
+
+  msg 'unused', 'foo.c:10', "unused variable `mumble'";
+
+If channel C<unused> is not silent (and if this message is not a duplicate),
+the following would be output:
+
+  foo.c:10: unused variable `mumble'
+
+C<$location> can also be an instance of C<Autom4te::Location>.  In this
+case the stack of contexts will be displayed in addition.
+
+If C<$message> contains new line caracters, C<$location> is prepended
+to each line.  For instance
+
+  msg 'error', 'somewhere', "1st line\n2nd line";
+
+becomes
+
+  somewhere: 1st line
+  somewhere: 2nd line
+
+If C<$location> is an empty string, it is replaced by the name of the
+program.  Actually, if you don't use C<%options>, you can even
+elide the empty C<$location>.  Thus
+
+  msg 'fatal', '', 'fatal error';
+  msg 'fatal', 'fatal error';
+
+both print
+
+  progname: fatal error
+
+=cut
+
+
+use vars qw (@backlog %buffering @chain);
+
+# See buffer_messages() and flush_messages() below.
+%buffering = ();       # The map of channel types to buffer.
address@hidden = ();            # The buffer of messages.
+
+sub msg ($$;$%)
+{
+  my ($channel, $location, $message, %options) = @_;
+
+  if (! defined $message)
+    {
+      $message = $location;
+      $location = '';
+    }
+
+  confess "unknown channel $channel" unless exists $channels{$channel};
+
+  my %opts = %{$channels{$channel}};
+  _merge_options (%opts, %options);
+
+  if (exists $buffering{$opts{'type'}})
+    {
+      push @backlog, [$channel, $location->clone, $message, %options];
+      return;
+    }
+
+  # Print the message if needed.
+  if (_print_message ($location, $message, %opts))
+    {
+      # Adjust exit status.
+      if ($opts{'type'} eq 'error'
+         || $opts{'type'} eq 'fatal'
+         || ($opts{'type'} eq 'warning' && $warnings_are_errors))
+       {
+         my $es = $opts{'exit_code'};
+         $exit_code = $es if $es > $exit_code;
+       }
+
+      # Die on fatal messages.
+      confess if $opts{'backtrace'};
+      exit $exit_code if $opts{'type'} eq 'fatal';
+    }
+}
+
+
+=item C<setup_channel ($channel, %options)>
+
+Override the options of C<$channel> with those specified by C<%options>.
+
+=cut
+
+sub setup_channel ($%)
+{
+  my ($name, %opts) = @_;
+  confess "channel $name doesn't exist" unless exists $channels{$name};
+  _merge_options %{$channels{$name}}, %opts;
+}
+
+=item C<setup_channel_type ($type, %options)>
+
+Override the options of any channel of type C<$type>
+with those specified by C<%options>.
+
+=cut
+
+sub setup_channel_type ($%)
+{
+  my ($type, %opts) = @_;
+  foreach my $channel (keys %channels)
+    {
+      setup_channel $channel, %opts
+       if $channels{$channel}{'type'} eq $type;
+    }
+}
+
+=item C<dup_channel_setup ()>, C<drop_channel_setup ()>
+
+Sometimes it is necessary to make temporary modifications to channels.
+For instance one may want to disable a warning while processing a
+particular file, and then restore the initial setup.  These two
+functions make it easy: C<dup_channel_setup ()> saves a copy of the
+current configuration for later restoration by
+C<drop_channel_setup ()>.
+
+You can think of this as a stack of configurations whose first entry
+is the active one.  C<dup_channel_setup ()> duplicates the first
+entry, while C<drop_channel_setup ()> just deletes it.
+
+=cut
+
+use vars qw (@_saved_channels);
address@hidden = ();
+
+sub dup_channel_setup ()
+{
+  my %channels_copy;
+  foreach my $k1 (keys %channels)
+    {
+      $channels_copy{$k1} = {%{$channels{$k1}}};
+    }
+  push @_saved_channels, \%channels_copy;
+}
+
+sub drop_channel_setup ()
+{
+  my $saved = pop @_saved_channels;
+  %channels = %$saved;
+}
+
+=item C<buffer_messages (@types)>, C<flush_messages ()>
+
+By default, when C<msg> is called, messages are processed immediately.
+
+Sometimes it is necessary to delay the output of messages.
+For instance you might want to make diagnostics before
+channels have been completly configured.
+
+After C<buffer_messages(@types)> has been called, messages sent with
+C<msg> to a channel whose type is listed in C<@types> will be stored in a
+list for later processing.
+
+This backlog of messages is processed when C<flush_messages> is
+called, with the current channel options (not the options in effect,
+at the time of C<msg>).  So for instance if some channel was silenced
+in the meantime, messages to this channels will not be print.
+
+C<flush_messages> cancels the effect of C<buffer_messages>.  Following
+calls to C<msg> are processed immediately as usual.
+
+=cut
+
+sub buffer_messages (@)
+{
+  foreach my $type (@_)
+    {
+      $buffering{$type} = 1;
+    }
+}
+
+sub flush_messages ()
+{
+  %buffering = ();
+  foreach my $args (@backlog)
+    {
+      &msg (@$args);
+    }
+  @backlog = ();
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<Autom4te::Location>
+
+=head1 HISTORY
+
+Written by Alexandre Duret-Lutz E<lt>F<address@hidden>E<gt>.
+
+=cut
+
+1;
+
+### Setup "GNU" style for perl-mode and cperl-mode.
+## Local Variables:
+## perl-indent-level: 2
+## perl-continued-statement-offset: 2
+## perl-continued-brace-offset: 0
+## perl-brace-offset: 0
+## perl-brace-imaginary-offset: 0
+## perl-label-offset: -2
+## cperl-indent-level: 2
+## cperl-brace-offset: 0
+## cperl-continued-brace-offset: 0
+## cperl-label-offset: -2
+## cperl-extra-newline-before-brace: t
+## cperl-merge-trailing-else: nil
+## cperl-continued-statement-offset: 2
+## End:
Index: lib/Autom4te/Configure_ac.pm
===================================================================
RCS file: lib/Autom4te/Configure_ac.pm
diff -N lib/Autom4te/Configure_ac.pm
--- lib/Autom4te/Configure_ac.pm        1 Jan 1970 00:00:00 -0000
+++ lib/Autom4te/Configure_ac.pm        20 Aug 2003 06:50:20 -0000
@@ -0,0 +1,95 @@
+# Copyright (C) 2003  Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+package Autom4te::Configure_ac;
+
+use strict;
+use Exporter;
+use Autom4te::Channels;
+use Autom4te::ChannelDefs;
+
+use vars qw (@ISA @EXPORT);
+
address@hidden = qw (Exporter);
address@hidden = qw ($configure_ac &find_configure_ac &require_configure_ac);
+
+=head1 NAME
+
+Autom4te::Configure_ac - Locate configure.ac or configure.in.
+
+=head1 SYNOPSIS
+
+  use Autom4te::Configure_ac;
+
+  # Try to locate configure.in or configure.ac in the current
+  # directory.  It may be absent.  Complain if both files exist.
+  my $filename = find_configure_ac;
+
+  # Likewise, but bomb out if the file does not exist.
+  my $filename = require_configure_ac;
+
+In both cases, the name of the file found is also put in the
+C<$configure_ac> global variable.
+
+=cut
+
+use vars '$configure_ac';
+
+sub find_configure_ac ()
+{
+  if (-f 'configure.ac')
+    {
+      if (-f 'configure.in')
+       {
+         msg ('unsupported',
+              "`configure.ac' and `configure.in' both present.\n"
+              . "proceeding with `configure.ac'.");
+       }
+      $configure_ac = 'configure.ac';
+    }
+  elsif (-f 'configure.in')
+    {
+      $configure_ac = 'configure.in';
+    }
+  return $configure_ac;
+}
+
+sub require_configure_ac ()
+{
+  fatal "`configure.ac' or `configure.in' is required"
+    unless find_configure_ac;
+  return $configure_ac;
+}
+
+1;
+
+### Setup "GNU" style for perl-mode and cperl-mode.
+## Local Variables:
+## perl-indent-level: 2
+## perl-continued-statement-offset: 2
+## perl-continued-brace-offset: 0
+## perl-brace-offset: 0
+## perl-brace-imaginary-offset: 0
+## perl-label-offset: -2
+## cperl-indent-level: 2
+## cperl-brace-offset: 0
+## cperl-continued-brace-offset: 0
+## cperl-label-offset: -2
+## cperl-extra-newline-before-brace: t
+## cperl-merge-trailing-else: nil
+## cperl-continued-statement-offset: 2
+## End:
Index: lib/Autom4te/FileUtils.pm
===================================================================
RCS file: lib/Autom4te/FileUtils.pm
diff -N lib/Autom4te/FileUtils.pm
--- lib/Autom4te/FileUtils.pm   1 Jan 1970 00:00:00 -0000
+++ lib/Autom4te/FileUtils.pm   20 Aug 2003 06:50:20 -0000
@@ -0,0 +1,241 @@
+# Copyright (C) 2003  Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2, or (at your option)
+# any later version.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+# 02111-1307, USA.
+
+package Autom4te::FileUtils;
+
+use strict;
+use Exporter;
+use File::stat;
+use IO::File;
+use Autom4te::Channels;
+use Autom4te::ChannelDefs;
+
+use vars qw (@ISA @EXPORT);
+
address@hidden = qw (Exporter);
address@hidden = qw (&find_file &mtime &update_file &xsystem &contents);
+
+
+# $FILENAME
+# find_file ($FILENAME, @INCLUDE)
+# -------------------------------
+# We match exactly the behavior of GNU m4: first look in the current
+# directory (which includes the case of absolute file names), and, if
+# the file is not absolute, just fail.  Otherwise, look in the path.
+#
+# If the file is flagged as optional (ends with `?'), then return undef
+# if absent.
+sub find_file ($@)
+{
+  use File::Spec;
+
+  my ($filename, @include) = @_;
+  my $optional = 0;
+
+  $optional = 1
+    if $filename =~ s/\?$//;
+
+  return File::Spec->canonpath ($filename)
+    if -e $filename;
+
+  if (File::Spec->file_name_is_absolute ($filename))
+    {
+      fatal "$filename: no such file or directory"
+       unless $optional;
+      return undef;
+    }
+
+  foreach my $path (reverse @include)
+    {
+      return File::Spec->canonpath (File::Spec->catfile ($path, $filename))
+       if -e File::Spec->catfile ($path, $filename)
+    }
+
+  fatal "$filename: no such file or directory"
+    unless $optional;
+
+  return undef;
+}
+
+# $MTIME
+# MTIME ($FILE)
+# -------------
+# Return the mtime of $FILE.  Missing files, or `-' standing for STDIN
+# or STDOUT are ``obsolete'', i.e., as old as possible.
+sub mtime ($)
+{
+  my ($file) = @_;
+
+  return 0
+    if $file eq '-' || ! -f $file;
+
+  my $stat = stat ($file)
+    or fatal "cannot stat $file: $!";
+
+  return $stat->mtime;
+}
+
+
+# &update_file ($FROM, $TO)
+# -------------------------
+# Rename $FROM as $TO, preserving $TO timestamp if it has not changed.
+# Recognize `$TO = -' standing for stdin.
+sub update_file ($$)
+{
+  my ($from, $to) = @_;
+  my $SIMPLE_BACKUP_SUFFIX = $ENV{'SIMPLE_BACKUP_SUFFIX'} || '~';
+  use File::Compare;
+  use File::Copy;
+
+  if ($to eq '-')
+    {
+      my $in = new IO::File ("$from");
+      my $out = new IO::File (">-");
+      while ($_ = $in->getline)
+       {
+         print $out $_;
+       }
+      $in->close;
+      unlink ($from) || fatal "cannot not remove $from: $!";
+      return;
+    }
+
+  if (-f "$to" && compare ("$from", "$to") == 0)
+    {
+      # File didn't change, so don't update its mod time.
+      msg 'note', "`$to' is unchanged";
+      return
+    }
+
+  if (-f "$to")
+    {
+      # Back up and install the new one.
+      move ("$to",  "$to$SIMPLE_BACKUP_SUFFIX")
+       or fatal "cannot not backup $to: $!";
+      move ("$from", "$to")
+       or fatal "cannot not rename $from as $to: $!";
+      msg 'note', "`$to' is updated";
+    }
+  else
+    {
+      move ("$from", "$to")
+       or fatal "cannot not rename $from as $to: $!";
+      msg 'note', "`$to' is created";
+    }
+}
+
+
+# handle_exec_errors ($COMMAND)
+# -----------------------------
+# Display an error message for $COMMAND, based on the content of $? and $!.
+sub handle_exec_errors ($)
+{
+  my ($command) = @_;
+
+  $command = (split (' ', $command))[0];
+  if ($!)
+    {
+      fatal "failed to run $command: $!";
+    }
+  else
+    {
+      use POSIX qw (WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
+
+      if (WIFEXITED ($?))
+       {
+         my $status = WEXITSTATUS ($?);
+         # Propagate exit codes.
+         fatal ("$command failed with exit status: $status",
+                exit_code => $status);
+       }
+      elsif (WIFSIGNALED ($?))
+       {
+         my $signal = WTERMSIG ($?);
+         fatal "$command terminated by signal: $signal";
+       }
+      else
+       {
+         fatal "$command exited abnormally";
+       }
+    }
+}
+
+# xqx ($COMMAND)
+# --------------
+# Same as `qx' (but in scalar context), but fails on errors.
+sub xqx ($)
+{
+  my ($command) = @_;
+
+  verb "running: $command";
+
+  $! = 0;
+  my $res = `$command`;
+  handle_exec_errors $command
+    if $?;
+
+  return $res;
+}
+
+
+# xsystem ($COMMAND)
+# ------------------
+sub xsystem ($)
+{
+  my ($command) = @_;
+
+  verb "running: $command";
+
+  $! = 0;
+  handle_exec_errors $command
+    if system $command;
+}
+
+
+# contents ($FILENAME)
+# --------------------
+# Swallow the contents of file $FILENAME.
+sub contents ($)
+{
+  my ($file) = @_;
+  verb "reading $file";
+  local $/;                    # Turn on slurp-mode.
+  my $f = new Autom4te::XFile "< $file";
+  my $contents = $f->getline;
+  $f->close;
+  return $contents;
+}
+
+
+1; # for require
+
+### Setup "GNU" style for perl-mode and cperl-mode.
+## Local Variables:
+## perl-indent-level: 2
+## perl-continued-statement-offset: 2
+## perl-continued-brace-offset: 0
+## perl-brace-offset: 0
+## perl-brace-imaginary-offset: 0
+## perl-label-offset: -2
+## cperl-indent-level: 2
+## cperl-brace-offset: 0
+## cperl-continued-brace-offset: 0
+## cperl-label-offset: -2
+## cperl-extra-newline-before-brace: t
+## cperl-merge-trailing-else: nil
+## cperl-continued-statement-offset: 2
+## End:
Index: lib/Autom4te/Makefile.am
===================================================================
RCS file: /cvsroot/autoconf/autoconf/lib/Autom4te/Makefile.am,v
retrieving revision 1.6
diff -u -u -r1.6 Makefile.am
--- lib/Autom4te/Makefile.am    5 Sep 2001 07:06:40 -0000       1.6
+++ lib/Autom4te/Makefile.am    20 Aug 2003 06:50:20 -0000
@@ -1,7 +1,14 @@
 ## Process this file with automake to create Makefile.in
 
 perllibdir = $(pkgdatadir)/Autom4te
-dist_perllib_DATA = General.pm Struct.pm XFile.pm
+dist_perllib_DATA = \
+  ChannelDefs.pm \
+  Channels.pm \
+  Configure_ac.pm \
+  FileUtils.pm \
+  General.pm \
+  Struct.pm \
+  XFile.pm
 
 
 ## --------------- ##
Index: lib/Autom4te/Makefile.in
===================================================================
RCS file: /cvsroot/autoconf/autoconf/lib/Autom4te/Makefile.in,v
retrieving revision 1.30
diff -u -u -r1.30 Makefile.in
--- lib/Autom4te/Makefile.in    20 Aug 2003 06:29:56 -0000      1.30
+++ lib/Autom4te/Makefile.in    20 Aug 2003 06:50:20 -0000
@@ -109,7 +109,15 @@
 sysconfdir = @sysconfdir@
 target_alias = @target_alias@
 perllibdir = $(pkgdatadir)/Autom4te
-dist_perllib_DATA = General.pm Struct.pm XFile.pm
+dist_perllib_DATA = \
+  ChannelDefs.pm \
+  Channels.pm \
+  Configure_ac.pm \
+  FileUtils.pm \
+  General.pm \
+  Struct.pm \
+  XFile.pm
+
 TAGS_FILES = $(dist_perllib_DATA)
 ETAGS_ARGS = --lang=perl
 all: all-am




reply via email to

[Prev in Thread] Current Thread [Next in Thread]