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