summaryrefslogtreecommitdiffabout
path: root/t/TestConfig.pm
blob: de1ade9a6fa8b563b3885cb263470a8ecb75c148 (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
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;

Return to:

Send suggestions and report system problems to the System administrator.