lib/Automake/ChannelDefs.pm

   1 # Copyright (C) 2002, 2003, 2006, 2008, 2009, 2010 Free Software
   2 # Foundation, Inc.
   3
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License as published by
   6 # the Free Software Foundation; either version 2, or (at your option)
   7 # any later version.
   8
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13
  14 # You should have received a copy of the GNU General Public License
  15 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17 package Automake::ChannelDefs;
  18
  19 use Automake::Config;
  20 BEGIN
  21 {
  22   if ($perl_threads)
  23     {
  24       require threads;
  25       import threads;
  26     }
  27 }
  28 use Automake::Channels;
  29
  30 =head1 NAME
  31
  32 Automake::ChannelDefs - channel definitions for Automake and helper functions
  33
  34 =head1 SYNOPSIS
  35
  36   use Automake::ChannelDefs;
  37
  38   Automake::ChannelDefs::usage ();
  39   prog_error ($MESSAGE, [%OPTIONS]);
  40   error ($WHERE, $MESSAGE, [%OPTIONS]);
  41   error ($MESSAGE);
  42   fatal ($WHERE, $MESSAGE, [%OPTIONS]);
  43   fatal ($MESSAGE);
  44   verb ($MESSAGE, [%OPTIONS]);
  45   switch_warning ($CATEGORY);
  46   parse_WARNINGS ();
  47   parse_warning ($OPTION, $ARGUMENT);
  48   Automake::ChannelDefs::set_strictness ($STRICTNESS_NAME);
  49
  50 =head1 DESCRIPTION
  51
  52 This packages defines channels that can be used in Automake to
  53 output diagnostics and other messages (via C<msg()>).  It also defines
  54 some helper function to enable or disable these channels, and some
  55 shorthand function to output on specific channels.
  56
  57 =cut
  58
  59 use 5.005;
  60 use strict;
  61 use Exporter;
  62
  63 use vars qw (@ISA @EXPORT);
  64
  65 @ISA = qw (Exporter);
  66 @EXPORT = qw (&prog_error &error &fatal &verb
  67               &switch_warning &parse_WARNINGS &parse_warnings);
  68
  69 =head2 CHANNELS
  70
  71 The following channels can be used as the first argument of
  72 C<Automake::Channel::msg>.  For some of them we list a shorthand
  73 function that makes the code more readable.
  74
  75 =over 4
  76
  77 =item C<fatal>
  78
  79 Fatal errors.  Use C<&fatal> to send messages over this channel.
  80
  81 =item C<error>
  82
  83 Common errors.   Use C<&error> to send messages over this channel.
  84
  85 =item C<error-gnu>
  86
  87 Errors related to GNU Standards.
  88
  89 =item C<error-gnu/warn>
  90
  91 Errors related to GNU Standards that should be warnings in `foreign' mode.
  92
  93 =item C<error-gnits>
  94
  95 Errors related to GNITS Standards (silent by default).
  96
  97 =item C<automake>
  98
  99 Internal errors.  Use C<&prog_error> to send messages over this channel.
 100
 101 =item C<gnu>
 102
 103 Warnings related to GNU Coding Standards.
 104
 105 =item C<obsolete>
 106
 107 Warnings about obsolete features (silent by default).
 108
 109 =item C<override>
 110
 111 Warnings about user redefinitions of Automake rules or
 112 variables (silent by default).
 113
 114 =item C<portability>
 115
 116 Warnings about non-portable constructs.
 117
 118 =item C<syntax>
 119
 120 Warnings about weird syntax, unused variables, typos...
 121
 122 =item C<unsupported>
 123
 124 Warnings about unsupported (or mis-supported) features.
 125
 126 =item C<verb>
 127
 128 Messages output in C<--verbose> mode.  Use C<&verb> to send such messages.
 129
 130 =item C<note>
 131
 132 Informative messages.
 133
 134 =back
 135
 136 =cut
 137
 138 # Initialize our list of error/warning channels.
 139 # Do not forget to update &usage and the manual
 140 # if you add or change a warning channel.
 141
 142 register_channel 'fatal', type => 'fatal', uniq_part => UP_NONE, ordered => 0;
 143 register_channel 'error', type => 'error';
 144 register_channel 'error-gnu', type => 'error';
 145 register_channel 'error-gnu/warn', type => 'error';
 146 register_channel 'error-gnits', type => 'error', silent => 1;
 147 register_channel 'automake', type => 'fatal', backtrace => 1,
 148   header => ("####################\n" .
 149              "## Internal Error ##\n" .
 150              "####################\n"),
 151   footer => "\nPlease contact <$PACKAGE_BUGREPORT>.",
 152   uniq_part => UP_NONE, ordered => 0;
 153
 154 register_channel 'gnu', type => 'warning';
 155 register_channel 'obsolete', type => 'warning', silent => 1;
 156 register_channel 'override', type => 'warning', silent => 1;
 157 register_channel 'portability', type => 'warning', silent => 1;
 158 register_channel 'portability-recursive', type => 'warning', silent => 1;
 159 register_channel 'syntax', type => 'warning';
 160 register_channel 'unsupported', type => 'warning';
 161
 162 register_channel 'verb', type => 'debug', silent => 1, uniq_part => UP_NONE,
 163   ordered => 0;
 164 register_channel 'note', type => 'debug', silent => 0;
 165
 166 =head2 FUNCTIONS
 167
 168 =over 4
 169
 170 =item C<usage ()>
 171
 172 Display warning categories.
 173
 174 =cut
 175
 176 sub usage ()
 177 {
 178   print "Warning categories include:
 179   `gnu'           GNU coding standards (default in gnu and gnits modes)
 180   `obsolete'      obsolete features or constructions
 181   `override'      user redefinitions of Automake rules or variables
 182   `portability'   portability issues (default in gnu and gnits modes)
 183   `syntax'        dubious syntactic constructs (default)
 184   `unsupported'   unsupported or incomplete features (default)
 185   `all'           all the warnings
 186   `no-CATEGORY'   turn off warnings in CATEGORY
 187   `none'          turn off all the warnings
 188   `error'         treat warnings as errors
 189 ";
 190 }
 191
 192 =item C<prog_error ($MESSAGE, [%OPTIONS])>
 193
 194 Signal a programming error (on channel C<automake>),
 195 display C<$MESSAGE>, and exit 1.
 196
 197 =cut
 198
 199 sub prog_error ($;%)
 200 {
 201   my ($msg, %opts) = @_;
 202   msg 'automake', '', $msg, %opts;
 203 }
 204
 205 =item C<error ($WHERE, $MESSAGE, [%OPTIONS])>
 206
 207 =item C<error ($MESSAGE)>
 208
 209 Uncategorized errors.
 210
 211 =cut
 212
 213 sub error ($;$%)
 214 {
 215   my ($where, $msg, %opts) = @_;
 216   msg ('error', $where, $msg, %opts);
 217 }
 218
 219 =item C<fatal ($WHERE, $MESSAGE, [%OPTIONS])>
 220
 221 =item C<fatal ($MESSAGE)>
 222
 223 Fatal errors.
 224
 225 =cut
 226
 227 sub fatal ($;$%)
 228 {
 229   my ($where, $msg, %opts) = @_;
 230   msg ('fatal', $where, $msg, %opts);
 231 }
 232
 233 =item C<verb ($MESSAGE, [%OPTIONS])>
 234
 235 C<--verbose> messages.
 236
 237 =cut
 238
 239 sub verb ($;%)
 240 {
 241   my ($msg, %opts) = @_;
 242   $msg = "thread " . threads->tid . ": " . $msg
 243     if $perl_threads;
 244   msg 'verb', '', $msg, %opts;
 245 }
 246
 247 =item C<switch_warning ($CATEGORY)>
 248
 249 If C<$CATEGORY> is C<mumble>, turn on channel C<mumble>.
 250 If it's C<no-mumble>, turn C<mumble> off.
 251 Else handle C<all> and C<none> for completeness.
 252
 253 =cut
 254
 255 sub switch_warning ($)
 256 {
 257   my ($cat) = @_;
 258   my $has_no = 0;
 259
 260   if ($cat =~ /^no-(.*)$/)
 261     {
 262       $cat = $1;
 263       $has_no = 1;
 264     }
 265
 266   if ($cat eq 'all')
 267     {
 268       setup_channel_type 'warning', silent => $has_no;
 269     }
 270   elsif ($cat eq 'none')
 271     {
 272       setup_channel_type 'warning', silent => ! $has_no;
 273     }
 274   elsif ($cat eq 'error')
 275     {
 276       $warnings_are_errors = ! $has_no;
 277       # Set exit code if Perl warns about something
 278       # (like uninitialized variables).
 279       $SIG{"__WARN__"} =
 280         $has_no ? 'DEFAULT' : sub { print STDERR @_; $exit_code = 1; };
 281     }
 282   elsif (channel_type ($cat) eq 'warning')
 283     {
 284       setup_channel $cat, silent => $has_no;
 285       setup_channel 'portability-recursive', silent => $has_no
 286         if $cat eq 'portability';
 287     }
 288   else
 289     {
 290       return 1;
 291     }
 292   return 0;
 293 }
 294
 295 =item C<parse_WARNINGS ()>
 296
 297 Parse the WARNINGS environment variable.
 298
 299 =cut
 300
 301 sub parse_WARNINGS ()
 302 {
 303   if (exists $ENV{'WARNINGS'})
 304     {
 305       # Ignore unknown categories.  This is required because WARNINGS
 306       # should be honored by many tools.
 307       switch_warning $_ foreach (split (',', $ENV{'WARNINGS'}));
 308     }
 309 }
 310
 311 =item C<parse_warning ($OPTION, $ARGUMENT)>
 312
 313 Parse the argument of C<--warning=CATEGORY> or C<-WCATEGORY>.
 314
 315 C<$OPTIONS> is C<"--warning"> or C<"-W">, C<$ARGUMENT> is C<CATEGORY>.
 316
 317 This is meant to be used as an argument to C<Getopt>.
 318
 319 =cut
 320
 321 sub parse_warnings ($$)
 322 {
 323   my ($opt, $categories) = @_;
 324
 325   foreach my $cat (split (',', $categories))
 326     {
 327       msg 'unsupported', "unknown warning category `$cat'"
 328         if switch_warning $cat;
 329     }
 330 }
 331
 332 =item C<set_strictness ($STRICTNESS_NAME)>
 333
 334 Configure channels for strictness C<$STRICTNESS_NAME>.
 335
 336 =cut
 337
 338 sub set_strictness ($)
 339 {
 340   my ($name) = @_;
 341
 342   if ($name eq 'gnu')
 343     {
 344       setup_channel 'error-gnu', silent => 0;
 345       setup_channel 'error-gnu/warn', silent => 0, type => 'error';
 346       setup_channel 'error-gnits', silent => 1;
 347       setup_channel 'portability', silent => 0;
 348       setup_channel 'gnu', silent => 0;
 349     }
 350   elsif ($name eq 'gnits')
 351     {
 352       setup_channel 'error-gnu', silent => 0;
 353       setup_channel 'error-gnu/warn', silent => 0, type => 'error';
 354       setup_channel 'error-gnits', silent => 0;
 355       setup_channel 'portability', silent => 0;
 356       setup_channel 'gnu', silent => 0;
 357     }
 358   elsif ($name eq 'foreign')
 359     {
 360       setup_channel 'error-gnu', silent => 1;
 361       setup_channel 'error-gnu/warn', silent => 0, type => 'warning';
 362       setup_channel 'error-gnits', silent => 1;
 363       setup_channel 'portability', silent => 1;
 364       setup_channel 'gnu', silent => 1;
 365     }
 366   else
 367     {
 368       prog_error "level `$name' not recognized\n";
 369     }
 370 }
 371
 372 =back
 373
 374 =head1 SEE ALSO
 375
 376 L<Automake::Channels>
 377
 378 =head1 HISTORY
 379
 380 Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>.
 381
 382 =cut
 383
 384 ### Setup "GNU" style for perl-mode and cperl-mode.
 385 ## Local Variables:
 386 ## perl-indent-level: 2
 387 ## perl-continued-statement-offset: 2
 388 ## perl-continued-brace-offset: 0
 389 ## perl-brace-offset: 0
 390 ## perl-brace-imaginary-offset: 0
 391 ## perl-label-offset: -2
 392 ## cperl-indent-level: 2
 393 ## cperl-brace-offset: 0
 394 ## cperl-continued-brace-offset: 0
 395 ## cperl-label-offset: -2
 396 ## cperl-extra-newline-before-brace: t
 397 ## cperl-merge-trailing-else: nil
 398 ## cperl-continued-statement-offset: 2
 399 ## End: