File: | /tmp/automake/lib/Automake/ChannelDefs.pm |
Coverage: | 95.2% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
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 | 2212 2212 2212 | 6442 2087 7068 | use Automake::Config; | ||||
20 | BEGIN | ||||||
21 | { | ||||||
22 | 2212 | 15467 | if ($perl_threads) | ||||
23 | { | ||||||
24 | 2212 | 10755 | require threads; | ||||
25 | 2212 | 7153 | import threads; | ||||
26 | } | ||||||
27 | } | ||||||
28 | 2212 2212 2212 | 11786 2290 10366 | use Automake::Channels; | ||||
29 | |||||||
30 - 57 | =head1 NAME Automake::ChannelDefs - channel definitions for Automake and helper functions =head1 SYNOPSIS use Automake::ChannelDefs; Automake::ChannelDefs::usage (); prog_error ($MESSAGE, [%OPTIONS]); error ($WHERE, $MESSAGE, [%OPTIONS]); error ($MESSAGE); fatal ($WHERE, $MESSAGE, [%OPTIONS]); fatal ($MESSAGE); verb ($MESSAGE, [%OPTIONS]); switch_warning ($CATEGORY); parse_WARNINGS (); parse_warnings ($OPTION, $ARGUMENT); Automake::ChannelDefs::set_strictness ($STRICTNESS_NAME); =head1 DESCRIPTION This packages defines channels that can be used in Automake to output diagnostics and other messages (via C<msg()>). It also defines some helper function to enable or disable these channels, and some shorthand function to output on specific channels. =cut | ||||||
58 | |||||||
59 | 2212 2212 2212 | 40029 5616 2514 | use 5.005; | ||||
60 | 2212 2212 2212 | 7480 2236 5911 | use strict; | ||||
61 | 2212 2212 2212 | 7762 2591 9467 | use Exporter; | ||||
62 | |||||||
63 | 2212 2212 2212 | 7928 7040 6075 | 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 - 136 | =head2 CHANNELS The following channels can be used as the first argument of C<Automake::Channel::msg>. For some of them we list a shorthand function that makes the code more readable. =over 4 =item C<fatal> Fatal errors. Use C<&fatal> to send messages over this channel. =item C<error> Common errors. Use C<&error> to send messages over this channel. =item C<error-gnu> Errors related to GNU Standards. =item C<error-gnu/warn> Errors related to GNU Standards that should be warnings in `foreign' mode. =item C<error-gnits> Errors related to GNITS Standards (silent by default). =item C<automake> Internal errors. Use C<&prog_error> to send messages over this channel. =item C<gnu> Warnings related to GNU Coding Standards. =item C<obsolete> Warnings about obsolete features (silent by default). =item C<override> Warnings about user redefinitions of Automake rules or variables (silent by default). =item C<portability> Warnings about non-portable constructs. =item C<syntax> Warnings about weird syntax, unused variables, typos... =item C<unsupported> Warnings about unsupported (or mis-supported) features. =item C<verb> Messages output in C<--verbose> mode. Use C<&verb> to send such messages. =item C<note> Informative messages. =back =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 | setup_channel_type 'warning', header => 'warning: '; | ||||||
167 | setup_channel_type 'error', header => 'error: '; | ||||||
168 | setup_channel_type 'fatal', header => 'error: '; | ||||||
169 | |||||||
170 - 178 | =head2 FUNCTIONS =over 4 =item C<usage ()> Display warning categories. =cut | ||||||
179 | |||||||
180 | sub usage () | ||||||
181 | { | ||||||
182 | 7 | 1 | 22 | print "Warning categories include: | |||
183 | `gnu' GNU coding standards (default in gnu and gnits modes) | ||||||
184 | `obsolete' obsolete features or constructions | ||||||
185 | `override' user redefinitions of Automake rules or variables | ||||||
186 | `portability' portability issues (default in gnu and gnits modes) | ||||||
187 | `syntax' dubious syntactic constructs (default) | ||||||
188 | `unsupported' unsupported or incomplete features (default) | ||||||
189 | `all' all the warnings | ||||||
190 | `no-CATEGORY' turn off warnings in CATEGORY | ||||||
191 | `none' turn off all the warnings | ||||||
192 | `error' treat warnings as errors | ||||||
193 | "; | ||||||
194 | } | ||||||
195 | |||||||
196 - 201 | =item C<prog_error ($MESSAGE, [%OPTIONS])> Signal a programming error (on channel C<automake>), display C<$MESSAGE>, and exit 1. =cut | ||||||
202 | |||||||
203 | sub prog_error ($;%) | ||||||
204 | { | ||||||
205 | 8 | 1 | 240 | my ($msg, %opts) = @_; | |||
206 | 8 | 254 | msg 'automake', '', $msg, %opts; | ||||
207 | } | ||||||
208 | |||||||
209 - 215 | =item C<error ($WHERE, $MESSAGE, [%OPTIONS])> =item C<error ($MESSAGE)> Uncategorized errors. =cut | ||||||
216 | |||||||
217 | sub error ($;$%) | ||||||
218 | { | ||||||
219 | 223 | 1 | 698 | my ($where, $msg, %opts) = @_; | |||
220 | 223 | 809 | msg ('error', $where, $msg, %opts); | ||||
221 | } | ||||||
222 | |||||||
223 - 229 | =item C<fatal ($WHERE, $MESSAGE, [%OPTIONS])> =item C<fatal ($MESSAGE)> Fatal errors. =cut | ||||||
230 | |||||||
231 | sub fatal ($;$%) | ||||||
232 | { | ||||||
233 | 35 | 1 | 161 | my ($where, $msg, %opts) = @_; | |||
234 | 35 | 229 | msg ('fatal', $where, $msg, %opts); | ||||
235 | } | ||||||
236 | |||||||
237 - 241 | =item C<verb ($MESSAGE, [%OPTIONS])> C<--verbose> messages. =cut | ||||||
242 | |||||||
243 | sub verb ($;%) | ||||||
244 | { | ||||||
245 | 311365 | 1 | 590364 | my ($msg, %opts) = @_; | |||
246 | 311365 | 879461 | $msg = "thread " . threads->tid . ": " . $msg | ||||
247 | if $perl_threads; | ||||||
248 | 311365 | 909021 | msg 'verb', '', $msg, %opts; | ||||
249 | } | ||||||
250 | |||||||
251 - 258 | =item C<switch_warning ($CATEGORY, $WHERE)> If C<$CATEGORY> is C<mumble>, turn on channel C<mumble>. If it's C<no-mumble>, turn C<mumble> off. Else handle C<all> and C<none> for completeness. The warnings has been set at location C<$WHERE>. =cut | ||||||
259 | |||||||
260 | sub switch_warning ($;$) | ||||||
261 | { | ||||||
262 | 3397 | 1 | 7949 | my ($cat, $where) = @_; | |||
263 | 3397 | 10437 | my $has_no = 0; | ||||
264 | |||||||
265 | 3397 | 12134 | if ($cat =~ /^no-(.*)$/) | ||||
266 | { | ||||||
267 | 155 | 430 | $cat = $1; | ||||
268 | 155 | 253 | $has_no = 1; | ||||
269 | } | ||||||
270 | |||||||
271 | 3397 | 17578 | if ($cat eq 'all') | ||||
272 | { | ||||||
273 | 1105 | 4193 | setup_channel_type 'warning', silent => $has_no; | ||||
274 | } | ||||||
275 | elsif ($cat eq 'none') | ||||||
276 | { | ||||||
277 | 8 | 27 | setup_channel_type 'warning', silent => ! $has_no; | ||||
278 | } | ||||||
279 | elsif ($cat eq 'error') | ||||||
280 | { | ||||||
281 | 2137 | 9740 | setup_warnings_as_errors (! $has_no, $where); | ||||
282 | # Set exit code if Perl warns about something | ||||||
283 | # (like uninitialized variables). | ||||||
284 | $SIG{"__WARN__"} = | ||||||
285 | 2137 0 0 | 16309 0 0 | $has_no ? 'DEFAULT' : sub { print STDERR @_; $exit_code = 1; }; | ||||
286 | } | ||||||
287 | elsif (channel_type ($cat) eq 'warning') | ||||||
288 | { | ||||||
289 | 145 | 568 | setup_channel $cat, silent => $has_no; | ||||
290 | 145 | 572 | setup_channel 'portability-recursive', silent => $has_no | ||||
291 | if $cat eq 'portability'; | ||||||
292 | } | ||||||
293 | else | ||||||
294 | { | ||||||
295 | 2 | 15 | return 1; | ||||
296 | } | ||||||
297 | 3395 | 16947 | return 0; | ||||
298 | } | ||||||
299 | |||||||
300 - 304 | =item C<parse_WARNINGS ()> Parse the WARNINGS environment variable. =cut | ||||||
305 | |||||||
306 | sub parse_WARNINGS () | ||||||
307 | { | ||||||
308 | 2200 | 1 | 12599 | if (exists $ENV{'WARNINGS'}) | |||
309 | { | ||||||
310 | # Ignore unknown categories. This is required because WARNINGS | ||||||
311 | # should be honored by many tools. | ||||||
312 | 1 1 | 1 6 | switch_warning $_ foreach (split (',', $ENV{'WARNINGS'})); | ||||
313 | } | ||||||
314 | } | ||||||
315 | |||||||
316 - 324 | =item C<parse_warnings ($OPTION, $ARGUMENT)> Parse the argument of C<--warning=CATEGORY> or C<-WCATEGORY>. C<$OPTIONS> is C<"--warning"> or C<"-W">, C<$ARGUMENT> is C<CATEGORY>. This is meant to be used as an argument to C<Getopt>. =cut | ||||||
325 | |||||||
326 | sub parse_warnings ($$) | ||||||
327 | { | ||||||
328 | 3344 | 1 | 560686 | my ($opt, $categories) = @_; | |||
329 | |||||||
330 | 3344 | 10585 | foreach my $cat (split (',', $categories)) | ||||
331 | { | ||||||
332 | 3346 | 8455 | msg 'unsupported', "unknown warning category `$cat'" | ||||
333 | if switch_warning $cat; | ||||||
334 | } | ||||||
335 | } | ||||||
336 | |||||||
337 - 341 | =item C<set_strictness ($STRICTNESS_NAME)> Configure channels for strictness C<$STRICTNESS_NAME>. =cut | ||||||
342 | |||||||
343 | sub set_strictness ($) | ||||||
344 | { | ||||||
345 | 2339 | 1 | 4660 | my ($name) = @_; | |||
346 | |||||||
347 | 2339 | 10137 | if ($name eq 'gnu') | ||||
348 | { | ||||||
349 | 1177 | 4758 | setup_channel 'error-gnu', silent => 0; | ||||
350 | 1177 | 4751 | setup_channel 'error-gnu/warn', silent => 0, type => 'error'; | ||||
351 | 1177 | 5230 | setup_channel 'error-gnits', silent => 1; | ||||
352 | 1177 | 4162 | setup_channel 'portability', silent => 0; | ||||
353 | 1177 | 3909 | setup_channel 'gnu', silent => 0; | ||||
354 | } | ||||||
355 | elsif ($name eq 'gnits') | ||||||
356 | { | ||||||
357 | 11 | 43 | setup_channel 'error-gnu', silent => 0; | ||||
358 | 11 | 39 | setup_channel 'error-gnu/warn', silent => 0, type => 'error'; | ||||
359 | 11 | 42 | setup_channel 'error-gnits', silent => 0; | ||||
360 | 11 | 42 | setup_channel 'portability', silent => 0; | ||||
361 | 11 | 34 | setup_channel 'gnu', silent => 0; | ||||
362 | } | ||||||
363 | elsif ($name eq 'foreign') | ||||||
364 | { | ||||||
365 | 1151 | 3605 | setup_channel 'error-gnu', silent => 1; | ||||
366 | 1151 | 3984 | setup_channel 'error-gnu/warn', silent => 0, type => 'warning'; | ||||
367 | 1151 | 3660 | setup_channel 'error-gnits', silent => 1; | ||||
368 | 1151 | 3843 | setup_channel 'portability', silent => 1; | ||||
369 | 1151 | 3673 | setup_channel 'gnu', silent => 1; | ||||
370 | } | ||||||
371 | else | ||||||
372 | { | ||||||
373 | 0 | prog_error "level `$name' not recognized"; | |||||
374 | } | ||||||
375 | } | ||||||
376 | |||||||
377 | =back | ||||||
378 | |||||||
379 - 387 | =head1 SEE ALSO L<Automake::Channels> =head1 HISTORY Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>. =cut | ||||||
388 | |||||||
389 | 1; | ||||||
390 | |||||||
391 | ### Setup "GNU" style for perl-mode and cperl-mode. | ||||||
392 | ## Local Variables: | ||||||
393 | ## perl-indent-level: 2 | ||||||
394 | ## perl-continued-statement-offset: 2 | ||||||
395 | ## perl-continued-brace-offset: 0 | ||||||
396 | ## perl-brace-offset: 0 | ||||||
397 | ## perl-brace-imaginary-offset: 0 | ||||||
398 | ## perl-label-offset: -2 | ||||||
399 | ## cperl-indent-level: 2 | ||||||
400 | ## cperl-brace-offset: 0 | ||||||
401 | ## cperl-continued-brace-offset: 0 | ||||||
402 | ## cperl-label-offset: -2 | ||||||
403 | ## cperl-extra-newline-before-brace: t | ||||||
404 | ## cperl-merge-trailing-else: nil | ||||||
405 | ## cperl-continued-statement-offset: 2 | ||||||
406 | ## End: |