From: chromatic <chromatic@wgz.org>
Date: Wed, 10 Oct 2001 15:45:42 +0000 (-0600)
Subject: Add Tests for ExtUtils::Packlist
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b0948e64228c31870c211a3f03a0748d2a811ccc;p=p5sagit%2Fp5-mst-13.2.git

Add Tests for ExtUtils::Packlist
Message-ID: <20011010215140.8913.qmail@onion.perl.org>

p4raw-id: //depot/perl@12397
---

diff --git a/MANIFEST b/MANIFEST
index 82892a1..16fe167 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -902,6 +902,7 @@ lib/ExtUtils/MM_Unix.pm		MakeMaker base class for Unix
 lib/ExtUtils/MM_VMS.pm		MakeMaker methods for VMS
 lib/ExtUtils/MM_Win32.pm	MakeMaker methods for Win32
 lib/ExtUtils/Packlist.pm	Manipulates .packlist files
+lib/ExtUtils/Packlist.t		See if Packlist works
 lib/ExtUtils/testlib.pm		Fixes up @INC to use just-built extension
 lib/ExtUtils/testlib.t		Fixes up @INC to use just-built extension
 lib/ExtUtils/typemap		Extension interface types
diff --git a/lib/ExtUtils/Packlist.t b/lib/ExtUtils/Packlist.t
new file mode 100644
index 0000000..bdcecdf
--- /dev/null
+++ b/lib/ExtUtils/Packlist.t
@@ -0,0 +1,163 @@
+#!./perl
+
+BEGIN {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+}
+
+use Test::More tests => 34;
+
+use_ok( 'ExtUtils::Packlist' );
+
+is( ref(ExtUtils::Packlist::mkfh()), 'GLOB', 'mkfh() should return a FH' );
+
+# new calls tie()
+my $pl = ExtUtils::Packlist->new();
+isa_ok( $pl, 'ExtUtils::Packlist' );
+is( ref tied %$pl, 'ExtUtils::Packlist', 'obj should be tied underneath' );
+
+
+$pl = ExtUtils::Packlist::TIEHASH( 'tieclass', 'packfile' );
+is( ref($pl), 'tieclass', 'TIEHASH() should bless into class' );
+is( $pl->{packfile}, 'packfile', 'TIEHASH() should store packfile name' );
+
+
+ExtUtils::Packlist::STORE($pl, 'key', 'value');
+is( $pl->{data}{key}, 'value', 'STORE() should stuff stuff in data member' );
+
+
+$pl->{data}{foo} = 'bar';
+is( ExtUtils::Packlist::FETCH($pl, 'foo'), 'bar', 'check FETCH()' );
+
+
+# test FIRSTKEY and NEXTKEY
+SKIP: {
+	$pl->{data}{bar} = 'baz';
+	skip('not enough keys to test FIRSTKEY', 2) unless %{ $pl->{data} } > 2;
+
+	# get the first and second key
+	my ($first, $second) = keys %{ $pl->{data} };
+
+	# now get a couple of extra keys, to mess with the hash iterator
+	my $i = 0;
+	for (keys %{ $pl->{data} } ) {
+		last if $i++;
+	}
+	
+	# finally, see if it really can get the first key again
+	is( ExtUtils::Packlist::FIRSTKEY($pl), $first, 
+		'FIRSTKEY() should be consistent' );
+
+	is( ExtUtils::Packlist::NEXTKEY($pl), $second,
+		'and NEXTKEY() should also be consistent' );
+}
+
+
+ok( ExtUtils::Packlist::EXISTS($pl, 'bar'), 'EXISTS() should find keys' );
+
+
+ExtUtils::Packlist::DELETE($pl, 'bar');
+ok( !(exists $pl->{data}{bar}), 'DELETE() should delete cleanly' );
+
+
+ExtUtils::Packlist::CLEAR($pl);
+is( keys %{ $pl->{data} }, 0, 'CLEAR() should wipe out data' );
+
+
+# DESTROY does nothing...
+can_ok( 'ExtUtils::Packlist', 'DESTROY' );
+
+
+# write is a little more complicated
+eval { ExtUtils::Packlist::write({}) };
+like( $@, qr/No packlist filename/, 'write() should croak without packfile' );
+
+eval { ExtUtils::Packlist::write({}, 'eplist') };
+my $file_is_ready = $@ ? 0 : 1;
+ok( $file_is_ready, 'write() can write a file' );
+
+local *IN;
+
+SKIP: {
+	skip('cannot write files, some tests difficult', 3) unless $file_is_ready;
+
+	# set this file to read-only
+	chmod 0444, 'eplist';
+
+	eval { ExtUtils::Packlist::write({}, 'eplist') };
+	like( $@, qr/Can't open file/, 'write() should croak on open failure' );
+
+	#'now set it back (tick here fixes vim syntax highlighting ;)
+	chmod 0777, 'eplist';
+
+	# and some test data to be read
+	$pl->{data} = {
+		single => 1,
+		hash => {
+			foo => 'bar',
+			baz => 'bup',
+		},
+		'/./abc' => '',
+	};
+	eval { ExtUtils::Packlist::write($pl, 'eplist') };
+	is( $@, '', 'write() should normally succeed' );
+	is( $pl->{packfile}, 'eplist', 'write() should set packfile name' );
+
+	$file_is_ready = open(IN, 'eplist');
+}
+
+
+eval { ExtUtils::Packlist::read({}) };
+like( $@, qr/^No packlist filename/, 'read() should croak without packfile' );
+
+
+eval { ExtUtils::Packlist::read({}, 'abadfilename') };
+like( $@, qr/^Can't open file/, 'read() should croak with bad packfile name' );
+#'open packfile for reading
+
+
+# and more read() tests
+SKIP: {
+	skip("cannot open file for reading: $!", 5) unless $file_is_ready;
+	my $file = do { local $/ = <IN> };
+
+	like( $file, qr/single\n/, 'key with value should be available' );
+	like( $file, qr!/\./abc\n!, 'key with no value should also be present' );
+	like( $file, qr/hash.+baz=bup/, 'key with hash value should be present' );
+	like( $file, qr/hash.+foo=bar/, 'second embedded hash value should appear');
+	close IN;
+
+	eval{ ExtUtils::Packlist::read($pl, 'eplist') };
+	is( $@, '', 'read() should normally succeed' );
+	is( $pl->{data}{single}, undef, 'single keys should have undef value' );
+	is( ref($pl->{data}{hash}), 'HASH', 'multivalue keys should become hashes');
+
+	is( $pl->{data}{hash}{foo}, 'bar', 'hash values should be set' );
+	ok( exists $pl->{data}{'/abc'}, 'read() should resolve /./ to / in keys' );
+
+	# give validate a valid and an invalid file to find
+	$pl->{data} = {
+		eplist => 1,
+		fake => undef,
+	};
+
+	is( ExtUtils::Packlist::validate($pl), 1,
+		'validate() should find missing files' );
+	ExtUtils::Packlist::validate($pl, 1);
+	ok( !exists $pl->{data}{fake}, 
+		'validate() should remove missing files when prompted' );
+	
+	# one more new() test, to see if it calls read() successfully
+	$pl = ExtUtils::Packlist->new('eplist');
+}
+
+
+# packlist_file, $pl should be set from write test
+is( ExtUtils::Packlist::packlist_file({ packfile => 'pl' }), 'pl',
+	'packlist_file() should fetch packlist from passed hash' );
+is( ExtUtils::Packlist::packlist_file($pl), 'eplist',
+	'packlist_file() should fetch packlist from ExtUtils::Packlist object' );
+
+END {
+	1 while unlink qw( eplist );
+}