diff options
Diffstat (limited to 't/TestConfig.pm')
-rw-r--r-- | t/TestConfig.pm | 103 |
1 files changed, 103 insertions, 0 deletions
diff --git a/t/TestConfig.pm b/t/TestConfig.pm new file mode 100644 index 0000000..de1ade9 --- /dev/null +++ b/t/TestConfig.pm @@ -0,0 +1,103 @@ +package TestConfig; + +use strict; +use Carp; +use File::Temp; + +use Config::Tree qw(:sort); +use parent 'Config::Tree'; + +sub new { + my $class = shift; + local %_ = @_; + + my $config = delete $_{config}; + my $exp = delete $_{expect}; + + my $self = $class->SUPER::new(%_); + $self->{_expected_errors} = $exp // []; + my $i = 1; + while ((my $k = shift @$config) && (my $v = shift @$config)) { +# while (my ($k,$v) = each %$config) { + $self->add_node($k, $v, new Config::Tree::Locus('input', $i++)); + } + $self->commit; + if (@{$self->{_expected_errors}}) { + $self->{_status} = 0; + $self->report("not all expected errors reported: @{$self->{_expected_errors}}"); + } + return $self; +} + +sub success { + my ($self) = @_; + return $self->{_status}; +} + +sub canonical { + my $self = shift; + local %_ = @_; + my $delim; + unless (defined($delim = delete $_{delim})) { + $delim = " "; + } + carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_)); + + return join $delim, map { + local $Data::Dumper::Useqq = 1; + local $Data::Dumper::Terse = 1; + local $Data::Dumper::Indent = 0; + join('.', @{$_->[0]}) . "=" . Data::Dumper->Dump([$_->[1]->value]); + } $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 }; + print STDERR "$_{locus}: $err\n" + unless $self->expected_error($err); +} + +sub errors { + my $self = shift; + return undef if $self->success; + return @{$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; |