This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Module-Build to CPAN version 0.4200
[perl5.git] / cpan / Module-Build / t / extend.t
1 #!/usr/bin/perl -w
2
3 use strict;
4 use lib 't/lib';
5 use MBTest tests => 63;
6
7 blib_load('Module::Build');
8
9 my $tmp = MBTest->tmpdir;
10
11 use DistGen;
12 my $dist = DistGen->new( dir => $tmp );
13 $dist->regen;
14
15 $dist->chdir_in;
16
17 #########################
18
19 # Here we make sure actions are only called once per dispatch()
20 $::x = 0;
21 my $mb = Module::Build->subclass
22   (
23    code => "sub ACTION_loop { die 'recursed' if \$::x++; shift->depends_on('loop'); }"
24   )->new( module_name => $dist->name );
25 ok $mb;
26
27 $mb->dispatch('loop');
28 ok $::x;
29
30 $mb->dispatch('realclean');
31
32 # Make sure the subclass can be subclassed
33 my $build2class = ref($mb)->subclass
34   (
35    code => "sub ACTION_loop2 {}",
36    class => 'MBB',
37   );
38 can_ok( $build2class, 'ACTION_loop' );
39 can_ok( $build2class, 'ACTION_loop2' );
40
41
42 { # Make sure globbing works in filenames
43   $dist->add_file( 'script', <<'---' );
44 #!perl -w
45 print "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;
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;
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');
81   is_deeply $mb->build_elements, [qw(PL support pm xs share_dir pod script foo)],
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 => {abstract => 'bar'},
187                                   conflicts => {'Foo::Barxx' => 0},
188                                 );
189   my $data = $mb->get_metadata;
190   is_deeply $data->{abstract}, 'bar';
191
192   $mb->meta_merge(abstract => 'baz');
193   $data = $mb->get_metadata;
194   is_deeply $data->{abstract}, 'baz';
195
196   $mb->meta_merge(
197     'meta-spec' => { version => 2 },
198     prereqs => {
199       test => {
200         requirements => {
201           'Foo::Fooxx' => 0,
202         }
203       }
204     }
205   );
206   $data = $mb->get_metadata;
207   is_deeply $data->{prereqs}{test}{requirements}, { 'Foo::Fooxx' => 0 };
208
209 }
210
211 {
212   # Test interactive prompting
213
214   my $ans;
215   local $ENV{PERL_MM_USE_DEFAULT};
216
217   local $^W = 0;
218   local *{Module::Build::_readline} = sub { 'y' };
219
220   ok my $mb = Module::Build->new(
221                                   module_name => $dist->name,
222                                   license => 'perl',
223                                 );
224
225   eval{ $mb->prompt() };
226   like $@, qr/called without a prompt/, 'prompt() requires a prompt';
227
228   eval{ $mb->y_n() };
229   like $@, qr/called without a prompt/, 'y_n() requires a prompt';
230
231   eval{ $mb->y_n('Prompt?', 'invalid default') };
232   like $@, qr/Invalid default/, "y_n() requires a default of 'y' or 'n'";
233
234
235   $ENV{PERL_MM_USE_DEFAULT} = 1;
236
237   eval{ $mb->y_n('Is this a question?') };
238   print "\n"; # fake <enter> because the prompt prints before the checks
239   like $@, qr/ERROR:/,
240        'Do not allow default-less y_n() for unattended builds';
241
242   eval{ $ans = $mb->prompt('Is this a question?') };
243   print "\n"; # fake <enter> because the prompt prints before the checks
244   like $@, qr/ERROR:/,
245        'Do not allow default-less prompt() for unattended builds';
246
247
248   # When running Test::Smoke under a cron job, STDIN will be closed which
249   # will fool our _is_interactive() method causing various failures.
250   {
251     local *{Module::Build::_is_interactive} = sub { 1 };
252
253     $ENV{PERL_MM_USE_DEFAULT} = 0;
254
255     $ans = $mb->prompt('Is this a question?');
256     print "\n"; # fake <enter> after input
257     is $ans, 'y', "prompt() doesn't require default for interactive builds";
258
259     $ans = $mb->y_n('Say yes');
260     print "\n"; # fake <enter> after input
261     ok $ans, "y_n() doesn't require default for interactive build";
262
263
264     # Test Defaults
265     *{Module::Build::_readline} = sub { '' };
266
267     $ans = $mb->prompt("Is this a question");
268     is $ans, '', "default for prompt() without a default is ''";
269
270     $ans = $mb->prompt("Is this a question", 'y');
271     is $ans, 'y', "  prompt() with a default";
272
273     $ans = $mb->y_n("Is this a question", 'y');
274     ok $ans, "  y_n() with a default";
275
276     my @ans = $mb->prompt("Is this a question", undef);
277     is_deeply([@ans], [undef], "  prompt() with undef() default");
278   }
279
280 }
281