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 = ); 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;