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;