lib/ExtUtils/Packlist.t

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