lib/Automake/ChannelDefs.pm

   1 # Copyright (C) 2002-2024 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 ##################################################################
  17 # The master copy of this file is in Automake's source repository.
  18 # Please send updates to automake-patches@gnu.org.
  19 ##################################################################
  20
  21 package Automake::ChannelDefs;
  22
  23 =head1 NAME
  24
  25 Automake::ChannelDefs - channel definitions for Automake and helper functions
  26
  27 =head1 SYNOPSIS
  28
  29   use Automake::ChannelDefs;
  30
  31   print Automake::ChannelDefs::usage (), "\n";
  32   prog_error ($MESSAGE, [%OPTIONS]);
  33   error ($WHERE, $MESSAGE, [%OPTIONS]);
  34   error ($MESSAGE);
  35   fatal ($WHERE, $MESSAGE, [%OPTIONS]);
  36   fatal ($MESSAGE);
  37   verb ($MESSAGE, [%OPTIONS]);
  38   switch_warning ($CATEGORY);
  39   parse_WARNINGS ();
  40   parse_warnings ($OPTION, @ARGUMENT);
  41   Automake::ChannelDefs::set_strictness ($STRICTNESS_NAME);
  42
  43 =head1 DESCRIPTION
  44
  45 This package defines channels that can be used in Automake to
  46 output diagnostics and other messages (via C<msg()>).  It also defines
  47 some helper function to enable or disable these channels, and some
  48 shorthand function to output on specific channels.
  49
  50 =cut
  51
  52 use 5.006;
  53 use strict;
  54 use warnings FATAL => 'all';
  55
  56 use Exporter;
  57
  58 use Automake::Channels;
  59 use Automake::Config;
  60 BEGIN
  61 {
  62   if ($perl_threads)
  63     {
  64       require threads;
  65       import threads;
  66     }
  67 }
  68
  69 our @ISA = qw (Exporter);
  70 our @EXPORT = qw (&prog_error &error &fatal &verb
  71                   &switch_warning &parse_WARNINGS &parse_warnings
  72                   &merge_WARNINGS);
  73
  74 =head2 CHANNELS
  75
  76 The following channels can be used as the first argument of
  77 C<Automake::Channels::msg>.  For some of them we list a shorthand
  78 function that makes the code more readable.
  79
  80 =over 4
  81
  82 =item C<fatal>
  83
  84 Fatal errors.  Use C<&fatal> to send messages over this channel.
  85
  86 =item C<error>
  87
  88 Common errors.  Use C<&error> to send messages over this channel.
  89
  90 =item C<error-gnu>
  91
  92 Errors related to GNU Standards.
  93
  94 =item C<error-gnu/warn>
  95
  96 Errors related to GNU Standards that should be warnings in 'foreign' mode.
  97
  98 =item C<error-gnits>
  99
 100 Errors related to GNITS Standards (silent by default).
 101
 102 =item C<automake>
 103
 104 Internal errors.  Use C<&prog_error> to send messages over this channel.
 105
 106 =item C<cross>
 107
 108 Constructs compromising the cross-compilation of the package.
 109
 110 =item C<gnu>
 111
 112 Warnings related to GNU Coding Standards.
 113
 114 =item C<obsolete>
 115
 116 Warnings about obsolete features.
 117
 118 =item C<override>
 119
 120 Warnings about user redefinitions of Automake rules or
 121 variables (silent by default).
 122
 123 =item C<portability>
 124
 125 Warnings about non-portable constructs.
 126
 127 =item C<portability-recursive>
 128
 129 Warnings about recursive variable expansions (C<$(foo$(x))>).
 130 These are not universally supported, but are more portable than
 131 the other non-portable constructs diagnosed by C<-Wportability>.
 132 These warnings are turned on by C<-Wportability> but can then be
 133 turned off separately by C<-Wno-portability-recursive>.
 134
 135 =item C<extra-portability>
 136
 137 Extra warnings about non-portable constructs covering obscure tools.
 138
 139 =item C<syntax>
 140
 141 Warnings about weird syntax, unused variables, typos...
 142
 143 =item C<unsupported>
 144
 145 Warnings about unsupported (or mis-supported) features.
 146
 147 =item C<verb>
 148
 149 Messages output in C<--verbose> mode.  Use C<&verb> to send such messages.
 150
 151 =item C<note>
 152
 153 Informative messages.
 154
 155 =back
 156
 157 =cut
 158
 159 # Initialize our list of error/warning channels.
 160 # Do not forget to update &usage and the manual
 161 # if you add or change a warning channel.
 162
 163 register_channel 'fatal', type => 'fatal', uniq_part => UP_NONE, ordered => 0;
 164 register_channel 'error', type => 'error';
 165 register_channel 'error-gnu', type => 'error';
 166 register_channel 'error-gnu/warn', type => 'error';
 167 register_channel 'error-gnits', type => 'error', silent => 1;
 168 register_channel 'automake', type => 'fatal', backtrace => 1,
 169   header => ("####################\n" .
 170              "## Internal Error ##\n" .
 171              "####################\n"),
 172   footer => "\nPlease contact <$PACKAGE_BUGREPORT>.",
 173   uniq_part => UP_NONE, ordered => 0;
 174
 175 register_channel 'cross', type => 'warning', silent => 1;
 176 register_channel 'gnu', type => 'warning';
 177 register_channel 'obsolete', type => 'warning';
 178 register_channel 'override', type => 'warning', silent => 1;
 179 register_channel 'portability', type => 'warning', silent => 1;
 180 register_channel 'extra-portability', type => 'warning', silent => 1;
 181 register_channel 'portability-recursive', type => 'warning', silent => 1;
 182 register_channel 'syntax', type => 'warning';
 183 register_channel 'unsupported', type => 'warning';
 184
 185 register_channel 'verb', type => 'debug', silent => 1, uniq_part => UP_NONE,
 186   ordered => 0;
 187 register_channel 'note', type => 'debug', silent => 0;
 188
 189 setup_channel_type 'warning', header => 'warning: ';
 190 setup_channel_type 'error', header => 'error: ';
 191 setup_channel_type 'fatal', header => 'error: ';
 192
 193 =head2 FUNCTIONS
 194
 195 =over 4
 196
 197 =item C<usage ()>
 198
 199 Return the warning category descriptions.
 200
 201 =cut
 202
 203 sub usage ()
 204 {
 205   return "Warning categories are:
 206   cross                  cross compilation issues
 207   gnu                    GNU coding standards (default in gnu and gnits modes)
 208   obsolete               obsolete features or constructions (default)
 209   override               user redefinitions of Automake rules or variables
 210   portability            portability issues (default in gnu and gnits modes)
 211   portability-recursive  nested Make variables (default with -Wportability)
 212   extra-portability      extra portability issues related to obscure tools
 213   syntax                 dubious syntactic constructs (default)
 214   unsupported            unsupported or incomplete features (default)
 215
 216 -W also understands:
 217   all                    turn on all the warnings
 218   none                   turn off all the warnings
 219   no-CATEGORY            turn off warnings in CATEGORY
 220   error                  treat all enabled warnings as errors";
 221 }
 222
 223 =item C<prog_error ($MESSAGE, [%OPTIONS])>
 224
 225 Signal a programming error (on channel C<automake>),
 226 display C<$MESSAGE>, and exit 1.
 227
 228 =cut
 229
 230 sub prog_error ($;%)
 231 {
 232   my ($msg, %opts) = @_;
 233   msg 'automake', '', $msg, %opts;
 234 }
 235
 236 =item C<error ($WHERE, $MESSAGE, [%OPTIONS])>
 237
 238 =item C<error ($MESSAGE)>
 239
 240 Uncategorized errors.
 241
 242 =cut
 243
 244 sub error ($;$%)
 245 {
 246   my ($where, $msg, %opts) = @_;
 247   msg ('error', $where, $msg, %opts);
 248 }
 249
 250 =item C<fatal ($WHERE, $MESSAGE, [%OPTIONS])>
 251
 252 =item C<fatal ($MESSAGE)>
 253
 254 Fatal errors.
 255
 256 =cut
 257
 258 sub fatal ($;$%)
 259 {
 260   my ($where, $msg, %opts) = @_;
 261   msg ('fatal', $where, $msg, %opts);
 262 }
 263
 264 =item C<verb ($MESSAGE, [%OPTIONS])>
 265
 266 C<--verbose> messages.
 267
 268 =cut
 269
 270 sub verb ($;%)
 271 {
 272   my ($msg, %opts) = @_;
 273   $msg = "thread " . threads->tid . ": " . $msg
 274     if $perl_threads;
 275   msg 'verb', '', $msg, %opts;
 276 }
 277
 278 =item C<switch_warning ($CATEGORY)>
 279
 280 If C<$CATEGORY> is C<mumble>, turn on channel C<mumble>.
 281 If it is C<no-mumble>, turn C<mumble> off.
 282 Else handle C<all> and C<none> for completeness.
 283
 284 =cut
 285
 286 sub switch_warning ($)
 287 {
 288   my ($cat) = @_;
 289   my $has_no = 0;
 290
 291   if ($cat =~ /^no-(.*)$/)
 292     {
 293       $cat = $1;
 294       $has_no = 1;
 295     }
 296
 297   if ($cat eq 'all')
 298     {
 299       setup_channel_type 'warning', silent => $has_no;
 300     }
 301   elsif ($cat eq 'none')
 302     {
 303       setup_channel_type 'warning', silent => ! $has_no;
 304     }
 305   elsif ($cat eq 'error')
 306     {
 307       $warnings_are_errors = ! $has_no;
 308       # Set exit code if Perl warns about something
 309       # (like uninitialized variables).
 310       $SIG{"__WARN__"} =
 311         $has_no ? 'DEFAULT' : sub { print STDERR @_; $exit_code = 1; };
 312     }
 313   elsif (channel_type ($cat) eq 'warning')
 314     {
 315       setup_channel $cat, silent => $has_no;
 316       #
 317       # Handling of portability warnings is trickier.  For relevant tests,
 318       # see 'dollarvar2', 'extra-portability' and 'extra-portability3'.
 319       #
 320       # -Wportability-recursive and -Wno-portability-recursive should not
 321       # have any effect on other 'portability' or 'extra-portability'
 322       # warnings, so there's no need to handle them separately or ad-hoc.
 323       #
 324       if ($cat eq 'extra-portability' && ! $has_no) # -Wextra-portability
 325         {
 326           # -Wextra-portability must enable 'portability' and
 327           # 'portability-recursive' warnings.
 328           setup_channel 'portability', silent => 0;
 329           setup_channel 'portability-recursive', silent => 0;
 330         }
 331       if ($cat eq 'portability') # -Wportability or -Wno-portability
 332         {
 333           if ($has_no) # -Wno-portability
 334             {
 335               # -Wno-portability must disable 'extra-portability' and
 336               # 'portability-recursive' warnings.
 337               setup_channel 'portability-recursive', silent => 1;
 338               setup_channel 'extra-portability', silent => 1;
 339             }
 340           else # -Wportability
 341             {
 342               # -Wportability must enable 'portability-recursive'
 343               # warnings.  But it should have no influence over the
 344               # 'extra-portability' warnings.
 345               setup_channel 'portability-recursive', silent => 0;
 346             }
 347         }
 348     }
 349   else
 350     {
 351       return 1;
 352     }
 353   return 0;
 354 }
 355
 356 =item C<parse_WARNINGS ()>
 357
 358 Parse the WARNINGS environment variable.
 359
 360 =cut
 361
 362 # Used to communicate from parse_WARNINGS to parse_warnings.
 363 our $_werror = 0;
 364
 365 sub parse_WARNINGS ()
 366 {
 367   if (exists $ENV{'WARNINGS'})
 368     {
 369       # Ignore unknown categories.  This is required because WARNINGS
 370       # should be honored by many tools.
 371       # For the same reason, do not turn on -Werror at this point, just
 372       # record that we saw it; parse_warnings will turn on -Werror after
 373       # the command line has been processed.
 374       foreach (split (',', $ENV{'WARNINGS'}))
 375         {
 376           if (/^(no-)?error$/)
 377             {
 378               $_werror = !defined $1;
 379             }
 380           else
 381             {
 382               switch_warning $_;
 383             }
 384         }
 385     }
 386 }
 387
 388 =item C<parse_warnings (@CATEGORIES)>
 389
 390 Parse the argument of C<--warning=CATEGORY> or C<-WCATEGORY>.
 391 C<@CATEGORIES> is the accumulated set of warnings categories.
 392 Use like this:
 393
 394     Automake::GetOpt::parse_options (
 395         # ...
 396         'W|warnings=s' => \@warnings,
 397     )
 398     # possibly call set_strictness here
 399     parse_warnings @warnings;
 400
 401 =cut
 402
 403 sub parse_warnings (@)
 404 {
 405   foreach my $cat (map { split ',' } @_)
 406     {
 407       if ($cat =~ /^(no-)?error$/)
 408         {
 409           $_werror = !defined $1;
 410         }
 411       elsif (switch_warning $cat)
 412         {
 413           msg 'unsupported', "unknown warning category '$cat'";
 414         }
 415     }
 416
 417   switch_warning ($_werror ? 'error' : 'no-error');
 418 }
 419
 420 =item C<merge_WARNINGS (@CATEGORIES)>
 421
 422 Merge the warnings categories in the environment variable C<WARNINGS>
 423 with the warnings categories in C<@CATEGORIES>, and return a new
 424 value for C<WARNINGS>.  Values in C<@CATEGORIES> take precedence.
 425 Use like this:
 426
 427     local $ENV{WARNINGS} = merge_WARNINGS @additional_warnings;
 428
 429 =cut
 430
 431 sub merge_WARNINGS (@)
 432 {
 433   my $werror = '';
 434   my $all_or_none = '';
 435   my %warnings;
 436
 437   my @categories = split /,/, $ENV{WARNINGS} || '';
 438   push @categories, @_;
 439
 440   foreach (@categories)
 441     {
 442       if (/^(?:no-)?error$/)
 443         {
 444           $werror = $_;
 445         }
 446       elsif (/^(?:all|none)$/)
 447         {
 448           $all_or_none = $_;
 449         }
 450       else
 451         {
 452           # The character class in the second match group is ASCII \S minus
 453           # comma.  We are generous with this because category values may come
 454           # from WARNINGS and we don't want to assume what other programs'
 455           # syntaxes for warnings categories are.
 456           /^(no-|)([\w\[\]\/\\!"#$%&'()*+-.:;<=>?@^`{|}~]+)$/
 457             or die "Invalid warnings category: $_";
 458           $warnings{$2} = $1;
 459         }
 460     }
 461
 462   my @final_warnings;
 463   if ($all_or_none)
 464     {
 465       push @final_warnings, $all_or_none;
 466     }
 467   else
 468     {
 469       foreach (sort keys %warnings)
 470         {
 471           push @final_warnings, $warnings{$_} . $_;
 472         }
 473     }
 474   if ($werror)
 475     {
 476       push @final_warnings, $werror;
 477     }
 478
 479   return join (',', @final_warnings);
 480 }
 481
 482 =item C<set_strictness ($STRICTNESS_NAME)>
 483
 484 Configure channels for strictness C<$STRICTNESS_NAME>.
 485
 486 =cut
 487
 488 sub set_strictness ($)
 489 {
 490   my ($name) = @_;
 491
 492   if ($name eq 'gnu')
 493     {
 494       setup_channel 'error-gnu', silent => 0;
 495       setup_channel 'error-gnu/warn', silent => 0, type => 'error';
 496       setup_channel 'error-gnits', silent => 1;
 497       setup_channel 'portability', silent => 0;
 498       setup_channel 'extra-portability', silent => 1;
 499       setup_channel 'gnu', silent => 0;
 500     }
 501   elsif ($name eq 'gnits')
 502     {
 503       setup_channel 'error-gnu', silent => 0;
 504       setup_channel 'error-gnu/warn', silent => 0, type => 'error';
 505       setup_channel 'error-gnits', silent => 0;
 506       setup_channel 'portability', silent => 0;
 507       setup_channel 'extra-portability', silent => 1;
 508       setup_channel 'gnu', silent => 0;
 509     }
 510   elsif ($name eq 'foreign')
 511     {
 512       setup_channel 'error-gnu', silent => 1;
 513       setup_channel 'error-gnu/warn', silent => 0, type => 'warning';
 514       setup_channel 'error-gnits', silent => 1;
 515       setup_channel 'portability', silent => 1;
 516       setup_channel 'extra-portability', silent => 1;
 517       setup_channel 'gnu', silent => 1;
 518     }
 519   else
 520     {
 521       prog_error "level '$name' not recognized";
 522     }
 523 }
 524
 525 =back
 526
 527 =head1 SEE ALSO
 528
 529 L<Automake::Channels>
 530
 531 =head1 HISTORY
 532
 533 Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>.
 534
 535 =cut
 536
 537 1;
 538
 539 ### Setup "GNU" style for perl-mode and cperl-mode.
 540 ## Local Variables:
 541 ## perl-indent-level: 2
 542 ## perl-continued-statement-offset: 2
 543 ## perl-continued-brace-offset: 0
 544 ## perl-brace-offset: 0
 545 ## perl-brace-imaginary-offset: 0
 546 ## perl-label-offset: -2
 547 ## cperl-indent-level: 2
 548 ## cperl-brace-offset: 0
 549 ## cperl-continued-brace-offset: 0
 550 ## cperl-label-offset: -2
 551 ## cperl-extra-newline-before-brace: t
 552 ## cperl-merge-trailing-else: nil
 553 ## cperl-continued-statement-offset: 2
 554 ## End: