Move Data::Dumper from ext/ to dist/
[perl.git] / ext / ExtUtils-Install / t / Packlist.t
1 #!/usr/bin/perl -w
2
3 BEGIN {
4     unshift @INC, 't/lib';
5 }
6
7 use Test::More tests => 34;
8
9 use_ok( 'ExtUtils::Packlist' );
10
11 is( ref(ExtUtils::Packlist::mkfh()), 'GLOB', 'mkfh() should return a FH' );
12
13 # new calls tie()
14 my $pl = ExtUtils::Packlist->new();
15 isa_ok( $pl, 'ExtUtils::Packlist' );
16 is( ref tied %$pl, 'ExtUtils::Packlist', 'obj should be tied underneath' );
17
18
19 $pl = ExtUtils::Packlist::TIEHASH( 'tieclass', 'packfile' );
20 is( ref($pl), 'tieclass', 'TIEHASH() should bless into class' );
21 is( $pl->{packfile}, 'packfile', 'TIEHASH() should store packfile name' );
22
23
24 ExtUtils::Packlist::STORE($pl, 'key', 'value');
25 is( $pl->{data}{key}, 'value', 'STORE() should stuff stuff in data member' );
26
27
28 $pl->{data}{foo} = 'bar';
29 is( ExtUtils::Packlist::FETCH($pl, 'foo'), 'bar', 'check FETCH()' );
30
31
32 # test FIRSTKEY and NEXTKEY
33 SKIP: {
34         $pl->{data}{bar} = 'baz';
35         skip('not enough keys to test FIRSTKEY', 2)
36       unless keys %{ $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         SKIP: {
88             skip("cannot write readonly files", 1) if -w 'eplist';
89
90             eval { ExtUtils::Packlist::write({}, 'eplist') };
91             like( $@, qr/Can't open file/, 'write() should croak on open failure' );
92         }
93
94         #'now set it back (tick here fixes vim syntax highlighting ;)
95         chmod 0777, 'eplist';
96
97         # and some test data to be read
98         $pl->{data} = {
99                 single => 1,
100                 hash => {
101                         foo => 'bar',
102                         baz => 'bup',
103                 },
104                 '/./abc' => '',
105         };
106         eval { ExtUtils::Packlist::write($pl, 'eplist') };
107         is( $@, '', 'write() should normally succeed' );
108         is( $pl->{packfile}, 'eplist', 'write() should set packfile name' );
109
110         $file_is_ready = open(IN, 'eplist');
111 }
112
113
114 eval { ExtUtils::Packlist::read({}) };
115 like( $@, qr/^No packlist filename/, 'read() should croak without packfile' );
116
117
118 eval { ExtUtils::Packlist::read({}, 'abadfilename') };
119 like( $@, qr/^Can't open file/, 'read() should croak with bad packfile name' );
120 #'open packfile for reading
121
122
123 # and more read() tests
124 SKIP: {
125         skip("cannot open file for reading: $!", 5) unless $file_is_ready;
126         my $file = do { local $/ = <IN> };
127
128         like( $file, qr/single\n/, 'key with value should be available' );
129         like( $file, qr!/\./abc\n!, 'key with no value should also be present' );
130         like( $file, qr/hash.+baz=bup/, 'key with hash value should be present' );
131         like( $file, qr/hash.+foo=bar/, 'second embedded hash value should appear');
132         close IN;
133
134         eval{ ExtUtils::Packlist::read($pl, 'eplist') };
135         is( $@, '', 'read() should normally succeed' );
136         is( $pl->{data}{single}, undef, 'single keys should have undef value' );
137         is( ref($pl->{data}{hash}), 'HASH', 'multivalue keys should become hashes');
138
139         is( $pl->{data}{hash}{foo}, 'bar', 'hash values should be set' );
140         ok( exists $pl->{data}{'/abc'}, 'read() should resolve /./ to / in keys' );
141
142         # give validate a valid and an invalid file to find
143         $pl->{data} = {
144                 eplist => 1,
145                 fake => undef,
146         };
147
148         is( ExtUtils::Packlist::validate($pl), 1,
149                 'validate() should find missing files' );
150         ExtUtils::Packlist::validate($pl, 1);
151         ok( !exists $pl->{data}{fake},
152                 'validate() should remove missing files when prompted' );
153
154         # one more new() test, to see if it calls read() successfully
155         $pl = ExtUtils::Packlist->new('eplist');
156 }
157
158
159 # packlist_file, $pl should be set from write test
160 is( ExtUtils::Packlist::packlist_file({ packfile => 'pl' }), 'pl',
161         'packlist_file() should fetch packlist from passed hash' );
162 is( ExtUtils::Packlist::packlist_file($pl), 'eplist',
163         'packlist_file() should fetch packlist from ExtUtils::Packlist object' );
164
165 END {
166         1 while unlink qw( eplist );
167 }