blob: 08f5baed5108c823b516c331b73486cf86eae724 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
package TestConfig;
use strict;
use warnings;
use Carp;
use Config::AST qw(:sort);
use parent 'Config::Parser::Ini';
use Data::Dumper;
use File::Temp;
=head1 CONSTRUCTOR
$obj = new TestConfig(KW => VAL, ...)
Key arguments:
=over 4
=item B<text>
Text of the configuration file
=item expect
Reference to the list of expected errors
=back
=cut
sub new {
my $class = shift;
local %_ = @_;
my $file = new File::Temp(UNLINK => 1);
if (defined(my $text = delete $_{text})) {
print $file $text;
} else {
while (<main::DATA>) {
print $file $_;
}
}
close $file;
my $exp = delete $_{expect};
# FIXME: Filter out fh and line keywords?
my $self = $class->SUPER::new(%_);
$self->{_expected_errors} = $exp if $exp;
if (-s $file->filename) {
$self->parse($file->filename);
$self->{_status} = $self->commit;
} else {
$self->{_status} = 1;
}
if ($exp && @{$self->{_expected_errors}}) {
$self->{_status} = 0;
$self->error("not all expected errors reported");
}
return $self;
}
sub success {
my ($self) = @_;
return $self->{_status};
}
sub canonical {
my $self = shift;
return $self->SUPER::canonical(delim => ' ');
}
sub expected_error {
my ($self, $msg) = @_;
if (exists($self->{_expected_errors})) {
my ($i) = grep { ${$self->{_expected_errors}}[$_] eq $msg }
0..$#{$self->{_expected_errors}};
if (defined($i)) {
splice(@{$self->{_expected_errors}}, $i, 1);
return 1;
}
}
}
sub error {
my $self = shift;
my $err = shift;
local %_ = @_;
push @{$self->{_errors}}, { message => $err };
unless ($self->expected_error($err)) {
print STDERR "$_{locus}: " if $_{locus};
print STDERR "$err\n";
}
}
sub errors {
my $self = shift;
return 0+@{$self->{_errors}};
}
sub report {
my ($self, $err) = @_;
print STDERR "$err\n"
}
sub lint {
my $self = shift;
my $synt = shift;
local %_ = @_;
my $exp = $self->{_expected_errors} = delete $_{expect};
carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_));
my $ret = $self->SUPER::lint($synt);
if ($exp && @{$self->{_expected_errors}}) {
$self->{_status} = 0;
$self->report("not all expected errors reported: @{$self->{_expected_errors}}");
}
return $ret;
}
1;
|
