diff options
Diffstat (limited to 't')
-rw-r--r-- | t/ConfigSpec.pm | 25 | ||||
-rw-r--r-- | t/TestConfig.pm | 130 | ||||
-rw-r--r-- | t/conf00.t | 22 | ||||
-rw-r--r-- | t/conf01.t | 17 | ||||
-rw-r--r-- | t/conf02.t | 13 | ||||
-rw-r--r-- | t/conf03.t | 16 | ||||
-rw-r--r-- | t/conf04.t | 17 | ||||
-rw-r--r-- | t/conf05.t | 14 |
8 files changed, 254 insertions, 0 deletions
diff --git a/t/ConfigSpec.pm b/t/ConfigSpec.pm new file mode 100644 index 0000000..3963d83 --- /dev/null +++ b/t/ConfigSpec.pm | |||
@@ -0,0 +1,25 @@ | |||
1 | package ConfigSpec; | ||
2 | use parent 'TestConfig'; | ||
3 | |||
4 | sub _check_abs_name { | ||
5 | my ($self, $valref, $prev_value, $locus) = @_; | ||
6 | unless ($$valref =~ m{^/}) { | ||
7 | $self->error("not an absolute pathname", locus => $locus); | ||
8 | return 0; | ||
9 | } | ||
10 | 1; | ||
11 | } | ||
12 | |||
13 | 1; | ||
14 | __DATA__ | ||
15 | [core] | ||
16 | base = STRING :mandatory null | ||
17 | number = NUMBER :array | ||
18 | size = STRING :re='\d+(?:(?i) *[kmg])' | ||
19 | [load] | ||
20 | file = STRING :check=_check_abs_name :mandatory | ||
21 | [load ANY param:mandatory] | ||
22 | mode = OCTAL | ||
23 | owner = STRING | ||
24 | |||
25 | |||
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 @@ | |||
1 | package TestConfig; | ||
2 | |||
3 | use strict; | ||
4 | use warnings; | ||
5 | use Carp; | ||
6 | |||
7 | use Config::Tree qw(:sort); | ||
8 | use parent 'Config::Parser::Ini'; | ||
9 | use Data::Dumper; | ||
10 | use File::Temp; | ||
11 | |||
12 | =head1 CONSTRUCTOR | ||
13 | |||
14 | $obj = new TestConfig(KW => VAL, ...) | ||
15 | |||
16 | Key arguments: | ||
17 | |||
18 | =over 4 | ||
19 | |||
20 | =item B<text> | ||
21 | |||
22 | Text of the configuration file | ||
23 | |||
24 | =item expect | ||
25 | |||
26 | Reference to the list of expected errors | ||
27 | |||
28 | =back | ||
29 | |||
30 | =cut | ||
31 | |||
32 | sub new { | ||
33 | my $class = shift; | ||
34 | local %_ = @_; | ||
35 | |||
36 | my $file = new File::Temp(UNLINK => 1); | ||
37 | if (defined(my $text = delete $_{text})) { | ||
38 | print $file $text; | ||
39 | } else { | ||
40 | while (<main::DATA>) { | ||
41 | print $file $_; | ||
42 | } | ||
43 | } | ||
44 | close $file; | ||
45 | |||
46 | my $exp = delete $_{expect}; | ||
47 | # FIXME: Filter out fh and line keywords? | ||
48 | my $self = $class->SUPER::new(%_); | ||
49 | $self->{_expected_errors} = $exp if $exp; | ||
50 | $self->parse($file->filename); | ||
51 | $self->{_status} = $self->commit; | ||
52 | |||
53 | if ($exp && @{$self->{_expected_errors}}) { | ||
54 | $self->{_status} = 0; | ||
55 | $self->error("not all expected errors reported"); | ||
56 | } | ||
57 | return $self; | ||
58 | } | ||
59 | |||
60 | sub success { | ||
61 | my ($self) = @_; | ||
62 | return $self->{_status}; | ||
63 | } | ||
64 | |||
65 | sub canonical { | ||
66 | my $self = shift; | ||
67 | local %_ = @_; | ||
68 | carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_)); | ||
69 | return join $_{delim} // " ", map { | ||
70 | join('.', @{$_->[0]}) | ||
71 | . "=" | ||
72 | . Data::Dumper->new([$_->[1]->value]) | ||
73 | ->Useqq(1) | ||
74 | ->Terse(1) | ||
75 | ->Indent(0) | ||
76 | ->Dump | ||
77 | } $self->flatten(sort => SORT_PATH); | ||
78 | } | ||
79 | |||
80 | sub expected_error { | ||
81 | my ($self, $msg) = @_; | ||
82 | |||
83 | if (exists($self->{_expected_errors})) { | ||
84 | my ($i) = grep { ${$self->{_expected_errors}}[$_] eq $msg } | ||
85 | 0..$#{$self->{_expected_errors}}; | ||
86 | if (defined($i)) { | ||
87 | splice(@{$self->{_expected_errors}}, $i, 1); | ||
88 | return 1; | ||
89 | } | ||
90 | } | ||
91 | } | ||
92 | |||
93 | sub error { | ||
94 | my $self = shift; | ||
95 | my $err = shift; | ||
96 | local %_ = @_; | ||
97 | push @{$self->{_errors}}, { message => $err }; | ||
98 | unless ($self->expected_error($err)) { | ||
99 | print STDERR "$_{locus}: " if $_{locus}; | ||
100 | print STDERR "$err\n"; | ||
101 | } | ||
102 | } | ||
103 | |||
104 | sub errors { | ||
105 | my $self = shift; | ||
106 | return 0+@{$self->{_errors}}; | ||
107 | } | ||
108 | |||
109 | sub report { | ||
110 | my ($self, $err) = @_; | ||
111 | print STDERR "$err\n" | ||
112 | } | ||
113 | |||
114 | sub lint { | ||
115 | my $self = shift; | ||
116 | my $synt = shift; | ||
117 | local %_ = @_; | ||
118 | my $exp = $self->{_expected_errors} = delete $_{expect}; | ||
119 | carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_)); | ||
120 | |||
121 | my $ret = $self->SUPER::lint($synt); | ||
122 | |||
123 | if ($exp && @{$self->{_expected_errors}}) { | ||
124 | $self->{_status} = 0; | ||
125 | $self->report("not all expected errors reported: @{$self->{_expected_errors}}"); | ||
126 | } | ||
127 | return $ret; | ||
128 | } | ||
129 | |||
130 | 1; | ||
diff --git a/t/conf00.t b/t/conf00.t new file mode 100644 index 0000000..b497c86 --- /dev/null +++ b/t/conf00.t | |||
@@ -0,0 +1,22 @@ | |||
1 | # -*- perl -*- | ||
2 | use lib qw(t lib); | ||
3 | use strict; | ||
4 | use Test; | ||
5 | use ConfigSpec; | ||
6 | |||
7 | plan(tests => 1); | ||
8 | |||
9 | my $c = new ConfigSpec; | ||
10 | ok($c->canonical, | ||
11 | q{core.base=4 core.number=[5,10] core.size="10 k" load.file="/etc/passwd" load.foobar="baz"}); | ||
12 | |||
13 | __DATA__ | ||
14 | [core] | ||
15 | number = 5 | ||
16 | base = 4 | ||
17 | size = 10 k | ||
18 | number = 10 | ||
19 | [load] | ||
20 | file = /etc/passwd | ||
21 | foobar = baz | ||
22 | |||
diff --git a/t/conf01.t b/t/conf01.t new file mode 100644 index 0000000..36b1f65 --- /dev/null +++ b/t/conf01.t | |||
@@ -0,0 +1,17 @@ | |||
1 | # -*- perl -*- | ||
2 | use lib qw(t lib); | ||
3 | use strict; | ||
4 | use Test; | ||
5 | use ConfigSpec; | ||
6 | |||
7 | plan(tests => 1); | ||
8 | |||
9 | my $c = new ConfigSpec(expect => ['keyword "output" is unknown']); | ||
10 | ok($c->errors() == 1); | ||
11 | |||
12 | __DATA__ | ||
13 | [core] | ||
14 | number = 5 | ||
15 | output = file; | ||
16 | [load] | ||
17 | file = /etc/passwd | ||
diff --git a/t/conf02.t b/t/conf02.t new file mode 100644 index 0000000..da0dc07 --- /dev/null +++ b/t/conf02.t | |||
@@ -0,0 +1,13 @@ | |||
1 | # -*- perl -*- | ||
2 | use lib qw(t lib); | ||
3 | use strict; | ||
4 | use Test; | ||
5 | use ConfigSpec; | ||
6 | |||
7 | plan(tests => 1); | ||
8 | |||
9 | my $c = new ConfigSpec(expect => ['mandatory variable "load.file" not set']); | ||
10 | ok($c->errors() == 1); | ||
11 | __DATA__ | ||
12 | [core] | ||
13 | number = 5 | ||
diff --git a/t/conf03.t b/t/conf03.t new file mode 100644 index 0000000..5b49347 --- /dev/null +++ b/t/conf03.t | |||
@@ -0,0 +1,16 @@ | |||
1 | # -*- perl -*- | ||
2 | use lib qw(t lib); | ||
3 | use strict; | ||
4 | use Test; | ||
5 | use ConfigSpec; | ||
6 | |||
7 | plan(tests => 1); | ||
8 | |||
9 | my $c = new ConfigSpec(expect => ['invalid value for size']); | ||
10 | ok($c->errors() == 1); | ||
11 | |||
12 | __DATA__ | ||
13 | [core] | ||
14 | size = 11 | ||
15 | [load] | ||
16 | file = /etc/passwd | ||
diff --git a/t/conf04.t b/t/conf04.t new file mode 100644 index 0000000..ab4c12a --- /dev/null +++ b/t/conf04.t | |||
@@ -0,0 +1,17 @@ | |||
1 | # -*- perl -*- | ||
2 | use lib qw(t lib); | ||
3 | use strict; | ||
4 | use Test; | ||
5 | use ConfigSpec; | ||
6 | |||
7 | plan(tests => 1); | ||
8 | |||