File Coverage

File:/usr/local/share/automake-1.11/Automake/ChannelDefs.pm
Coverage:43.2%

linestmtbrancondsubpodtimecode
1# Copyright (C) 2002, 2003, 2006, 2008, 2009 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 <http://www.gnu.org/licenses/>.
15
16package Automake::ChannelDefs;
17
18
1
1
1
1
5
1
4
use Automake::Config;
19BEGIN
20{
21
1
50
1
10
  if ($perl_threads)
22    {
23
1
3
      require threads;
24
1
3
      import threads;
25    }
26}
27
1
1
1
1
13
1
7
use Automake::Channels;
28
29 - 56
=head1 NAME

Automake::ChannelDefs - channel definitions for Automake and helper functions

=head1 SYNOPSIS

  use Automake::ChannelDefs;

  Automake::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);
  Automake::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
57
58
1
1
1
1
19
3
1
use 5.005;
59
1
1
1
1
3
1
2
use strict;
60
1
1
1
1
4
1
2
use Exporter;
61
62
1
1
1
1
4
1
3
use vars qw (@ISA @EXPORT);
63
64@ISA = qw (Exporter);
65@EXPORT = qw (&prog_error &error &fatal &verb
66              &switch_warning &parse_WARNINGS &parse_warnings);
67
68 - 135
=head2 CHANNELS

The following channels can be used as the first argument of
C<Automake::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
136
137# Initialize our list of error/warning channels.
138# Do not forget to update &usage and the manual
139# if you add or change a warning channel.
140
141register_channel 'fatal', type => 'fatal', uniq_part => UP_NONE, ordered => 0;
142register_channel 'error', type => 'error';
143register_channel 'error-gnu', type => 'error';
144register_channel 'error-gnu/warn', type => 'error';
145register_channel 'error-gnits', type => 'error', silent => 1;
146register_channel 'automake', type => 'fatal', backtrace => 1,
147  header => ("####################\n" .
148             "## Internal Error ##\n" .
149             "####################\n"),
150  footer => "\nPlease contact <bug-automake\@gnu.org>.",
151  uniq_part => UP_NONE, ordered => 0;
152
153register_channel 'gnu', type => 'warning';
154register_channel 'obsolete', type => 'warning', silent => 1;
155register_channel 'override', type => 'warning', silent => 1;
156register_channel 'portability', type => 'warning', silent => 1;
157register_channel 'portability-recursive', type => 'warning', silent => 1;
158register_channel 'syntax', type => 'warning';
159register_channel 'unsupported', type => 'warning';
160
161register_channel 'verb', type => 'debug', silent => 1, uniq_part => UP_NONE,
162  ordered => 0;
163register_channel 'note', type => 'debug', silent => 0;
164
165 - 173
=head2 FUNCTIONS

=over 4

=item C<usage ()>

Display warning categories.

=cut
174
175sub usage ()
176{
177
0
0
1
0
  print "Warning categories include:
178  `gnu' GNU coding standards (default in gnu and gnits modes)
179  `obsolete' obsolete features or constructions
180  `override' user redefinitions of Automake rules or variables
181  `portability' portability issues (default in gnu and gnits modes)
182  `syntax' dubious syntactic constructs (default)
183  `unsupported' unsupported or incomplete features (default)
184  `all' all the warnings
185  `no-CATEGORY' turn off warnings in CATEGORY
186  `none' turn off all the warnings
187  `error' treat warnings as errors
188";
189}
190
191 - 196
=item C<prog_error ($MESSAGE, [%OPTIONS])>

Signal a programming error (on channel C<automake>),
display C<$MESSAGE>, and exit 1.

=cut
197
198sub prog_error ($;%)
199{
200
0
0
1
0
  my ($msg, %opts) = @_;
201
0
0
  msg 'automake', '', $msg, %opts;
202}
203
204 - 210
=item C<error ($WHERE, $MESSAGE, [%OPTIONS])>

=item C<error ($MESSAGE)>

Uncategorized errors.

=cut
211
212sub error ($;$%)
213{
214
0
0
1
0
  my ($where, $msg, %opts) = @_;
215
0
0
  msg ('error', $where, $msg, %opts);
216}
217
218 - 224
=item C<fatal ($WHERE, $MESSAGE, [%OPTIONS])>

=item C<fatal ($MESSAGE)>

Fatal errors.

=cut
225
226sub fatal ($;$%)
227{
228
0
0
1
0
  my ($where, $msg, %opts) = @_;
229
0
0
  msg ('fatal', $where, $msg, %opts);
230}
231
232 - 236
=item C<verb ($MESSAGE, [%OPTIONS])>

C<--verbose> messages.

=cut
237
238sub verb ($;%)
239{
240
65
65
1
104
  my ($msg, %opts) = @_;
241
65
50
288
  $msg = "thread " . threads->tid . ": " . $msg
242    if $perl_threads;
243
65
177
  msg 'verb', '', $msg, %opts;
244}
245
246 - 252
=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
253
254sub switch_warning ($)
255{
256
0
0
1
0
  my ($cat) = @_;
257
0
0
  my $has_no = 0;
258
259
0
0
0
  if ($cat =~ /^no-(.*)$/)
260    {
261
0
0
      $cat = $1;
262
0
0
      $has_no = 1;
263    }
264
265
0
0
0
0
0
0
  if ($cat eq 'all')
266    {
267
0
0
      setup_channel_type 'warning', silent => $has_no;
268    }
269  elsif ($cat eq 'none')
270    {
271
0
0
      setup_channel_type 'warning', silent => ! $has_no;
272    }
273  elsif ($cat eq 'error')
274    {
275
0
0
      $warnings_are_errors = ! $has_no;
276      # Set exit code if Perl warns about something
277      # (like uninitialized variables).
278      $SIG{"__WARN__"} =
279
0
0
0
0
0
0
0
0
        $has_no ? 'DEFAULT' : sub { print STDERR @_; $exit_code = 1; };
280    }
281  elsif (channel_type ($cat) eq 'warning')
282    {
283
0
0
      setup_channel $cat, silent => $has_no;
284
0
0
0
      setup_channel 'portability-recursive', silent => $has_no
285        if $cat eq 'portability';
286    }
287  else
288    {
289
0
0
      return 1;
290    }
291
0
0
  return 0;
292}
293
294 - 298
=item C<parse_WARNINGS ()>

Parse the WARNINGS environment variable.

=cut
299
300sub parse_WARNINGS ()
301{
302
1
50
1
1
6
  if (exists $ENV{'WARNINGS'})
303    {
304      # Ignore unknown categories. This is required because WARNINGS
305      # should be honored by many tools.
306
0
0
0
0
      switch_warning $_ foreach (split (',', $ENV{'WARNINGS'}));
307    }
308}
309
310 - 318
=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 an argument to C<Getopt>.

=cut
319
320sub parse_warnings ($$)
321{
322
0
0
0
0
  my ($opt, $categories) = @_;
323
324
0
0
  foreach my $cat (split (',', $categories))
325    {
326
0
0
0
      msg 'unsupported', "unknown warning category `$cat'"
327        if switch_warning $cat;
328    }
329}
330
331 - 335
=item C<set_strictness ($STRICTNESS_NAME)>

Configure channels for strictness C<$STRICTNESS_NAME>.

=cut
336
337sub set_strictness ($)
338{
339
1
1
1
4
  my ($name) = @_;
340
341
1
50
0
0
4
  if ($name eq 'gnu')
342    {
343
1
3
      setup_channel 'error-gnu', silent => 0;
344
1
4
      setup_channel 'error-gnu/warn', silent => 0, type => 'error';
345
1
2
      setup_channel 'error-gnits', silent => 1;
346
1
3
      setup_channel 'portability', silent => 0;
347
1
3
      setup_channel 'gnu', silent => 0;
348    }
349  elsif ($name eq 'gnits')
350    {
351
0
      setup_channel 'error-gnu', silent => 0;
352
0
      setup_channel 'error-gnu/warn', silent => 0, type => 'error';
353
0
      setup_channel 'error-gnits', silent => 0;
354
0
      setup_channel 'portability', silent => 0;
355
0
      setup_channel 'gnu', silent => 0;
356    }
357  elsif ($name eq 'foreign')
358    {
359
0
      setup_channel 'error-gnu', silent => 1;
360
0
      setup_channel 'error-gnu/warn', silent => 0, type => 'warning';
361
0
      setup_channel 'error-gnits', silent => 1;
362
0
      setup_channel 'portability', silent => 1;
363
0
      setup_channel 'gnu', silent => 1;
364    }
365  else
366    {
367
0
      prog_error "level `$name' not recognized\n";
368    }
369}
370
371=back
372
373 - 381
=head1 SEE ALSO

L<Automake::Channels>

=head1 HISTORY

Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>.

=cut
382
383### Setup "GNU" style for perl-mode and cperl-mode.
384## Local Variables:
385## perl-indent-level: 2
386## perl-continued-statement-offset: 2
387## perl-continued-brace-offset: 0
388## perl-brace-offset: 0
389## perl-brace-imaginary-offset: 0
390## perl-label-offset: -2
391## cperl-indent-level: 2
392## cperl-brace-offset: 0
393## cperl-continued-brace-offset: 0
394## cperl-label-offset: -2
395## cperl-extra-newline-before-brace: t
396## cperl-merge-trailing-else: nil
397## cperl-continued-statement-offset: 2
398## End: