Commit | Line | Data |
---|---|---|
39234879 | 1 | #!/usr/bin/perl -w |
b0948e64 | 2 | |
3 | BEGIN { | |
fb78ba4b | 4 | unshift @INC, 't/lib'; |
b0948e64 | 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'; | |
3a465856 | 35 | skip('not enough keys to test FIRSTKEY', 2) |
39234879 | 36 | unless keys %{ $pl->{data} } > 2; |
b0948e64 | 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 | } | |
3a465856 | 46 | |
b0948e64 | 47 | # finally, see if it really can get the first key again |
3a465856 | 48 | is( ExtUtils::Packlist::FIRSTKEY($pl), $first, |
b0948e64 | 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: { |
57b1a898 | 88 | skip("cannot write readonly files", 1) if -w 'eplist'; |
e1eb1c15 JH |
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); | |
3a465856 | 151 | ok( !exists $pl->{data}{fake}, |
b0948e64 | 152 | 'validate() should remove missing files when prompted' ); |
3a465856 | 153 | |
b0948e64 | 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 | } |