lib/ExtUtils/t/Packlist.t

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