summaryrefslogtreecommitdiffabout
path: root/t/TestConfig.pm
Side-by-side diff
Diffstat (limited to 't/TestConfig.pm') (more/less context) (ignore whitespace changes)
-rw-r--r--t/TestConfig.pm130
1 files changed, 130 insertions, 0 deletions
diff --git a/t/TestConfig.pm b/t/TestConfig.pm
new file mode 100644
index 0000000..886e66b
--- a/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;

Return to:

Send suggestions and report system problems to the System administrator.