test suites

CVS patchset: 3748
CVS date: 2000/05/22 08:38:05

diff --git a/Perl-RPM/t/00_load.t b/Perl-RPM/t/00_load.t
new file mode 100755 (executable)
index 0000000..21fb924
--- /dev/null
+++ b/Perl-RPM/t/00_load.t
@@ -0,0 +1,16 @@
+#!/usr/bin/perl
+
+# Verify that the indivual modules will load
+
+@MODULES = qw(RPM RPM::Constants RPM::Database RPM::Header);
+
+printf "1..%d\n", scalar(@MODULES);
+
+for $idx (0 .. $#MODULES)
+{
+    eval "use $MODULES[$idx]";
+
+    printf "%sok %d\n", ($@) ? 'not ' : '', $idx + 1;
+}
+
+exit 0;

diff --git a/Perl-RPM/t/01_database.t b/Perl-RPM/t/01_database.t
new file mode 100755 (executable)
index 0000000..8f89a62
--- /dev/null
+++ b/Perl-RPM/t/01_database.t
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+
+use RPM::Database;
+
+$SIG{__WARN__} = sub { $@ = shift; };
+$SIG{__DIE__} = sub { $@ = shift; };
+
+print "1..11\n";
+
+tie %DB, "RPM::Database" or print "not ";
+print "ok 1\n";
+
+# This package must exist, obviously
+$rpm = $DB{rpm};
+print "not " unless (defined $rpm and ref $rpm);
+print "ok 2\n";
+
+# Verify that STORE, DELETE and CLEAR operations are blocked
+# STORE
+eval { $DB{foo_package} = 'baz'; print "not " if ($DB{foo_package} == 'baz') };
+print "ok 3\n";
+
+# DELETE
+eval { delete $DB{foo_package} and print "not " };
+print "ok 4\n";
+
+# CLEAR
+eval { %DB = () and print "not " };
+print "ok 5\n";
+
+# Test the untying
+eval { untie %DB };
+print "not " if ($@);
+print "ok 6\n";
+
+# That should cover the basic TIEHASH operands sufficiently.
+
+# No way to test init() or rebuilddb() !!!
+
+# All of the FindBy* suite behave basically the same way. For now, I only
+# have these few tests...
+
+# Test the non-tie approach
+$rpm = new RPM::Database;
+print "not " unless (defined $rpm and ref $rpm);
+print "ok 7\n";
+
+@matches = $rpm->FindByFile('/bin/rpm');
+# There should be exactly one match:
+print "not " unless (@matches == 1);
+print "ok 8\n";
+
+print "not " unless ($matches[0]->{name}->[0] eq 'rpm');
+print "ok 9\n";
+
+# There may be more than one package that depends on rpm
+@matches = $rpm->FindByRequiredBy('rpm');
+for (@matches) { $_ = $_->{name}->[0] }
+# As long as we see this one (it has to be present to build this package)
+print "not " unless (grep 'rpm-devel', @matches);
+print "ok 10\n";
+
+undef $rpm;
+print "ok 11\n";
+
+exit 0;

diff --git a/Perl-RPM/t/02_headers.t b/Perl-RPM/t/02_headers.t
new file mode 100755 (executable)
index 0000000..28db197
--- /dev/null
+++ b/Perl-RPM/t/02_headers.t
@@ -0,0 +1,64 @@
+#!/usr/bin/perl
+
+use RPM::Header;
+use RPM::Database;
+
+chomp($rpmstr = qx{rpm -q rpm});
+
+tie %DB, "RPM::Database";
+
+print "1..8\n";
+
+# Are we getting RPM::Header objects from the database?
+$hdr = $DB{rpm};
+print "not " unless (ref($hdr) and $hdr->isa('RPM::Header'));
+print "ok 1\n";
+
+# Does this one match what rpm thinks?
+print "not "
+    unless ($rpmstr eq join('-',
+                            map { $hdr->{$_}->[0] } qw(name version release)));
+print "ok 2\n";
+
+# This is a much more involved test sequence
+@rpmlines = `rpm -ql rpm`;
+chomp(@rpmlines);
+
+# Headers store files as a list of basenames, dirnames, and pointers to a dir
+# for each file.
+$files   = $hdr->{basenames};
+$dirs    = $hdr->{dirnames};
+$indices = $hdr->{dirindexes};
+
+print "not " unless (@$files == @$indices);
+print "ok 3\n";
+
+print "not " unless (@$files == @rpmlines);
+print "ok 4\n";
+
+for $idx (0 .. $#rpmlines)
+{
+    if ($rpmlines[$idx] ne
+       sprintf("%s%s", $dirs->[$indices->[$idx]], $files->[$idx]))
+    {
+       print "not ";
+       last;
+    }
+}
+print "ok 5\n";
+
+# Can't really test RPM::Header->size(), except to see that it works.
+print "not " if ($hdr->size <= 0);
+print "ok 6\n";
+
+# Check tagtype()
+use RPM::Constants ':rpmtypes';
+
+print "not " unless ($hdr->tagtype(q{size}) == RPM_INT32_TYPE);
+print "ok 7\n";
+
+print "not " unless ($hdr->tagtype(q{dirnames}) == RPM_STRING_ARRAY_TYPE);
+print "ok 8\n";
+
+exit 0;
+