4 if( $ENV{PERL_CORE} ) {
9 unshift @INC, 't/lib/';
14 my $Is_VMS = $^O eq 'VMS';
24 use Test::More tests => 63;
26 BEGIN { use_ok( 'ExtUtils::Installed' ) }
28 my $mandirs = !!$Config{man1direxp} + !!$Config{man3direxp};
30 # saves having to qualify package name for class methods
31 my $ei = bless( {}, 'ExtUtils::Installed' );
33 # Make sure meta info is available
34 $ei->{':private:'}{Config} = \%Config;
35 $ei->{':private:'}{INC} = \@INC;
38 ok( $ei->_is_prefix('foo/bar', 'foo'),
39 '_is_prefix() should match valid path prefix' );
40 ok( !$ei->_is_prefix('\foo\bar', '\bar'),
41 '... should not match wrong prefix' );
44 ok( $ei->_is_type(0, 'all'), '_is_type() should be true for type of "all"' );
46 foreach my $path (qw( man1dir man3dir )) {
48 my $dir = $Config{$path.'exp'};
49 skip("no man directory $path on this system", 2 ) unless $dir;
51 my $file = $dir . '/foo';
52 ok( $ei->_is_type($file, 'doc'), "... should find doc file in $path" );
53 ok( !$ei->_is_type($file, 'prog'), "... but not prog file in $path" );
57 # VMS 5.6.1 doesn't seem to have $Config{prefixexp}
58 my $prefix = $Config{prefix} || $Config{prefixexp};
60 # You can concatenate /foo but not foo:, which defaults in the current
62 $prefix = VMS::Filespec::unixify($prefix) if $Is_VMS;
64 # ActivePerl 5.6.1/631 has $Config{prefixexp} as 'p:' for some reason
65 $prefix = $Config{prefix} if $prefix eq 'p:' && $^O eq 'MSWin32';
67 ok( $ei->_is_type( File::Spec->catfile($prefix, 'bar'), 'prog'),
68 "... should find prog file under $prefix" );
71 skip('no man directories on this system', 1) unless $mandirs;
72 is( $ei->_is_type('bar', 'doc'), 0,
73 '... should not find doc file outside path' );
76 ok( !$ei->_is_type('bar', 'prog'),
77 '... nor prog file outside path' );
78 ok( !$ei->_is_type('whocares', 'someother'), '... nor other type anywhere' );
81 ok( $ei->_is_under('foo'), '_is_under() should return true with no dirs' );
83 my @under = qw( boo bar baz );
84 ok( !$ei->_is_under('foo', @under), '... should find no file not under dirs');
85 ok( $ei->_is_under('baz', @under), '... should find file under dir' );
88 rmtree 'auto/FakeMod';
89 ok( mkpath('auto/FakeMod') );
92 ok(open(PACKLIST, '>auto/FakeMod/.packlist'));
93 print PACKLIST 'list';
96 ok(open(FAKEMOD, '>auto/FakeMod/FakeMod.pm'));
98 print FAKEMOD <<'FAKE';
100 use vars qw( $VERSION );
107 my $fake_mod_dir = File::Spec->catdir(cwd(), 'auto', 'FakeMod');
109 # avoid warning and death by localizing glob
110 local *ExtUtils::Installed::Config;
111 %ExtUtils::Installed::Config = (
114 sitearchexp => $fake_mod_dir,
117 # necessary to fool new()
118 push @INC, $fake_mod_dir;
120 my $realei = ExtUtils::Installed->new();
121 isa_ok( $realei, 'ExtUtils::Installed' );
122 isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' );
123 is( $realei->{Perl}{version}, $Config{version},
124 'new() should set Perl version from %Config' );
126 ok( exists $realei->{FakeMod}, 'new() should find modules with .packlists');
127 isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' );
128 is( $realei->{FakeMod}{version}, '1.1.1',
129 '... should find version in modules' );
132 # Now try this using PERL5LIB
134 local $ENV{PERL5LIB} = join $Config{path_sep}, $fake_mod_dir;
135 local *ExtUtils::Installed::Config;
136 %ExtUtils::Installed::Config = (
139 sitearchexp => cwd(),
142 my $realei = ExtUtils::Installed->new();
143 isa_ok( $realei, 'ExtUtils::Installed' );
144 isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' );
145 is( $realei->{Perl}{version}, $Config{version},
146 'new() should set Perl version from %Config' );
148 ok( exists $realei->{FakeMod},
149 'new() should find modules with .packlists using PERL5LIB'
151 isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' );
152 is( $realei->{FakeMod}{version}, '1.1.1',
153 '... should find version in modules' );
156 # Do the same thing as the last block, but with overrides for
159 my $config_override = { %Config::Config };
160 $config_override->{archlibexp} = cwd();
161 $config_override->{sitearchexp} = $fake_mod_dir;
162 $config_override->{version} = 'fake_test_version';
164 my @inc_override = (@INC, $fake_mod_dir);
166 my $realei = ExtUtils::Installed->new(
167 'config_override' => $config_override,
168 'inc_override' => \@inc_override,
170 isa_ok( $realei, 'ExtUtils::Installed' );
171 isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' );
172 is( $realei->{Perl}{version}, 'fake_test_version',
173 'new(config_override => HASH) overrides %Config' );
175 ok( exists $realei->{FakeMod}, 'new() with overrides should find modules with .packlists');
176 isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' );
177 is( $realei->{FakeMod}{version}, '1.1.1',
178 '... should find version in modules' );
181 # Check if extra_libs works.
183 my $realei = ExtUtils::Installed->new(
184 'extra_libs' => [ cwd() ],
186 isa_ok( $realei, 'ExtUtils::Installed' );
187 isa_ok( $realei->{Perl}{packlist}, 'ExtUtils::Packlist' );
188 ok( exists $realei->{FakeMod},
189 'new() with extra_libs should find modules with .packlists');
191 #{ use Data::Dumper; local $realei->{':private:'}{Config};
192 # warn Dumper($realei); }
194 isa_ok( $realei->{FakeMod}{packlist}, 'ExtUtils::Packlist' );
195 is( $realei->{FakeMod}{version}, '1.1.1',
196 '... should find version in modules' );
200 $ei->{$_} = 1 for qw( abc def ghi );
201 is( join(' ', $ei->modules()), 'abc def ghi',
202 'modules() should return sorted keys' );
204 # This didn't work for a long time due to a sort in scalar context oddity.
205 is( $ei->modules, 3, 'modules() in scalar context' );
210 ($Config{man1direxp} ?
211 (File::Spec->catdir($Config{man1direxp}, 'foo') => 1) :
213 ($Config{man3direxp} ?
214 (File::Spec->catdir($Config{man3direxp}, 'bar') => 1) :
216 File::Spec->catdir($prefix, 'foobar') => 1,
221 eval { $ei->files('badmod') };
222 like( $@, qr/badmod is not installed/,'files() should croak given bad modname');
223 eval { $ei->files('goodmod', 'badtype' ) };
224 like( $@, qr/type must be/,'files() should croak given bad type' );
228 skip('no man directory man1dir on this system', 2)
229 unless $Config{man1direxp};
230 @files = $ei->files('goodmod', 'doc', $Config{man1direxp});
231 is( scalar @files, 1, '... should find doc file under given dir' );
232 is( (grep { /foo$/ } @files), 1, '... checking file name' );
235 skip('no man directories on this system', 1) unless $mandirs;
236 @files = $ei->files('goodmod', 'doc');
237 is( scalar @files, $mandirs, '... should find all doc files with no dir' );
240 @files = $ei->files('goodmod', 'prog', 'fake', 'fake2');
241 is( scalar @files, 0, '... should find no doc files given wrong dirs' );
242 @files = $ei->files('goodmod', 'prog');
243 is( scalar @files, 1, '... should find doc file in correct dir' );
244 like( $files[0], qr/foobar[>\]]?$/, '... checking file name' );
245 @files = $ei->files('goodmod');
246 is( scalar @files, 2 + $mandirs, '... should find all files with no type specified' );
247 my %dirnames = map { lc($_) => dirname($_) } @files;
250 my @dirs = $ei->directories('goodmod', 'prog', 'fake');
251 is( scalar @dirs, 0, 'directories() should return no dirs if no files found' );
254 skip('no man directories on this system', 1) unless $mandirs;
255 @dirs = $ei->directories('goodmod', 'doc');
256 is( scalar @dirs, $mandirs, '... should find all files files() would' );
258 @dirs = $ei->directories('goodmod');
259 is( scalar @dirs, 2 + $mandirs, '... should find all files files() would, again' );
260 @files = sort map { exists $dirnames{lc($_)} ? $dirnames{lc($_)} : '' } @files;
261 is( join(' ', @files), join(' ', @dirs), '... should sort output' );
266 (dirname($Config{man1direxp}) eq dirname($Config{man3direxp}))
270 skip('no man directories on this system', 1) unless $mandirs;
271 @dirs = $ei->directory_tree('goodmod', 'doc', $Config{man1direxp} ?
272 dirname($Config{man1direxp}) : dirname($Config{man3direxp}));
273 is( scalar @dirs, $expectdirs,
274 'directory_tree() should report intermediate dirs to those requested' );
277 my $fakepak = Fakepak->new(102);
281 packlist => $fakepak,
284 # these should all croak
285 foreach my $sub (qw( validate packlist version )) {
286 eval { $ei->$sub('nomod') };
287 like( $@, qr/nomod is not installed/,
288 "$sub() should croak when asked about uninstalled module" );
292 is( $ei->validate('yesmod'), 'validated',
293 'validate() should return results of packlist validate() call' );
296 is( ${ $ei->packlist('yesmod') }, 102,
297 'packlist() should report installed mod packlist' );
300 is( $ei->version('yesmod'), 101,
301 'version() should report installed mod version' );
308 bless(\(my $scalar = shift), $class);