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<extra-portability>
 119
 120 Extra warnings about non-portable constructs covering obscure tools.
 121
 122 =item C<syntax>
 123
 124 Warnings about weird syntax, unused variables, typos...
 125
 126 =item C<unsupported>
 127
 128 Warnings about unsupported (or mis-supported) features.
 129
 130 =item C<verb>
 131
 132 Messages output in C<--verbose> mode.  Use C<&verb> to send such messages.
 133
 134 =item C<note>
 135
 136 Informative messages.
 137
 138 =back
 139
 140 =cut
 141
 142 # Initialize our list of error/warning channels.
 143 # Do not forget to update &usage and the manual
 144 # if you add or change a warning channel.
 145
 146 register_channel 'fatal', type => 'fatal', uniq_part => UP_NONE, ordered => 0;
 147 register_channel 'error', type => 'error';
 148 register_channel 'error-gnu', type => 'error';
 149 register_channel 'error-gnu/warn', type => 'error';
 150 register_channel 'error-gnits', type => 'error', silent => 1;
 151 register_channel 'automake', type => 'fatal', backtrace => 1,
 152   header => ("####################\n" .
 153              "## Internal Error ##\n" .
 154              "####################\n"),
 155   footer => "\nPlease contact <$PACKAGE_BUGREPORT>.",
 156   uniq_part => UP_NONE, ordered => 0;
 157
 158 register_channel 'extra-portability', type => 'warning', silent => 1;
 159 register_channel 'gnu', type => 'warning';
 160 register_channel 'obsolete', type => 'warning', silent => 1;
 161 register_channel 'override', type => 'warning', silent => 1;
 162 register_channel 'portability', type => 'warning', silent => 1;
 163 register_channel 'portability-recursive', type => 'warning', silent => 1;
 164 register_channel 'syntax', type => 'warning';
 165 register_channel 'unsupported', type => 'warning';
 166
 167 register_channel 'verb', type => 'debug', silent => 1, uniq_part => UP_NONE,
 168   ordered => 0;
 169 register_channel 'note', type => 'debug', silent => 0;
 170
 171 =head2 FUNCTIONS
 172
 173 =over 4
 174
 175 =item C<usage ()>
 176
 177 Display warning categories.
 178
 179 =cut
 180
 181 sub usage ()
 182 {
 183   print "Warning categories include:
 184   `gnu'           GNU coding standards (default in gnu and gnits modes)
 185   `obsolete'      obsolete features or constructions
 186   `override'      user redefinitions of Automake rules or variables
 187   `portability'   portability issues (default in gnu and gnits modes)
 188   `extra-portability'  extra portability issues related to obscure tools
 189   `syntax'        dubious syntactic constructs (default)
 190   `unsupported'   unsupported or incomplete features (default)
 191   `all'           all the warnings
 192   `no-CATEGORY'   turn off warnings in CATEGORY
 193   `none'          turn off all the warnings
 194   `error'         treat warnings as errors
 195 ";
 196 }
 197
 198 =item C<prog_error ($MESSAGE, [%OPTIONS])>
 199
 200 Signal a programming error (on channel C<automake>),
 201 display C<$MESSAGE>, and exit 1.
 202
 203 =cut
 204
 205 sub prog_error ($;%)
 206 {
 207   my ($msg, %opts) = @_;
 208   msg 'automake', '', $msg, %opts;
 209 }
 210
 211 =item C<error ($WHERE, $MESSAGE, [%OPTIONS])>
 212
 213 =item C<error ($MESSAGE)>
 214
 215 Uncategorized errors.
 216
 217 =cut
 218
 219 sub error ($;$%)
 220 {
 221   my ($where, $msg, %opts) = @_;
 222   msg ('error', $where, $msg, %opts);
 223 }
 224
 225 =item C<fatal ($WHERE, $MESSAGE, [%OPTIONS])>
 226
 227 =item C<fatal ($MESSAGE)>
 228
 229 Fatal errors.
 230
 231 =cut
 232
 233 sub fatal ($;$%)
 234 {
 235   my ($where, $msg, %opts) = @_;
 236   msg ('fatal', $where, $msg, %opts);
 237 }
 238
 239 =item C<verb ($MESSAGE, [%OPTIONS])>
 240
 241 C<--verbose> messages.
 242
 243 =cut
 244
 245 sub verb ($;%)
 246 {
 247   my ($msg, %opts) = @_;
 248   $msg = "thread " . threads->tid . ": " . $msg
 249     if $perl_threads;
 250   msg 'verb', '', $msg, %opts;
 251 }
 252
 253 =item C<switch_warning ($CATEGORY)>
 254
 255 If C<$CATEGORY> is C<mumble>, turn on channel C<mumble>.
 256 If it's C<no-mumble>, turn C<mumble> off.
 257 Else handle C<all> and C<none> for completeness.
 258
 259 =cut
 260
 261 # HACK to have `-Wextra-portability' *not* implied by `-Wall'.
 262 # This will go away in automake 1.12.
 263 my $have_extra_portability = 0;
 264
 265 sub switch_warning ($)
 266 {
 267   my ($cat) = @_;
 268   my $has_no = 0;
 269
 270   if ($cat =~ /^no-(.*)$/)
 271     {
 272       $cat = $1;
 273       $has_no = 1;
 274     }
 275
 276   if ($cat eq 'all')
 277     {
 278       setup_channel_type 'warning', silent => $has_no;
 279       setup_channel 'extra-portability', silent => 1
 280         unless $have_extra_portability;
 281     }
 282   elsif ($cat eq 'none')
 283     {
 284       setup_channel_type 'warning', silent => ! $has_no;
 285     }
 286   elsif ($cat eq 'error')
 287     {
 288       $warnings_are_errors = ! $has_no;
 289       # Set exit code if Perl warns about something
 290       # (like uninitialized variables).
 291       $SIG{"__WARN__"} =
 292         $has_no ? 'DEFAULT' : sub { print STDERR @_; $exit_code = 1; };
 293     }
 294   elsif (channel_type ($cat) eq 'warning')
 295     {
 296       setup_channel $cat, silent => $has_no;
 297       setup_channel 'portability-recursive', silent => $has_no
 298         if $cat eq 'portability';
 299       if ($cat eq 'portability' && $has_no)
 300         {
 301           setup_channel 'extra-portability', silent => 1;
 302           $have_extra_portability = 0;
 303         }
 304       if ($cat eq 'extra-portability' && ! $has_no)
 305         {
 306           setup_channel 'portability', silent => 0;
 307           setup_channel 'portability-recursive', silent => 0;
 308           $have_extra_portability = 1;
 309         }
 310     }
 311   else
 312     {
 313       return 1;
 314     }
 315   return 0;
 316 }
 317
 318 =item C<parse_WARNINGS ()>
 319
 320 Parse the WARNINGS environment variable.
 321
 322 =cut
 323
 324 sub parse_WARNINGS ()
 325 {
 326   if (exists $ENV{'WARNINGS'})
 327     {
 328       # Ignore unknown categories.  This is required because WARNINGS
 329       # should be honored by many tools.
 330       switch_warning $_ foreach (split (',', $ENV{'WARNINGS'}));
 331     }
 332 }
 333
 334 =item C<parse_warning ($OPTION, $ARGUMENT)>
 335
 336 Parse the argument of C<--warning=CATEGORY> or C<-WCATEGORY>.
 337
 338 C<$OPTIONS> is C<"--warning"> or C<"-W">, C<$ARGUMENT> is C<CATEGORY>.
 339
 340 This is meant to be used as an argument to C<Getopt>.
 341
 342 =cut
 343
 344 sub parse_warnings ($$)
 345 {
 346   my ($opt, $categories) = @_;
 347
 348   foreach my $cat (split (',', $categories))
 349     {
 350       msg 'unsupported', "unknown warning category `$cat'"
 351         if switch_warning $cat;
 352     }
 353 }
 354
 355 =item C<set_strictness ($STRICTNESS_NAME)>
 356
 357 Configure channels for strictness C<$STRICTNESS_NAME>.
 358
 359 =cut
 360
 361 sub set_strictness ($)
 362 {
 363   my ($name) = @_;
 364
 365   if ($name eq 'gnu')
 366     {
 367       setup_channel 'error-gnu', silent => 0;
 368       setup_channel 'error-gnu/warn', silent => 0, type => 'error';
 369       setup_channel 'error-gnits', silent => 1;
 370       setup_channel 'portability', silent => 0;
 371       setup_channel 'extra-portability', silent => 1;
 372       setup_channel 'gnu', silent => 0;
 373     }
 374   elsif ($name eq 'gnits')
 375     {
 376       setup_channel 'error-gnu', silent => 0;
 377       setup_channel 'error-gnu/warn', silent => 0, type => 'error';
 378       setup_channel 'error-gnits', silent => 0;
 379       setup_channel 'portability', silent => 0;
 380       setup_channel 'extra-portability', silent => 1;
 381       setup_channel 'gnu', silent => 0;
 382     }
 383   elsif ($name eq 'foreign')
 384     {
 385       setup_channel 'error-gnu', silent => 1;
 386       setup_channel 'error-gnu/warn', silent => 0, type => 'warning';
 387       setup_channel 'error-gnits', silent => 1;
 388       setup_channel 'portability', silent => 1;
 389       setup_channel 'extra-portability', silent => 1;
 390       setup_channel 'gnu', silent => 1;
 391     }
 392   else
 393     {
 394       prog_error "level `$name' not recognized\n";
 395     }
 396 }
 397
 398 1;
 399
 400 =back
 401
 402 =head1 SEE ALSO
 403
 404 L<Automake::Channels>
 405
 406 =head1 HISTORY
 407
 408 Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>.
 409
 410 =cut
 411
 412 ### Setup "GNU" style for perl-mode and cperl-mode.
 413 ## Local Variables:
 414 ## perl-indent-level: 2
 415 ## perl-continued-statement-offset: 2
 416 ## perl-continued-brace-offset: 0
 417 ## perl-brace-offset: 0
 418 ## perl-brace-imaginary-offset: 0
 419 ## perl-label-offset: -2
 420 ## cperl-indent-level: 2
 421 ## cperl-brace-offset: 0
 422 ## cperl-continued-brace-offset: 0
 423 ## cperl-label-offset: -2
 424 ## cperl-extra-newline-before-brace: t
 425 ## cperl-merge-trailing-else: nil
 426 ## cperl-continued-statement-offset: 2
 427 ## End: