aboutsummaryrefslogtreecommitdiff
path: root/t/TestConfig.pm
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2017-02-16 14:28:01 +0200
committerSergey Poznyakoff <gray@gnu.org.ua>2017-02-16 16:08:43 +0200
commite547b7507e6878efdccb744b7d6cd5250c6c69b9 (patch)
tree89bba96184b32d831e06bafb8ed38bd376cb92e7 /t/TestConfig.pm
parent0cd31637a354ba5c0171a5f4ce8243f12739fda4 (diff)
downloadbeam-e547b7507e6878efdccb744b7d6cd5250c6c69b9.tar.gz
beam-e547b7507e6878efdccb744b7d6cd5250c6c69b9.tar.bz2
Improve config parser. Add more tests.
* MANIFEST: Update. * lib/App/Beam/Config.pm: Rewrite 'error' as method. Check for missing mandatory statements. * t/TestConfig.pm: New file. * t/conf01.t: New file. * t/conf02.t: New file. * t/conf03.t: New file. * t/config.t: Remove. * t/f.conf: Remove.
Diffstat (limited to 't/TestConfig.pm')
-rw-r--r--t/TestConfig.pm102
1 files changed, 102 insertions, 0 deletions
diff --git a/t/TestConfig.pm b/t/TestConfig.pm
new file mode 100644
index 0000000..ef5ce1d
--- /dev/null
+++ b/t/TestConfig.pm
@@ -0,0 +1,102 @@
+package TestConfig;
+
+use strict;
+use Carp;
+use File::Temp;
+
+require App::Beam::Config;
+our @ISA = qw(App::Beam::Config);
+
+sub new {
+ my $class = shift;
+ my $text;
+ local %_ = @_;
+
+ my $file = new File::Temp(UNLINK => 1);
+ if (defined($text = delete $_{text})) {
+ print $file $text;
+ } else {
+ while (<main::DATA>) {
+ print $file $_;
+ }
+ }
+ close $file;
+
+ my $exp = delete $_{expect};
+ my $self = $class->SUPER::new($file->filename, %_);
+ $self->{expected_errors} = $exp if $exp;
+ $self->{status} = $self->parse();
+ 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 %_ = @_;
+ my $delim;
+ unless (defined($delim = delete $_{delim})) {
+ $delim = " ";
+ }
+ carp "unknown parameters: " . join(', ', keys(%_)) if (keys(%_));
+ return undef unless $self->success;
+
+ return join $delim, map {
+ local $Data::Dumper::Useqq = 1;
+ local $Data::Dumper::Terse = 1;
+ local $Data::Dumper::Indent = 0;
+ $_->[0] . "=" . Data::Dumper->Dump([$_->[1]]);
+ } $self->flatten();
+}
+
+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, $err) = @_;
+ if ($err =~ /^(.+?):(.+?): (.+)/) {
+ unless (exists($self->{first_line})) {
+ if (open(my $fd, '<', $0)) {
+ $self->{first_line} = 0;
+ while (<$fd>) {
+ $self->{first_line}++;
+ chomp;
+ last if /^__DATA__$/;
+ }
+ close $fd;
+ }
+ }
+ my $line = $2 + $self->{first_line};
+ push @{$self->{errors}}, { file => $0,
+ orig => $1,
+ line => $line,
+ message => $3 };
+ print STDERR "$0:$line: $3\n"
+ unless $self->expected_error($3);
+ } else {
+ push @{$self->{errors}}, { message => $err };
+ print STDERR "$err\n"
+ }
+}
+
+sub errors {
+ my $self = shift;
+ return undef if $self->success;
+ return @{$self->{errors}};
+}

Return to:

Send suggestions and report system problems to the System administrator.