diff options
Diffstat (limited to 't/TestConfig.pm')
-rw-r--r-- | t/TestConfig.pm | 130 |
1 files changed, 130 insertions, 0 deletions
diff --git a/t/TestConfig.pm b/t/TestConfig.pm new file mode 100644 index 0000000..886e66b --- /dev/null +++ b/t/TestConfig.pm @@ -0,0 +1,130 @@ +package TestConfig; + +use strict; +use warnings; +use Carp; + +use Config::Tree 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; + $self->parse($file->filename); + $self->{_status} = $self->commit; + + 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; + local %_ = @_; + carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_)); + return join $_{delim} // " ", map { + join('.', @{$_->[0]}) + . "=" + . Data::Dumper->new([$_->[1]->value]) + ->Useqq(1) + ->Terse(1) + ->Indent(0) + ->Dump + } $self->flatten(sort => SORT_PATH); +} + +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; |