This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Updated CPANPLUS to cpan release 0.90
[perl5.git] / cpan / Module-Build / t / extend.t
CommitLineData
bb4e9162
YST
1#!/usr/bin/perl -w
2
3use strict;
10b84a45 4use lib 't/lib';
613f422f 5use MBTest tests => 64;
738349a8 6
613f422f 7blib_load('Module::Build');
bb4e9162 8
7a827510 9my $tmp = MBTest->tmpdir;
bb4e9162
YST
10
11use DistGen;
12my $dist = DistGen->new( dir => $tmp );
13$dist->regen;
14
738349a8 15$dist->chdir_in;
bb4e9162
YST
16
17#########################
18
bb4e9162
YST
19# Here we make sure actions are only called once per dispatch()
20$::x = 0;
21my $mb = Module::Build->subclass
22 (
23 code => "sub ACTION_loop { die 'recursed' if \$::x++; shift->depends_on('loop'); }"
24 )->new( module_name => $dist->name );
25ok $mb;
26
27$mb->dispatch('loop');
28ok $::x;
29
30$mb->dispatch('realclean');
31
32# Make sure the subclass can be subclassed
33my $build2class = ref($mb)->subclass
34 (
35 code => "sub ACTION_loop2 {}",
36 class => 'MBB',
37 );
38can_ok( $build2class, 'ACTION_loop' );
39can_ok( $build2class, 'ACTION_loop2' );
40
41
42{ # Make sure globbing works in filenames
43 $dist->add_file( 'script', <<'---' );
44#!perl -w
45print "Hello, World!\n";
46---
47 $dist->regen;
48
49 $mb->test_files('*t*');
50 my $files = $mb->test_files;
51 ok grep {$_ eq 'script'} @$files;
94410036
DG
52 my $t_basic_t = File::Spec->catfile('t', 'basic.t');
53 $t_basic_t = VMS::Filespec::vmsify($t_basic_t) if $^O eq 'VMS';
54 ok grep {$_ eq $t_basic_t} @$files;
bb4e9162
YST
55 ok !grep {$_ eq 'Build.PL' } @$files;
56
57 # Make sure order is preserved
58 $mb->test_files('foo', 'bar');
59 $files = $mb->test_files;
60 is @$files, 2;
61 is $files->[0], 'foo';
62 is $files->[1], 'bar';
63
64 $dist->remove_file( 'script' );
65 $dist->regen( clean => 1 );
66}
67
68
69{
70 # Make sure we can add new kinds of stuff to the build sequence
71
72 $dist->add_file( 'test.foo', "content\n" );
73 $dist->regen;
74
75 my $mb = Module::Build->new( module_name => $dist->name,
76 foo_files => {'test.foo', 'lib/test.foo'} );
77 ok $mb;
78
79 $mb->add_build_element('foo');
80 $mb->add_build_element('foo');
613f422f 81 is_deeply $mb->build_elements, [qw(PL support pm xs share_dir pod script foo)],
bb4e9162
YST
82 'The foo element should be in build_elements only once';
83
84 $mb->dispatch('build');
85 ok -e File::Spec->catfile($mb->blib, 'lib', 'test.foo');
86
87 $mb->dispatch('realclean');
88
89 # revert distribution to a pristine state
90 $dist->remove_file( 'test.foo' );
91 $dist->regen( clean => 1 );
92}
93
94
95{
96 package MBSub;
97 use Test::More;
98 use vars qw($VERSION @ISA);
99 @ISA = qw(Module::Build);
100 $VERSION = 0.01;
101
102 # Add a new property.
103 ok(__PACKAGE__->add_property('foo'));
104 # Add a new property with a default value.
105 ok(__PACKAGE__->add_property('bar', 'hey'));
106 # Add a hash property.
107 ok(__PACKAGE__->add_property('hash', {}));
108
109
110 # Catch an exception adding an existing property.
111 eval { __PACKAGE__->add_property('module_name')};
112 like "$@", qr/already exists/;
113}
114
115{
116 package MBSub2;
117 use Test::More;
118 use vars qw($VERSION @ISA);
119 @ISA = qw(Module::Build);
120 $VERSION = 0.01;
121
122 # Add a new property with a different default value than MBSub has.
123 ok(__PACKAGE__->add_property('bar', 'yow'));
124}
125
126
127{
128 ok my $mb = MBSub->new( module_name => $dist->name );
129 isa_ok $mb, 'Module::Build';
130 isa_ok $mb, 'MBSub';
131 ok $mb->valid_property('foo');
132 can_ok $mb, 'module_name';
133
134 # Check foo property.
135 can_ok $mb, 'foo';
136 ok ! $mb->foo;
137 ok $mb->foo(1);
138 ok $mb->foo;
139
140 # Check bar property.
141 can_ok $mb, 'bar';
142 is $mb->bar, 'hey';
143 ok $mb->bar('you');
144 is $mb->bar, 'you';
145
146 # Check hash property.
147 ok $mb = MBSub->new(
148 module_name => $dist->name,
149 hash => { foo => 'bar', bin => 'foo'}
150 );
151
152 can_ok $mb, 'hash';
153 isa_ok $mb->hash, 'HASH';
154 is $mb->hash->{foo}, 'bar';
155 is $mb->hash->{bin}, 'foo';
156
157 # Check hash property passed via the command-line.
158 {
159 local @ARGV = (
160 '--hash', 'foo=bar',
161 '--hash', 'bin=foo',
162 );
163 ok $mb = MBSub->new( module_name => $dist->name );
164 }
165
166 can_ok $mb, 'hash';
167 isa_ok $mb->hash, 'HASH';
168 is $mb->hash->{foo}, 'bar';
169 is $mb->hash->{bin}, 'foo';
170
171 # Make sure that a different subclass with the same named property has a
172 # different default.
173 ok $mb = MBSub2->new( module_name => $dist->name );
174 isa_ok $mb, 'Module::Build';
175 isa_ok $mb, 'MBSub2';
176 ok $mb->valid_property('bar');
177 can_ok $mb, 'bar';
178 is $mb->bar, 'yow';
179}
180
181{
182 # Test the meta_add and meta_merge stuff
183 ok my $mb = Module::Build->new(
184 module_name => $dist->name,
185 license => 'perl',
186 meta_add => {foo => 'bar'},
187 conflicts => {'Foo::Barxx' => 0},
188 );
613f422f
DG
189 my $data = $mb->prepare_metadata;
190 is $data->{foo}, 'bar';
bb4e9162
YST
191
192 $mb->meta_merge(foo => 'baz');
613f422f
DG
193 $data = $mb->prepare_metadata;
194 is $data->{foo}, 'baz';
bb4e9162
YST
195
196 $mb->meta_merge(conflicts => {'Foo::Fooxx' => 0});
613f422f
DG
197 $data = $mb->prepare_metadata;
198 is_deeply $data->{conflicts}, {'Foo::Barxx' => 0, 'Foo::Fooxx' => 0};
bb4e9162
YST
199
200 $mb->meta_add(conflicts => {'Foo::Bazxx' => 0});
613f422f
DG
201 $data = $mb->prepare_metadata;
202 is_deeply $data->{conflicts}, {'Foo::Bazxx' => 0, 'Foo::Fooxx' => 0};
bb4e9162
YST
203}
204
dc8021d3
SP
205{
206 # Test interactive prompting
207
208 my $ans;
209 local $ENV{PERL_MM_USE_DEFAULT};
210
211 local $^W = 0;
212 local *{Module::Build::_readline} = sub { 'y' };
213
214 ok my $mb = Module::Build->new(
215 module_name => $dist->name,
216 license => 'perl',
217 );
218
219 eval{ $mb->prompt() };
220 like $@, qr/called without a prompt/, 'prompt() requires a prompt';
221
222 eval{ $mb->y_n() };
223 like $@, qr/called without a prompt/, 'y_n() requires a prompt';
224
225 eval{ $mb->y_n('Prompt?', 'invalid default') };
226 like $@, qr/Invalid default/, "y_n() requires a default of 'y' or 'n'";
227
228
77e96e88 229 $ENV{PERL_MM_USE_DEFAULT} = 1;
dc8021d3 230
77e96e88 231 eval{ $mb->y_n('Is this a question?') };
7253302f 232 print "\n"; # fake <enter> because the prompt prints before the checks
77e96e88
RGS
233 like $@, qr/ERROR:/,
234 'Do not allow default-less y_n() for unattended builds';
dc8021d3 235
77e96e88 236 eval{ $ans = $mb->prompt('Is this a question?') };
7253302f 237 print "\n"; # fake <enter> because the prompt prints before the checks
77e96e88
RGS
238 like $@, qr/ERROR:/,
239 'Do not allow default-less prompt() for unattended builds';
dc8021d3 240
77e96e88
RGS
241
242 # When running Test::Smoke under a cron job, STDIN will be closed which
243 # will fool our _is_interactive() method causing various failures.
244 {
245 local *{Module::Build::_is_interactive} = sub { 1 };
dc8021d3 246
f4892442 247 $ENV{PERL_MM_USE_DEFAULT} = 0;
dc8021d3 248
77e96e88 249 $ans = $mb->prompt('Is this a question?');
f4892442
SP
250 print "\n"; # fake <enter> after input
251 is $ans, 'y', "prompt() doesn't require default for interactive builds";
dc8021d3 252
77e96e88 253 $ans = $mb->y_n('Say yes');
f4892442
SP
254 print "\n"; # fake <enter> after input
255 ok $ans, "y_n() doesn't require default for interactive build";
dc8021d3
SP
256
257
f4892442
SP
258 # Test Defaults
259 *{Module::Build::_readline} = sub { '' };
dc8021d3 260
77e96e88 261 $ans = $mb->prompt("Is this a question");
f4892442 262 is $ans, '', "default for prompt() without a default is ''";
dc8021d3 263
77e96e88 264 $ans = $mb->prompt("Is this a question", 'y');
f4892442 265 is $ans, 'y', " prompt() with a default";
dc8021d3 266
77e96e88 267 $ans = $mb->y_n("Is this a question", 'y');
f4892442 268 ok $ans, " y_n() with a default";
7253302f
SP
269
270 my @ans = $mb->prompt("Is this a question", undef);
271 is_deeply([@ans], [undef], " prompt() with undef() default");
f4892442 272 }
77e96e88 273
dc8021d3 274}
bb4e9162 275