Commit | Line | Data |
39234879 |
1 | #!/usr/bin/perl -w |
b0948e64 |
2 | |
3 | BEGIN { |
39234879 |
4 | if( $ENV{PERL_CORE} ) { |
5 | chdir 't' if -d 't'; |
6 | @INC = '../lib'; |
7 | } |
f6d6199c |
8 | else { |
9 | unshift @INC, 't/lib'; |
10 | } |
b0948e64 |
11 | } |
39234879 |
12 | chdir 't'; |
b0948e64 |
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'; |
39234879 |
42 | skip('not enough keys to test FIRSTKEY', 2) |
43 | unless keys %{ $pl->{data} } > 2; |
b0948e64 |
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 | |
e1eb1c15 |
94 | SKIP: { |
57b1a898 |
95 | skip("cannot write readonly files", 1) if -w 'eplist'; |
e1eb1c15 |
96 | |
97 | eval { ExtUtils::Packlist::write({}, 'eplist') }; |
98 | like( $@, qr/Can't open file/, 'write() should croak on open failure' ); |
99 | } |
b0948e64 |
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 | } |