diff options
author | gregor herrmann <gregoa@debian.org> | 2011-09-02 23:05:21 +0200 |
---|---|---|
committer | gregor herrmann <gregoa@debian.org> | 2011-09-02 23:05:21 +0200 |
commit | 66f380b5003a0e04dfa118649937a80d4cb3e17b (patch) | |
tree | 0f75c630c82a9a026f207ef48a1762f8f573cfe0 /t/common.pl |
Imported Upstream version 0.38
Diffstat (limited to 't/common.pl')
-rw-r--r-- | t/common.pl | 95 |
1 files changed, 95 insertions, 0 deletions
diff --git a/t/common.pl b/t/common.pl new file mode 100644 index 0000000..c8249bb --- /dev/null +++ b/t/common.pl @@ -0,0 +1,95 @@ +use Carp; + +my $err_file = 't/errors'; + +END { unlink $err_file } + + +sub setup_stderr +{ + open (SAVE_STDERR, ">&STDERR") + || die "couldn't save stderr: $!\n"; + open (STDERR, ">$err_file") + || die "couldn't redirect stderr to $err_file: $!\n"; + STDERR->autoflush (1); + +# $SIG{'__WARN__'} = sub { print SAVE_STDERR @_ }; + $SIG{'__DIE__'} = sub + { + open (STDERR, '>&=' . fileno (SAVE_STDERR)); + die @_; + }; +} + +sub warnings +{ + my @err; + open (ERR, $err_file) || die "couldn't open $err_file: $!\n"; + chomp (@err = <ERR>); + close (ERR); + open (STDERR, ">$err_file") + || die "couldn't redirect stderr to $err_file: $!\n"; + STDERR->autoflush (1); + if ($DEBUG) + { + printf "caught %d messages on stderr:\n", scalar @err; + print join ("\n", @err) . "\n"; + } + @err; +} + +sub list_equal +{ + my ($eq, $a, $b) = @_; + + croak "list_equal: \$a and \$b not lists" + unless ref $a eq 'ARRAY' && ref $b eq 'ARRAY'; + + return 0 unless @$a == @$b; # compare lengths + my @eq = map { &$eq ($a->[$_], $b->[$_]) } (0 .. $#$a); + return 0 unless (grep ($_ == 1, @eq)) == @eq; +} + +sub slist_equal +{ + my ($a, $b) = @_; + list_equal (sub + { + my ($a, $b) = @_; + (defined $a && defined $b && $a eq $b) || + (! defined $a && ! defined $b); + }, $a, $b); +} + +my $i = 1; +sub test +{ + my ($result) = @_; + + ++$i; + printf "%s %d\n", ($result ? "ok" : "not ok"), $i; +} + +sub test_entry +{ + my ($entry, $type, $key, $fields, $values) = @_; + my ($i, @vals); + + croak "test_entry: num fields != num values" + unless $#$fields == $#$values; + test ($entry->parse_ok); + test ($entry->type eq $type); + test (defined $key ? $entry->key eq $key : !defined $entry->key); + test (slist_equal ([$entry->fieldlist], $fields)); + for $i (0 .. $#$fields) + { + my $val = $entry->get ($fields->[$i]) || ''; + test ($entry->exists ($fields->[$i]) && + $val eq $values->[$i]); + } + + @vals = map ($_ || '', $entry->get (@$fields)); + test (slist_equal (\@vals, $values)); +} + +1; |