1#!/usr/bin/perl -w 2use strict; 3 4BEGIN { 5 unshift @INC, 't/lib'; 6} 7 8use Test::More tests => 35; 9 10BEGIN { use_ok( 'ExtUtils::Packlist' ); } 11 12is( ref(ExtUtils::Packlist::mkfh()), 'GLOB', 'mkfh() should return a FH' ); 13 14# new calls tie() 15my $pl = ExtUtils::Packlist->new(); 16isa_ok( $pl, 'ExtUtils::Packlist' ); 17is( ref tied %$pl, 'ExtUtils::Packlist', 'obj should be tied underneath' ); 18 19 20$pl = ExtUtils::Packlist::TIEHASH( 'tieclass', 'packfile' ); 21is( ref($pl), 'tieclass', 'TIEHASH() should bless into class' ); 22is( $pl->{packfile}, 'packfile', 'TIEHASH() should store packfile name' ); 23 24 25ExtUtils::Packlist::STORE($pl, 'key', 'value'); 26is( $pl->{data}{key}, 'value', 'STORE() should stuff stuff in data member' ); 27 28 29$pl->{data}{foo} = 'bar'; 30is( ExtUtils::Packlist::FETCH($pl, 'foo'), 'bar', 'check FETCH()' ); 31 32 33# test FIRSTKEY and NEXTKEY 34SKIP: { 35 $pl->{data}{bar} = 'baz'; 36 skip('not enough keys to test FIRSTKEY', 2) 37 unless keys %{ $pl->{data} } > 2; 38 39 # get the first and second key 40 my ($first, $second) = keys %{ $pl->{data} }; 41 42 # now get a couple of extra keys, to mess with the hash iterator 43 my $i = 0; 44 for (keys %{ $pl->{data} } ) { 45 last if $i++; 46 } 47 48 # finally, see if it really can get the first key again 49 is( ExtUtils::Packlist::FIRSTKEY($pl), $first, 50 'FIRSTKEY() should be consistent' ); 51 52 is( ExtUtils::Packlist::NEXTKEY($pl), $second, 53 'and NEXTKEY() should also be consistent' ); 54} 55 56 57ok( ExtUtils::Packlist::EXISTS($pl, 'bar'), 'EXISTS() should find keys' ); 58 59 60ExtUtils::Packlist::DELETE($pl, 'bar'); 61ok( !(exists $pl->{data}{bar}), 'DELETE() should delete cleanly' ); 62 63 64ExtUtils::Packlist::CLEAR($pl); 65is( keys %{ $pl->{data} }, 0, 'CLEAR() should wipe out data' ); 66 67 68# DESTROY does nothing... 69can_ok( 'ExtUtils::Packlist', 'DESTROY' ); 70 71 72# write is a little more complicated 73eval { ExtUtils::Packlist::write({}) }; 74like( $@, qr/No packlist filename/, 'write() should croak without packfile' ); 75 76eval { ExtUtils::Packlist::write({}, 'eplist') }; 77my $file_is_ready = $@ ? 0 : 1; 78ok( $file_is_ready, 'write() can write a file' ); 79 80local *IN; 81 82SKIP: { 83 skip('cannot write files, some tests difficult', 3) unless $file_is_ready; 84 85 # set this file to read-only 86 chmod 0444, 'eplist'; 87 88 SKIP: { 89 skip("cannot write readonly files", 1) if -w 'eplist'; 90 91 eval { ExtUtils::Packlist::write({}, 'eplist') }; 92 like( $@, qr/Can't open file/, 'write() should croak on open failure' ); 93 } 94 95 #'now set it back (tick here fixes vim syntax highlighting ;) 96 chmod 0777, 'eplist'; 97 98 # and some test data to be read 99 $pl->{data} = { 100 single => 1, 101 hash => { 102 foo => 'bar', 103 baz => 'bup', 104 }, 105 '/./abc' => '', 106 }; 107 eval { ExtUtils::Packlist::write($pl, 'eplist') }; 108 is( $@, '', 'write() should normally succeed' ); 109 is( $pl->{packfile}, 'eplist', 'write() should set packfile name' ); 110 111 $file_is_ready = open(IN, 'eplist'); 112} 113 114 115eval { ExtUtils::Packlist::read({}) }; 116like( $@, qr/^No packlist filename/, 'read() should croak without packfile' ); 117 118 119eval { ExtUtils::Packlist::read({}, 'abadfilename') }; 120like( $@, qr/^Can't open file/, 'read() should croak with bad packfile name' ); 121#'open packfile for reading 122 123 124# and more read() tests 125SKIP: { 126 skip("cannot open file for reading: $!", 5) unless $file_is_ready; 127 my $file = do { local $/ = <IN> }; 128 129 like( $file, qr/single\n/, 'key with value should be available' ); 130 like( $file, qr!/\./abc\n!, 'key with no value should also be present' ); 131 like( $file, qr/hash.+baz=bup/, 'key with hash value should be present' ); 132 like( $file, qr/hash.+foo=bar/, 'second embedded hash value should appear'); 133 close IN; 134 135 eval{ ExtUtils::Packlist::read($pl, 'eplist') }; 136 is( $@, '', 'read() should normally succeed' ); 137 is( $pl->{data}{single}, undef, 'single keys should have undef value' ); 138 is( ref($pl->{data}{hash}), 'HASH', 'multivalue keys should become hashes'); 139 140 is( $pl->{data}{hash}{foo}, 'bar', 'hash values should be set' ); 141 ok( exists $pl->{data}{'/abc'}, 'read() should resolve /./ to / in keys' ); 142 143 # give validate a valid and an invalid file to find 144 $pl->{data} = { 145 eplist => 1, 146 fake => undef, 147 }; 148 149 is( ExtUtils::Packlist::validate($pl), 1, 150 'validate() should find missing files' ); 151 ExtUtils::Packlist::validate($pl, 1); 152 ok( !exists $pl->{data}{fake}, 153 'validate() should remove missing files when prompted' ); 154 155 # one more new() test, to see if it calls read() successfully 156 $pl = ExtUtils::Packlist->new('eplist'); 157} 158 159 160# packlist_file, $pl should be set from write test 161is( ExtUtils::Packlist::packlist_file({ packfile => 'pl' }), 'pl', 162 'packlist_file() should fetch packlist from passed hash' ); 163is( ExtUtils::Packlist::packlist_file($pl), 'eplist', 164 'packlist_file() should fetch packlist from ExtUtils::Packlist object' ); 165 166my $w = 0; 167BEGIN { 168 # Call mkfh at BEGIN time, to make sure it does not trigger "Used 169 # once" warnings. 170 $SIG{__WARN__} = sub { ++$w; warn $_[0] }; 171 ExtUtils::Packlist::mkfh(); 172 173} 174INIT { 175 is $w, undef, '[perl #107410] no warnings from BEGIN-time mkfh'; 176 delete $SIG{__WARN__}; 177} 178 179END { 180 1 while unlink qw( eplist ); 181} 182