File: | /usr/local/share/autoconf/Autom4te/ChannelDefs.pm |
Coverage: | 59.1% |
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 3 of the License, or | ||||||
7 | # (at your option) 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 Autom4te::ChannelDefs; | ||||||
18 | |||||||
19 | 2774 2774 2774 | 17377 3144 17649 | use Autom4te::Channels; | ||||
20 | |||||||
21 - 48 | =head1 NAME Autom4te::ChannelDefs - channel definitions for Automake and helper functions =head1 SYNOPSIS use Autom4te::ChannelDefs; print Autom4te::ChannelDefs::usage (), "\n"; 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); Autom4te::ChannelDefs::set_strictness ($STRICTNESS_NAME); =head1 DESCRIPTION This package 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 | ||||||
49 | |||||||
50 | 2774 2774 2774 | 52705 6342 2859 | use 5.005; | ||||
51 | 2774 2774 2774 | 9062 2597 7602 | use strict; | ||||
52 | 2774 2774 2774 | 9274 2429 6141 | use Exporter; | ||||
53 | |||||||
54 | 2774 2774 2774 | 9551 2427 6636 | use vars qw (@ISA @EXPORT); | ||||
55 | |||||||
56 | @ISA = qw (Exporter); | ||||||
57 | @EXPORT = qw (&prog_error &error &fatal &verb | ||||||
58 | &switch_warning &parse_WARNINGS &parse_warnings); | ||||||
59 | |||||||
60 - 131 | =head2 CHANNELS The following channels can be used as the first argument of C<Autom4te::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<cross> Constructs compromising the cross-compilation of the package. =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 | ||||||
132 | |||||||
133 | # Initialize our list of error/warning channels. | ||||||
134 | # Do not forget to update &usage and the manual | ||||||
135 | # if you add or change a warning channel. | ||||||
136 | |||||||
137 | register_channel 'fatal', type => 'fatal', ordered => 0; | ||||||
138 | register_channel 'error', type => 'error'; | ||||||
139 | register_channel 'error-gnu', type => 'error'; | ||||||
140 | register_channel 'error-gnu/warn', type => 'error'; | ||||||
141 | register_channel 'error-gnits', type => 'error', silent => 1; | ||||||
142 | register_channel 'automake', type => 'fatal', backtrace => 1, | ||||||
143 | header => ("####################\n" . | ||||||
144 | "## Internal Error ##\n" . | ||||||
145 | "####################\n"), | ||||||
146 | footer => "\nPlease contact <bug-automake\@gnu.org>.", | ||||||
147 | ordered => 0; | ||||||
148 | |||||||
149 | register_channel 'cross', type => 'warning', silent => 1; | ||||||
150 | register_channel 'gnu', type => 'warning'; | ||||||
151 | register_channel 'obsolete', type => 'warning', silent => 1; | ||||||
152 | register_channel 'override', type => 'warning', silent => 1; | ||||||
153 | register_channel 'portability', type => 'warning', silent => 1; | ||||||
154 | register_channel 'syntax', type => 'warning'; | ||||||
155 | register_channel 'unsupported', type => 'warning'; | ||||||
156 | |||||||
157 | register_channel 'verb', type => 'debug', silent => 1, ordered => 0; | ||||||
158 | register_channel 'note', type => 'debug', silent => 0; | ||||||
159 | |||||||
160 - 168 | =head2 FUNCTIONS =over 4 =item C<usage ()> Return the warning category descriptions. =cut | ||||||
169 | |||||||
170 | sub usage () | ||||||
171 | { | ||||||
172 | 2772 | 1 | 32640 | return "Warning categories include: | |||
173 | `cross' cross compilation issues | ||||||
174 | `gnu' GNU coding standards (default in gnu and gnits modes) | ||||||
175 | `obsolete' obsolete features or constructions | ||||||
176 | `override' user redefinitions of Automake rules or variables | ||||||
177 | `portability' portability issues (default in gnu and gnits modes) | ||||||
178 | `syntax' dubious syntactic constructs (default) | ||||||
179 | `unsupported' unsupported or incomplete features (default) | ||||||
180 | `all' all the warnings | ||||||
181 | `no-CATEGORY' turn off warnings in CATEGORY | ||||||
182 | `none' turn off all the warnings | ||||||
183 | `error' treat warnings as errors"; | ||||||
184 | } | ||||||
185 | |||||||
186 - 191 | =item C<prog_error ($MESSAGE, [%OPTIONS])> Signal a programming error (on channel C<automake>), display C<$MESSAGE>, and exit 1. =cut | ||||||
192 | |||||||
193 | sub prog_error ($;%) | ||||||
194 | { | ||||||
195 | 0 | 1 | 0 | my ($msg, %opts) = @_; | |||
196 | 0 | 0 | msg 'automake', '', $msg, %opts; | ||||
197 | } | ||||||
198 | |||||||
199 - 205 | =item C<error ($WHERE, $MESSAGE, [%OPTIONS])> =item C<error ($MESSAGE)> Uncategorized errors. =cut | ||||||
206 | |||||||
207 | sub error ($;$%) | ||||||
208 | { | ||||||
209 | 0 | 1 | 0 | my ($where, $msg, %opts) = @_; | |||
210 | 0 | 0 | msg ('error', $where, $msg, %opts); | ||||
211 | } | ||||||
212 | |||||||
213 - 219 | =item C<fatal ($WHERE, $MESSAGE, [%OPTIONS])> =item C<fatal ($MESSAGE)> Fatal errors. =cut | ||||||
220 | |||||||
221 | sub fatal ($;$%) | ||||||
222 | { | ||||||
223 | 16 | 1 | 149 | my ($where, $msg, %opts) = @_; | |||
224 | 16 | 207 | msg ('fatal', $where, $msg, %opts); | ||||
225 | } | ||||||
226 | |||||||
227 - 231 | =item C<verb ($MESSAGE, [%OPTIONS])> C<--verbose> messages. =cut | ||||||
232 | |||||||
233 | sub verb ($;%) | ||||||
234 | { | ||||||
235 | 17058 | 1 | 64410 | my ($msg, %opts) = @_; | |||
236 | 17058 | 94457 | msg 'verb', '', $msg, %opts; | ||||
237 | } | ||||||
238 | |||||||
239 - 245 | =item C<switch_warning ($CATEGORY)> If C<$CATEGORY> is C<mumble>, turn on channel C<mumble>. If it is C<no-mumble>, turn C<mumble> off. Else handle C<all> and C<none> for completeness. =cut | ||||||
246 | |||||||
247 | sub switch_warning ($) | ||||||
248 | { | ||||||
249 | 2777 | 1 | 6957 | my ($cat) = @_; | |||
250 | 2777 | 4992 | my $has_no = 0; | ||||
251 | |||||||
252 | 2777 | 16470 | if ($cat =~ /^no-(.*)$/) | ||||
253 | { | ||||||
254 | 0 | 0 | $cat = $1; | ||||
255 | 0 | 0 | $has_no = 1; | ||||
256 | } | ||||||
257 | |||||||
258 | 2777 | 45191 | if ($cat eq 'all') | ||||
259 | { | ||||||
260 | 0 | 0 | setup_channel_type 'warning', silent => $has_no; | ||||
261 | } | ||||||
262 | elsif ($cat eq 'none') | ||||||
263 | { | ||||||
264 | 0 | 0 | setup_channel_type 'warning', silent => ! $has_no; | ||||
265 | } | ||||||
266 | elsif ($cat eq 'error') | ||||||
267 | { | ||||||
268 | 3 | 13 | $warnings_are_errors = ! $has_no; | ||||
269 | # Set exit code if Perl warns about something | ||||||
270 | # (like uninitialized variables). | ||||||
271 | $SIG{"__WARN__"} = | ||||||
272 | 3 0 0 | 34 0 0 | $has_no ? 'DEFAULT' : sub { print STDERR @_; $exit_code = 1; }; | ||||
273 | } | ||||||
274 | elsif (channel_type ($cat) eq 'warning') | ||||||
275 | { | ||||||
276 | 2774 | 19760 | setup_channel $cat, silent => $has_no; | ||||
277 | } | ||||||
278 | else | ||||||
279 | { | ||||||
280 | 0 | 0 | return 1; | ||||
281 | } | ||||||
282 | 2777 | 17376 | return 0; | ||||
283 | } | ||||||
284 | |||||||
285 - 289 | =item C<parse_WARNINGS ()> Parse the WARNINGS environment variable. =cut | ||||||
290 | |||||||
291 | sub parse_WARNINGS () | ||||||
292 | { | ||||||
293 | 2772 | 1 | 15019 | if (exists $ENV{'WARNINGS'}) | |||
294 | { | ||||||
295 | # Ignore unknown categories. This is required because WARNINGS | ||||||
296 | # should be honored by many tools. | ||||||
297 | 1 1 | 2 9 | switch_warning $_ foreach (split (',', $ENV{'WARNINGS'})); | ||||
298 | } | ||||||
299 | } | ||||||
300 | |||||||
301 - 310 | =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 a list of C<CATEGORY>. This can be used as an argument to C<Getopt>. =cut | ||||||
311 | |||||||
312 | sub parse_warnings ($@) | ||||||
313 | { | ||||||
314 | 2762 | 1 | 6509178 | my ($opt, @categories) = @_; | |||
315 | |||||||
316 | 2762 2762 | 6924 15253 | foreach my $cat (map { split ',' } @categories) | ||||
317 | { | ||||||
318 | 2762 | 14289 | msg 'unsupported', "unknown warning category `$cat'" | ||||
319 | if switch_warning $cat; | ||||||
320 | } | ||||||
321 | } | ||||||
322 | |||||||
323 - 327 | =item C<set_strictness ($STRICTNESS_NAME)> Configure channels for strictness C<$STRICTNESS_NAME>. =cut | ||||||
328 | |||||||
329 | sub set_strictness ($) | ||||||
330 | { | ||||||
331 | 0 | 1 | my ($name) = @_; | ||||
332 | |||||||
333 | 0 | if ($name eq 'gnu') | |||||
334 | { | ||||||
335 | 0 | setup_channel 'error-gnu', silent => 0; | |||||
336 | 0 | setup_channel 'error-gnu/warn', silent => 0, type => 'error'; | |||||
337 | 0 | setup_channel 'error-gnits', silent => 1; | |||||
338 | 0 | setup_channel 'portability', silent => 0; | |||||
339 | 0 | setup_channel 'gnu', silent => 0; | |||||
340 | } | ||||||
341 | elsif ($name eq 'gnits') | ||||||
342 | { | ||||||
343 | 0 | setup_channel 'error-gnu', silent => 0; | |||||
344 | 0 | setup_channel 'error-gnu/warn', silent => 0, type => 'error'; | |||||
345 | 0 | setup_channel 'error-gnits', silent => 0; | |||||
346 | 0 | setup_channel 'portability', silent => 0; | |||||
347 | 0 | setup_channel 'gnu', silent => 0; | |||||
348 | } | ||||||
349 | elsif ($name eq 'foreign') | ||||||
350 | { | ||||||
351 | 0 | setup_channel 'error-gnu', silent => 1; | |||||
352 | 0 | setup_channel 'error-gnu/warn', silent => 0, type => 'warning'; | |||||
353 | 0 | setup_channel 'error-gnits', silent => 1; | |||||
354 | 0 | setup_channel 'portability', silent => 1; | |||||
355 | 0 | setup_channel 'gnu', silent => 1; | |||||
356 | } | ||||||
357 | else | ||||||
358 | { | ||||||
359 | 0 | prog_error "level `$name' not recognized\n"; | |||||
360 | } | ||||||
361 | } | ||||||
362 | |||||||
363 | =back | ||||||
364 | |||||||
365 - 373 | =head1 SEE ALSO L<Autom4te::Channels> =head1 HISTORY Written by Alexandre Duret-Lutz E<lt>F<adl@gnu.org>E<gt>. =cut | ||||||
374 | |||||||
375 | ### Setup "GNU" style for perl-mode and cperl-mode. | ||||||
376 | ## Local Variables: | ||||||
377 | ## perl-indent-level: 2 | ||||||
378 | ## perl-continued-statement-offset: 2 | ||||||
379 | ## perl-continued-brace-offset: 0 | ||||||
380 | ## perl-brace-offset: 0 | ||||||
381 | ## perl-brace-imaginary-offset: 0 | ||||||
382 | ## perl-label-offset: -2 | ||||||
383 | ## cperl-indent-level: 2 | ||||||
384 | ## cperl-brace-offset: 0 | ||||||
385 | ## cperl-continued-brace-offset: 0 | ||||||
386 | ## cperl-label-offset: -2 | ||||||
387 | ## cperl-extra-newline-before-brace: t | ||||||
388 | ## cperl-merge-trailing-else: nil | ||||||
389 | ## cperl-continued-statement-offset: 2 | ||||||
390 | ## End: |