Commit | Line | Data |
b0948e64 |
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 | } |