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