lib/Automake/ChannelDefs.pm

   1 # Copyright (C) 2002-2017 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 package Automake::ChannelDefs;
  17
  18 use Automake::Config;
  19 BEGIN
  20 {
  21   if ($perl_threads)
  22     {
  23       require threads;
  24       import threads;
  25     }
  26 }
  27 use Automake::Channels;
  28
  29 =head1 NAME
  30
  31 Automake::ChannelDefs - channel definitions for Automake and helper functions
  32
  33 =head1 SYNOPSIS
  34
  35   use Automake::ChannelDefs;
  36
  37   Automake::ChannelDefs::usage ();
  38   prog_error ($MESSAGE, [%OPTIONS]);
  39   error ($WHERE, $MESSAGE, [%OPTIONS]);
  40   error ($MESSAGE);
  41   fatal ($WHERE, $MESSAGE, [%OPTIONS]);
  42   fatal ($MESSAGE);
  43   verb ($MESSAGE, [%OPTIONS]);
  44   switch_warning ($CATEGORY);
  45   parse_WARNINGS ();
  46   parse_warnings ($OPTION, $ARGUMENT);
  47   Automake::ChannelDefs::set_strictness ($STRICTNESS_NAME);
  48
  49 =head1 DESCRIPTION
  50
  51 This packages defines channels that can be used in Automake to
  52 output diagnostics and other messages (via C<msg()>).  It also defines
  53 some helper function to enable or disable these channels, and some
  54 shorthand function to output on specific channels.
  55
  56 =cut
  57
  58 use 5.006;
  59 use strict;
  60 use Exporter;
  61
  62 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 =head2 CHANNELS
  69
  70 The following channels can be used as the first argument of
  71 C<Automake::Channel::msg>.  For some of them we list a shorthand
  72 function that makes the code more readable.
  73
  74 =over 4
  75
  76 =item C<fatal>
  77
  78 Fatal errors.  Use C<&fatal> to send messages over this channel.
  79
  80 =item C<error>
  81
  82 Common errors.  Use C<&error> to send messages over this channel.
  83
  84 =item C<error-gnu>
  85
  86 Errors related to GNU Standards.
  87
  88 =item C<error-gnu/warn>
  89
  90 Errors related to GNU Standards that should be warnings in 'foreign' mode.
  91
  92 =item C<error-gnits>
  93
  94 Errors related to GNITS Standards (silent by default).
  95
  96 =item C<automake>
  97
  98 Internal errors.  Use C<&prog_error> to send messages over this channel.
  99
 100 =item C<gnu>
 101
 102 Warnings related to GNU Coding Standards.
 103
 104 =item C<obsolete>
 105
 106 Warnings about obsolete features (silent by default).
 107
 108 =item C<override>
 109
 110 Warnings about user redefinitions of Automake rules or
 111 variables (silent by default).
 112
 113 =item C<portability>
 114
 115 Warnings about non-portable constructs.
 116
 117 =item C<extra-portability>
 118
 119 Extra warnings about non-portable constructs covering obscure tools.
 120
 121 =item C<syntax>
 122
 123 Warnings about weird syntax, unused variables, typos...
 124
 125 =item C<unsupported>
 126
 127 Warnings about unsupported (or mis-supported) features.
 128
 129 =item C<verb>
 130
 131 Messages output in C<--verbose> mode.  Use C<&verb> to send such messages.
 132
 133 =item C<note>
 134
 135 Informative messages.
 136
 137 =back
 138
 139 =cut
 140
 141 # Initialize our list of error/warning channels.
 142 # Do not forget to update &usage and the manual
 143 # if you add or change a warning channel.
 144
 145 register_channel 'fatal', type => 'fatal', uniq_part => UP_NONE, ordered => 0;
 146 register_channel 'error', type => 'error';
 147 register_channel 'error-gnu', type => 'error';
 148 register_channel 'error-gnu/warn', type => 'error';
 149 register_channel 'error-gnits', type => 'error', silent => 1;
 150 register_channel 'automake', type => 'fatal', backtrace => 1,
 151   header => ("####################\n" .
 152              "## Internal Error ##\n" .
 153              "####################\n"),
 154   footer => "\nPlease contact <$PACKAGE_BUGREPORT>.",
 155   uniq_part => UP_NONE, ordered => 0;
 156
 157 register_channel 'extra-portability', type => 'warning', silent => 1;
 158 register_channel 'gnu', type => 'warning';
 159 register_channel 'obsolete', type => 'warning';
 160 register_channel 'override', type => 'warning', silent => 1;
 161 register_channel 'portability', type => 'warning', silent => 1;
 162 register_channel 'portability-recursive', type => 'warning', silent => 1;
 163 register_channel 'syntax', type => 'warning';
 164 register_channel 'unsupported', type => 'warning';
 165
 166 register_channel 'verb', type => 'debug', silent => 1, uniq_part => UP_NONE,
 167   ordered => 0;
 168 register_channel 'note', type => 'debug', silent => 0;
 169
 170 setup_channel_type 'warning', header => 'warning: ';
 171 setup_channel_type 'error', header => 'error: ';
 172 setup_channel_type 'fatal', header => 'error: ';
 173
 174 =head2 FUNCTIONS
 175
 176 =over 4
 177
 178 =item C<usage ()>
 179
 180 Display warning categories.
 181
 182 =cut
 183
 184 sub usage ()
 185 {
 186   print <<EOF;
 187 Warning categories include:
 188   gnu                GNU coding standards (default in gnu and gnits modes)
 189   obsolete           obsolete features or constructions
 190   override           user redefinitions of Automake rules or variables
 191   portability        portability issues (default in gnu and gnits modes)
 192   extra-portability  extra portability issues related to obscure tools
 193   syntax             dubious syntactic constructs (default)
 194   unsupported        unsupported or incomplete features (default)
 195   all                all the warnings
 196   no-CATEGORY        turn off warnings in CATEGORY
 197   none               turn off all the warnings
 198   error              treat warnings as errors
 199 EOF
 200 }
 201
 202 =item C<prog_error ($MESSAGE, [%OPTIONS])>
 203
 204 Signal a programming error (on channel C<automake>),
 205 display C<$MESSAGE>, and exit 1.
 206
 207 =cut
 208
 209 sub prog_error ($;%)
 210 {
 211   my ($msg, %opts) = @_;
 212   msg 'automake', '', $msg, %opts;
 213 }
 214
 215 =item C<error ($WHERE, $MESSAGE, [%OPTIONS])>
 216
 217 =item C<error ($MESSAGE)>
 218
 219 Uncategorized errors.
 220
 221 =cut
 222
 223 sub error ($;$%)
 224 {
 225   my ($where, $msg, %opts) = @_;
 226   msg ('error', $where, $msg, %opts);
 227 }
 228
 229 =item C<fatal ($WHERE, $MESSAGE, [%OPTIONS])>
 230
 231 =item C<fatal ($MESSAGE)>
 232
 233 Fatal errors.
 234
 235 =cut
 236
 237 sub fatal ($;$%)
 238 {
 239   my ($where, $msg, %opts) = @_;
 240   msg ('fatal', $where, $msg, %opts);
 241 }
 242
 243 =item C<verb ($MESSAGE, [%OPTIONS])>
 244
 245 C<--verbose> messages.
 246
 247 =cut
 248
 249 sub verb ($;%)
 250 {
 251   my ($msg, %opts) = @_;
 252   $msg = "thread " . threads->tid . ": " . $msg
 253     if $perl_threads;
 254   msg 'verb', '', $msg, %opts;
 255 }
 256
 257 =item C<switch_warning ($CATEGORY)>
 258
 259 If C<$CATEGORY> is C<mumble>, turn on channel C<mumble>.
 260 If it's C<no-mumble>, turn C<mumble> off.
 261 Else handle C<all> and C<none> for completeness.
 262
 263 =cut
 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     }
 280   elsif ($cat eq 'none')
 281     {
 282       setup_channel_type 'warning', silent => ! $has_no;
 283     }
 284   elsif ($cat eq 'error')
 285     {
 286       $warnings_are_errors = ! $has_no;
 287       # Set exit code if Perl warns about something
 288       # (like uninitialized variables).
 289       $SIG{"__WARN__"} =
 290         $has_no ? 'DEFAULT' : sub { print STDERR @_; $exit_code = 1; };
 291     }
 292   elsif (channel_type ($cat) eq 'warning')
 293     {
 294       setup_channel $cat, silent => $has_no;
 295       #
 296       # Handling of portability warnings is trickier.  For relevant tests,
 297       # see 'dollarvar2', 'extra-portability' and 'extra-portability3'.
 298       #
 299       # -Wportability-recursive and -Wno-portability-recursive should not
 300       # have any effect on other 'portability' or 'extra-portability'
 301       # warnings, so there's no need to handle them separately or ad-hoc.
 302       #
 303       if ($cat eq 'extra-portability' && ! $has_no) # -Wextra-portability
 304         {
 305           # -Wextra-portability must enable 'portability' and
 306           # 'portability-recursive' warnings.
 307           setup_channel 'portability', silent => 0;
 308           setup_channel 'portability-recursive', silent => 0;
 309         }
 310       if ($cat eq 'portability') # -Wportability or -Wno-portability
 311         {
 312           if ($has_no) # -Wno-portability
 313             {
 314               # -Wno-portability must disable 'extra-portability' and
 315               # 'portability-recursive' warnings.
 316               setup_channel 'portability-recursive', silent => 1;
 317               setup_channel 'extra-portability', silent => 1;
 318             }
 319           else # -Wportability
 320             {
 321               # -Wportability must enable 'portability-recursive'
 322               # warnings.  But it should have no influence over the
 323               # 'extra-portability' warnings.
 324               setup_channel 'portability-recursive', silent => 0;
 325             }
 326         }
 327     }
 328   else
 329     {
 330       return 1;
 331     }
 332   return 0;
 333 }
 334
 335 =item C<parse_WARNINGS ()>
 336
 337 Parse the WARNINGS environment variable.
 338
 339 =cut
 340
 341 sub parse_WARNINGS ()
 342 {
 343   if (exists $ENV{'WARNINGS'})
 344     {
 345       # Ignore unknown categories.  This is required because WARNINGS
 346       # should be honored by many tools.
 347       switch_warning $_ foreach (split (',', $ENV{'WARNINGS'}));
 348     }
 349 }
 350
 351 =item C<parse_warnings ($OPTION, $ARGUMENT)>
 352
 353 Parse the argument of C<--warning=CATEGORY> or C<-WCATEGORY>.
 354
 355 C<$OPTIONS> is C<"--warning"> or C<"-W">, C<$ARGUMENT> is C<CATEGORY>.
 356
 357 This is meant to be used as an argument to C<Getopt>.
 358
 359 =cut
 360
 361 sub parse_warnings ($$)
 362 {
 363   my ($opt, $categories) = @_;
 364
 365   foreach my $cat (split (',', $categories))
 366     {
 367       msg 'unsupported', "unknown warning category '$cat'"
 368         if switch_warning $cat;
 369     }
 370 }
 371
 372 =item C<set_strictness ($STRICTNESS_NAME)>
 373
 374 Configure channels for strictness C<$STRICTNESS_NAME>.
 375
 376 =cut
 377
 378 sub set_strictness ($)
 379 {
 380   my ($name) = @_;
 381
 382   if ($name eq 'gnu')
 383     {
 384       setup_channel 'error-gnu', silent => 0;
 385       setup_channel 'error-gnu/warn', silent => 0, type => 'error';
 386       setup_channel 'error-gnits', silent => 1;
 387       setup_channel 'portability', silent => 0;
 388       setup_channel 'extra-portability', silent => 1;
 389       setup_channel 'gnu', silent => 0;
 390     }
 391   elsif ($name eq 'gnits')
 392     {
 393       setup_channel 'error-gnu', silent => 0;
 394       setup_channel 'error-gnu/warn', silent => 0, type => 'error';
 395       setup_channel 'error-gnits', silent => 0;
 396       setup_channel 'portability', silent => 0;
 397       setup_channel 'extra-portability', silent => 1;
 398       setup_channel 'gnu', silent => 0;
 399     }
 400   elsif ($name eq 'foreign')
 401     {
 402       setup_channel 'error-gnu', silent => 1;
 403       setup_channel 'error-gnu/warn', silent => 0, type => 'warning';
 404       setup_channel 'error-gnits', silent => 1;
 405       setup_channel 'portability', silent => 1;
 406       setup_channel 'extra-portability', silent => 1;
 407       setup_channel 'gnu', silent => 1;
 408     }
 409   else
 410     {
 411       prog_error "level '$name' not recognized";
 412     }
 413 }
 414
 415 =back
 416
 417 =head1 SEE ALSO
 418
 419 L<Automake::Channels>
 420
 421 =head1 HISTORY
 422
 423 Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>.
 424
 425 =cut
 426
 427 1;