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;