Commit | Line | Data |
6aaee015 |
1 | BEGIN { |
2 | use FindBin; |
3 | use File::Spec; |
4 | |
5 | ### paths to our own 'lib' and 'inc' dirs |
6 | ### include them, relative from t/ |
7 | my @paths = map { "$FindBin::Bin/$_" } qw[../lib inc]; |
8 | |
9 | ### absolute'ify the paths in @INC; |
10 | my @rel2abs = map { File::Spec->rel2abs( $_ ) } |
11 | grep { not File::Spec->file_name_is_absolute( $_ ) } @INC; |
12 | |
13 | ### use require to make devel::cover happy |
14 | require lib; |
15 | for ( @paths, @rel2abs ) { |
16 | my $l = 'lib'; |
17 | $l->import( $_ ) |
18 | } |
19 | |
20 | use Config; |
21 | |
22 | ### and add them to the environment, so shellouts get them |
23 | $ENV{'PERL5LIB'} = join ':', |
24 | grep { defined } $ENV{'PERL5LIB'}, @paths, @rel2abs; |
25 | |
26 | ### add our own path to the front of $ENV{PATH}, so that cpanp-run-perl |
27 | ### and friends get picked up |
28 | $ENV{'PATH'} = join $Config{'path_sep'}, |
29 | grep { defined } "$FindBin::Bin/../bin", $ENV{'PATH'}; |
30 | |
31 | ### Fix up the path to perl, as we're about to chdir |
32 | ### but only under perlcore, or if the path contains delimiters, |
33 | ### meaning it's relative, but not looked up in your $PATH |
34 | $^X = File::Spec->rel2abs( $^X ) |
35 | if $ENV{PERL_CORE} or ( $^X =~ m|[/\\]| ); |
36 | |
37 | ### chdir to our own test dir, so we know all files are relative |
38 | ### to this point, no matter whether run from perlcore tests or |
39 | ### regular CPAN installs |
40 | chdir "$FindBin::Bin" if -d "$FindBin::Bin" |
41 | } |
42 | |
43 | BEGIN { |
44 | use IPC::Cmd; |
45 | |
46 | ### Win32 has issues with redirecting FD's properly in IPC::Run: |
47 | ### Can't redirect fd #4 on Win32 at IPC/Run.pm line 2801 |
48 | $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32'; |
49 | $IPC::Cmd::USE_IPC_RUN = 0 if $^O eq 'MSWin32'; |
50 | } |
51 | |
52 | use strict; |
53 | use CPANPLUS::Configure; |
983ffab6 |
54 | use CPANPLUS::Error (); |
6aaee015 |
55 | |
56 | use File::Path qw[rmtree]; |
57 | use FileHandle; |
58 | use File::Basename qw[basename]; |
59 | |
60 | { ### Force the ignoring of .po files for L::M::S |
61 | $INC{'Locale::Maketext::Lexicon.pm'} = __FILE__; |
62 | $Locale::Maketext::Lexicon::VERSION = 0; |
63 | } |
64 | |
65 | # prereq has to be in our package file && core! |
66 | use constant TEST_CONF_PREREQ => 'Cwd'; |
67 | use constant TEST_CONF_MODULE => 'Foo::Bar::EU::NOXS'; |
68 | use constant TEST_CONF_INST_MODULE => 'Foo::Bar'; |
69 | use constant TEST_CONF_INVALID_MODULE => 'fnurk'; |
494f1016 |
70 | use constant TEST_CONF_MIRROR_DIR => 'dummy-localmirror'; |
6aaee015 |
71 | |
72 | ### we might need this Some Day when we're installing into |
73 | ### our own sandbox. see t/20.t for details |
74 | # use constant TEST_INSTALL_DIR => do { |
75 | # my $dir = File::Spec->rel2abs( 'dummy-perl' ); |
76 | # |
77 | # ### clean up paths if we are on win32 |
78 | # ### dirs with spaces will be.. bad :( |
79 | # $^O eq 'MSWin32' |
80 | # ? Win32::GetShortPathName( $dir ) |
81 | # : $dir; |
82 | # }; |
83 | |
84 | # use constant TEST_INSTALL_DIR_LIB |
85 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'lib' ); |
86 | # use constant TEST_INSTALL_DIR_BIN |
87 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'bin' ); |
88 | # use constant TEST_INSTALL_DIR_MAN1 |
89 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man1' ); |
90 | # use constant TEST_INSTALL_DIR_MAN3 |
91 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'man', 'man3' ); |
92 | # use constant TEST_INSTALL_DIR_ARCH |
93 | # => File::Spec->catdir( TEST_INSTALL_DIR, 'arch' ); |
94 | # |
95 | # use constant TEST_INSTALL_EU_MM_FLAGS => |
96 | # ' INSTALLDIRS=site' . |
97 | # ' INSTALLSITELIB=' . TEST_INSTALL_DIR_LIB . |
98 | # ' INSTALLSITEARCH=' . TEST_INSTALL_DIR_ARCH . # .packlist |
99 | # ' INSTALLARCHLIB=' . TEST_INSTALL_DIR_ARCH . # perllocal.pod |
100 | # ' INSTALLSITEBIN=' . TEST_INSTALL_DIR_BIN . |
101 | # ' INSTALLSCRIPT=' . TEST_INSTALL_DIR_BIN . |
102 | # ' INSTALLSITEMAN1DIR=' . TEST_INSTALL_DIR_MAN1 . |
103 | # ' INSTALLSITEMAN3DIR=' . TEST_INSTALL_DIR_MAN3; |
104 | |
105 | |
106 | sub gimme_conf { |
d0baa00e |
107 | |
108 | ### don't load any other configs than the heuristic one |
109 | ### during tests. They might hold broken/incorrect data |
110 | ### for our test suite. Bug [perl #43629] showed this. |
111 | my $conf = CPANPLUS::Configure->new( load_configs => 0 ); |
6aaee015 |
112 | $conf->set_conf( hosts => [ { |
113 | path => 'dummy-CPAN', |
114 | scheme => 'file', |
115 | } ], |
116 | ); |
117 | $conf->set_conf( base => 'dummy-cpanplus' ); |
118 | $conf->set_conf( dist_type => '' ); |
119 | $conf->set_conf( signature => 0 ); |
120 | |
622d31ac |
121 | ### dmq tells us that we should run with /nologo |
122 | ### if using nmake, as it's very noise otherwise. |
123 | { my $make = $conf->get_program('make'); |
124 | if( $make and basename($make) =~ /^nmake/i and |
125 | $make !~ m|/nologo| |
126 | ) { |
127 | $make .= ' /nologo'; |
128 | $conf->set_program( make => $make ); |
129 | } |
130 | } |
131 | |
6aaee015 |
132 | _clean_test_dir( [ |
133 | $conf->get_conf('base'), |
494f1016 |
134 | TEST_CONF_MIRROR_DIR, |
6aaee015 |
135 | # TEST_INSTALL_DIR_LIB, |
136 | # TEST_INSTALL_DIR_BIN, |
137 | # TEST_INSTALL_DIR_MAN1, |
138 | # TEST_INSTALL_DIR_MAN3, |
53873a16 |
139 | ], ( $ENV{PERL_CORE} ? 0 : 1 ) ); |
6aaee015 |
140 | |
141 | return $conf; |
142 | }; |
143 | |
494f1016 |
144 | { |
145 | my $fh; |
146 | my $file = ".".basename($0).".output"; |
147 | sub output_handle { |
148 | return $fh if $fh; |
149 | |
150 | $fh = FileHandle->new(">$file") |
151 | or warn "Could not open output file '$file': $!"; |
152 | |
153 | $fh->autoflush(1); |
154 | return $fh; |
155 | } |
6aaee015 |
156 | |
494f1016 |
157 | sub output_file { return $file } |
983ffab6 |
158 | |
159 | |
160 | my $env = 'PERL5_CPANPLUS_TEST_VERBOSE'; |
161 | ### redirect output from msg() and error() output to file |
162 | unless( $ENV{$env} ) { |
163 | |
164 | print "# To run tests in verbose mode, set ". |
165 | "\$ENV{PERL5_CPANPLUS_TEST_VERBOSE} = 1\n" unless $ENV{PERL_CORE}; |
166 | |
167 | unlink $file; # just in case |
168 | |
169 | $CPANPLUS::Error::ERROR_FH = |
170 | $CPANPLUS::Error::ERROR_FH = output_handle(); |
171 | |
172 | $CPANPLUS::Error::MSG_FH = |
173 | $CPANPLUS::Error::MSG_FH = output_handle(); |
174 | |
175 | } |
6aaee015 |
176 | } |
177 | |
494f1016 |
178 | |
179 | ### clean these files if we're under perl core |
180 | END { |
181 | if ( $ENV{PERL_CORE} ) { |
182 | close output_handle(); 1 while unlink output_file(); |
183 | |
184 | _clean_test_dir( [ |
185 | gimme_conf->get_conf('base'), |
186 | TEST_CONF_MIRROR_DIR, |
187 | # TEST_INSTALL_DIR_LIB, |
188 | # TEST_INSTALL_DIR_BIN, |
189 | # TEST_INSTALL_DIR_MAN1, |
190 | # TEST_INSTALL_DIR_MAN3, |
53873a16 |
191 | ], 0 ); # DO NOT be verbose under perl core -- makes tests fail |
494f1016 |
192 | } |
193 | } |
194 | |
195 | |
6aaee015 |
196 | |
197 | ### whenever we start a new script, we want to clean out our |
198 | ### old files from the test '.cpanplus' dir.. |
199 | sub _clean_test_dir { |
200 | my $dirs = shift || []; |
201 | my $verbose = shift || 0; |
202 | |
203 | for my $dir ( @$dirs ) { |
204 | |
53873a16 |
205 | ### no point if it doesn't exist; |
206 | next unless -d $dir; |
207 | |
6aaee015 |
208 | my $dh; |
209 | opendir $dh, $dir or die "Could not open basedir '$dir': $!"; |
210 | while( my $file = readdir $dh ) { |
211 | next if $file =~ /^\./; # skip dot files |
212 | |
213 | my $path = File::Spec->catfile( $dir, $file ); |
214 | |
215 | ### directory, rmtree it |
216 | if( -d $path ) { |
53873a16 |
217 | print "# Deleting directory '$path'\n" if $verbose; |
6aaee015 |
218 | eval { rmtree( $path ) }; |
219 | warn "Could not delete '$path' while cleaning up '$dir'" if $@; |
220 | |
221 | ### regular file |
222 | } else { |
983ffab6 |
223 | print "# Deleting file '$path'\n" if $verbose; |
6aaee015 |
224 | 1 while unlink $path; |
225 | } |
226 | } |
227 | |
228 | close $dh; |
229 | } |
230 | |
231 | return 1; |
232 | } |
233 | 1; |