123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390 |
- package Autom4te::ChannelDefs;
- use Autom4te::Channels;
- use 5.006;
- use strict;
- use Exporter;
- use vars qw (@ISA @EXPORT);
- @ISA = qw (Exporter);
- @EXPORT = qw (&prog_error &error &fatal &verb
- &switch_warning &parse_WARNINGS &parse_warnings);
- register_channel 'fatal', type => 'fatal', ordered => 0;
- register_channel 'error', type => 'error';
- register_channel 'error-gnu', type => 'error';
- register_channel 'error-gnu/warn', type => 'error';
- register_channel 'error-gnits', type => 'error', silent => 1;
- register_channel 'automake', type => 'fatal', backtrace => 1,
- header => ("####################\n" .
- "## Internal Error ##\n" .
- "####################\n"),
- footer => "\nPlease contact <bug-automake\@gnu.org>.",
- ordered => 0;
- register_channel 'cross', type => 'warning', silent => 1;
- register_channel 'gnu', type => 'warning';
- register_channel 'obsolete', type => 'warning', silent => 1;
- register_channel 'override', type => 'warning', silent => 1;
- register_channel 'portability', type => 'warning', silent => 1;
- register_channel 'syntax', type => 'warning';
- register_channel 'unsupported', type => 'warning';
- register_channel 'verb', type => 'debug', silent => 1, ordered => 0;
- register_channel 'note', type => 'debug', silent => 0;
- sub usage ()
- {
- return "Warning categories include:
- `cross' cross compilation issues
- `gnu' GNU coding standards (default in gnu and gnits modes)
- `obsolete' obsolete features or constructions
- `override' user redefinitions of Automake rules or variables
- `portability' portability issues (default in gnu and gnits modes)
- `syntax' dubious syntactic constructs (default)
- `unsupported' unsupported or incomplete features (default)
- `all' all the warnings
- `no-CATEGORY' turn off warnings in CATEGORY
- `none' turn off all the warnings
- `error' treat warnings as errors";
- }
- sub prog_error ($;%)
- {
- my ($msg, %opts) = @_;
- msg 'automake', '', $msg, %opts;
- }
- sub error ($;$%)
- {
- my ($where, $msg, %opts) = @_;
- msg ('error', $where, $msg, %opts);
- }
- sub fatal ($;$%)
- {
- my ($where, $msg, %opts) = @_;
- msg ('fatal', $where, $msg, %opts);
- }
- sub verb ($;%)
- {
- my ($msg, %opts) = @_;
- msg 'verb', '', $msg, %opts;
- }
- sub switch_warning ($)
- {
- my ($cat) = @_;
- my $has_no = 0;
- if ($cat =~ /^no-(.*)$/)
- {
- $cat = $1;
- $has_no = 1;
- }
- if ($cat eq 'all')
- {
- setup_channel_type 'warning', silent => $has_no;
- }
- elsif ($cat eq 'none')
- {
- setup_channel_type 'warning', silent => ! $has_no;
- }
- elsif ($cat eq 'error')
- {
- $warnings_are_errors = ! $has_no;
-
-
- $SIG{"__WARN__"} =
- $has_no ? 'DEFAULT' : sub { print STDERR @_; $exit_code = 1; };
- }
- elsif (channel_type ($cat) eq 'warning')
- {
- setup_channel $cat, silent => $has_no;
- }
- else
- {
- return 1;
- }
- return 0;
- }
- sub parse_WARNINGS ()
- {
- if (exists $ENV{'WARNINGS'})
- {
-
-
- switch_warning $_ foreach (split (',', $ENV{'WARNINGS'}));
- }
- }
- sub parse_warnings ($@)
- {
- my ($opt, @categories) = @_;
- foreach my $cat (map { split ',' } @categories)
- {
- msg 'unsupported', "unknown warning category `$cat'"
- if switch_warning $cat;
- }
- }
- sub set_strictness ($)
- {
- my ($name) = @_;
- if ($name eq 'gnu')
- {
- setup_channel 'error-gnu', silent => 0;
- setup_channel 'error-gnu/warn', silent => 0, type => 'error';
- setup_channel 'error-gnits', silent => 1;
- setup_channel 'portability', silent => 0;
- setup_channel 'gnu', silent => 0;
- }
- elsif ($name eq 'gnits')
- {
- setup_channel 'error-gnu', silent => 0;
- setup_channel 'error-gnu/warn', silent => 0, type => 'error';
- setup_channel 'error-gnits', silent => 0;
- setup_channel 'portability', silent => 0;
- setup_channel 'gnu', silent => 0;
- }
- elsif ($name eq 'foreign')
- {
- setup_channel 'error-gnu', silent => 1;
- setup_channel 'error-gnu/warn', silent => 0, type => 'warning';
- setup_channel 'error-gnits', silent => 1;
- setup_channel 'portability', silent => 1;
- setup_channel 'gnu', silent => 1;
- }
- else
- {
- prog_error "level `$name' not recognized\n";
- }
- }
|