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 | |
e1eb1c15 |
87 | SKIP: { |
88 | skip("can 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 | } |
b0948e64 |
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 | } |