Commit | Line | Data |
6aaee015 |
1 | ### make sure we can find our conf.pl file |
2 | BEGIN { |
3 | use FindBin; |
4 | require "$FindBin::Bin/inc/conf.pl"; |
5 | } |
6 | |
7 | use strict; |
8 | use Test::More 'no_plan'; |
9 | |
10 | my $Class = 'CPANPLUS::inc'; |
11 | use_ok( $Class ); |
12 | can_ok( $Class, qw[original_perl5opt original_perl5lib original_inc] ); |
13 | |
14 | __END__ |
15 | |
16 | # XXX CPANPLUS::inc functionality is obsolete, so it is removed |
17 | |
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'; |
23 | |
24 | |
25 | |
26 | ### now, first element should be a coderef ### |
27 | my $code = $INC[0]; |
28 | is( ref $code, 'CODE', 'Coderef loaded in @INC' ); |
29 | |
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" ); |
36 | } |
37 | |
38 | ### checking include path ### |
39 | SKIP: { |
40 | my $path = CPANPLUS::inc->inc_path(); |
41 | ok( $path, "Retrieved include path" ); |
42 | ok( -d $path, " Include path is an actual directory" ); |
43 | |
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" ); |
48 | |
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" ); |
52 | } |
53 | |
54 | ### back to the coderef ### |
55 | ### try a boring module ### |
56 | { local $CPANPLUS::inc::DEBUG = 1; |
57 | my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" }; |
58 | |
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" ); |
64 | } |
65 | |
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 .= "@_" }; |
69 | |
70 | my $wfile = 'IO\File.pm'; |
71 | my $wmod = 'IO::File'; |
72 | |
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" ); |
78 | } |
79 | |
80 | ### try an interesting module ### |
81 | { local $CPANPLUS::inc::DEBUG = 1; |
82 | my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" }; |
83 | |
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" ); |
91 | |
92 | my $contents = do { local $/; <$rv> }; |
93 | ok( $contents, " Read contents from filehandle" ); |
94 | like( $contents, qr/$Module/s, |
95 | " Contents is from '$Module'" ); |
96 | } |
97 | |
98 | ### now do some real loading ### |
99 | { use_ok($Module); |
100 | ok( $INC{$Ufile}, " Regular use of '$Module'" ); |
101 | |
102 | use_ok($Boring); |
103 | ok( $INC{$Bfile}, " Regular use of '$Boring'" ); |
104 | } |
105 | |
106 | ### check we didn't load our coderef anymore than needed ### |
107 | { my $amount = 5; |
108 | for( 0..$amount ) { CPANPLUS::inc->import; }; |
109 | |
110 | my $flag; |
111 | map { $flag++ if ref $_ eq 'CODE' } @INC[0..$amount]; |
112 | |
113 | my $ok = $amount + 1 == $flag ? 0 : 1; |
114 | ok( $ok, "Only loaded coderef into \@INC $flag times"); |
115 | } |
116 | |
117 | ### check limit funcionality |
118 | { local $CPANPLUS::inc::DEBUG = 1; |
119 | my $warnings; local $SIG{__WARN__} = sub { $warnings .= "@_" }; |
120 | |
121 | ### so we can reload it |
122 | delete $INC{$Ufile}; |
123 | delete $INC{$Bfile}; |
124 | |
125 | ### limit to the loading of $Boring; |
126 | CPANPLUS::inc->import( $Boring ); |
127 | |
128 | ok( $CPANPLUS::inc::LIMIT{$Boring}, |
129 | "Limit to '$Boring' recorded" ); |
130 | |
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' ); |
135 | } |
136 | |
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" ); |
143 | } |
144 | |
145 | ### reset limits, try again |
146 | { local %CPANPLUS::inc::LIMIT; |
147 | ok( !keys(%CPANPLUS::inc::LIMIT), |
148 | " Limits removed" ); |
149 | |
150 | |
151 | my $rv = $code->( $code, $Ufile ); |
152 | ok( $rv, " '$Module' is being loaded" ); |
153 | |
154 | use_ok( $Module ); |
155 | ok( $INC{$Ufile}, ' Present in %INC' ); |
156 | } |
157 | } |
158 | |
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; |
163 | |
164 | ### first try an empty string; |
165 | { my $str = CPANPLUS::inc->limited_perl5opt; |
166 | ok( !$str, "limited_perl5opt without args is empty" ); |
167 | } |
168 | |
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" ); |
176 | } |
177 | |
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" ); |
185 | } |
186 | } |
187 | |
188 | |
189 | |
190 | |