1 ### make sure we can find our conf.pl file
4 require "$FindBin::Bin/inc/conf.pl";
8 use Test::More 'no_plan';
10 my $Class = 'CPANPLUS::inc';
12 can_ok( $Class, qw[original_perl5opt original_perl5lib original_inc] );
16 # XXX CPANPLUS::inc functionality is obsolete, so it is removed
18 my $Module = 'Params::Check';
19 my $File = File::Spec->catfile(qw|Params Check.pm|);
20 my $Ufile = 'Params/Check.pm';
21 my $Boring = 'IO::File';
22 my $Bfile = 'IO/File.pm';
26 ### now, first element should be a coderef ###
28 is( ref $code, 'CODE', 'Coderef loaded in @INC' );
30 ### check interesting modules ###
31 { my $mods = CPANPLUS::inc->interesting_modules();
32 ok( $mods, "Retrieved interesting modules list" );
33 is( ref $mods, 'HASH', " It's a hashref" );
34 ok( scalar(keys %$mods), " With some keys in it" );
35 ok( $mods->{$Module}, " Found a module we care about" );
38 ### checking include path ###
40 my $path = CPANPLUS::inc->inc_path();
41 ok( $path, "Retrieved include path" );
42 ok( -d $path, " Include path is an actual directory" );
44 ### XXX no more files are bundled this way, it's obsolete
45 #skip "No files actually bundled in perl core", 1 if $ENV{PERL_CORE};
46 #ok( -s File::Spec->catfile( $path, $File ),
47 # " Found '$File' in include path" );
49 ### we don't do this anymore
50 #my $out = join '', `$^X -V`; my $qm_path = quotemeta $path;
51 #like( $out, qr/$qm_path/s, " Path found in perl -V output" );
54 ### back to the coderef ###
55 ### try a boring module ###
56 { local $CPANPLUS::inc::DEBUG = 1;
57 my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" };
59 my $rv = $code->($code, $Bfile);
60 ok( !$rv, "Ignoring boring module" );
61 ok( !$INC{$Bfile}, " Boring file not loaded" );
62 like( $warnings, qr/CPANPLUS::inc: Not interested in '$Boring'/s,
63 " Warned about boringness" );
66 ### try to load a module with windows paths in it (bug [#11177])
67 { local $CPANPLUS::inc::DEBUG = 1;
68 my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" };
70 my $wfile = 'IO\File.pm';
71 my $wmod = 'IO::File';
73 my $rv = $code->($code, $wfile);
74 ok( !$rv, "Ignoring boring win32 module" );
75 ok( !$INC{$wfile}, " Boring win32 file not loaded" );
76 like( $warnings, qr/CPANPLUS::inc: Not interested in '$wmod'/s,
77 " Warned about boringness" );
80 ### try an interesting module ###
81 { local $CPANPLUS::inc::DEBUG = 1;
82 my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" };
84 my $rv = $code->($code, $Ufile);
85 ok( $rv, "Found interesting module" );
86 ok( !$INC{$Ufile}, " Interesting file not loaded" );
87 like( $warnings, qr/CPANPLUS::inc: Found match for '$Module'/,
88 " Match noted in warnings" );
89 like( $warnings, qr/CPANPLUS::inc: Best match for '$Module'/,
90 " Best match noted in warnings" );
92 my $contents = do { local $/; <$rv> };
93 ok( $contents, " Read contents from filehandle" );
94 like( $contents, qr/$Module/s,
95 " Contents is from '$Module'" );
98 ### now do some real loading ###
100 ok( $INC{$Ufile}, " Regular use of '$Module'" );
103 ok( $INC{$Bfile}, " Regular use of '$Boring'" );
106 ### check we didn't load our coderef anymore than needed ###
108 for( 0..$amount ) { CPANPLUS::inc->import; };
111 map { $flag++ if ref $_ eq 'CODE' } @INC[0..$amount];
113 my $ok = $amount + 1 == $flag ? 0 : 1;
114 ok( $ok, "Only loaded coderef into \@INC $flag times");
117 ### check limit funcionality
118 { local $CPANPLUS::inc::DEBUG = 1;
119 my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" };
121 ### so we can reload it
125 ### limit to the loading of $Boring;
126 CPANPLUS::inc->import( $Boring );
128 ok( $CPANPLUS::inc::LIMIT{$Boring},
129 "Limit to '$Boring' recorded" );
131 ### try a boring file first
132 { my $rv = $code->($code, $Bfile);
133 ok( !$rv, " '$Boring' still not being loaded" );
134 ok( !$INC{$Bfile}, ' Is not in %INC either' );
137 ### try an interesting one now
138 { my $rv = $code->( $code, $Ufile );
139 ok( !$rv, " '$Module' is not being loaded" );
140 ok( !$INC{$Ufile}, ' Is not in %INC either' );
141 like( $warnings, qr/CPANPLUS::inc: Limits active, '$Module'/s,
142 " Warned about limits" );
145 ### reset limits, try again
146 { local %CPANPLUS::inc::LIMIT;
147 ok( !keys(%CPANPLUS::inc::LIMIT),
151 my $rv = $code->( $code, $Ufile );
152 ok( $rv, " '$Module' is being loaded" );
155 ok( $INC{$Ufile}, ' Present in %INC' );
159 ### test limited perl5opt, to include just a few modules
160 { my $dash_m = quotemeta '-MCPANPLUS::inc';
161 my $dash_i = quotemeta '-I' . CPANPLUS::inc->my_path;
162 my $orgopt = quotemeta CPANPLUS::inc->original_perl5opt;
164 ### first try an empty string;
165 { my $str = CPANPLUS::inc->limited_perl5opt;
166 ok( !$str, "limited_perl5opt without args is empty" );
169 ### try with one 'modules'
170 { my $str = CPANPLUS::inc->limited_perl5opt(qw[A]);
171 ok( $str, "limted perl5opt set for 1 module" );
172 like( $str, qr/$dash_m=A\b/,
173 " -M set properly" );
174 like( $str, qr/$dash_i/," -I set properly" );
175 like( $str, qr/$orgopt/," Original opts preserved" );
178 ### try with more 'modules'
179 { my $str = CPANPLUS::inc->limited_perl5opt(qw[A B C]);
180 ok( $str, "limted perl5opt set for 3 modules" );
181 like( $str, qr/$dash_m=A,B,C\b/,
182 " -M set properly" );
183 like( $str, qr/$dash_i/," -I set properly" );
184 like( $str, qr/$orgopt/," Original opts preserved" );