Commit | Line | Data |
---|---|---|
46de787b CBW |
1 | #!/usr/bin/perl -w |
2 | ||
3 | use strict; | |
4 | use lib 't/lib'; | |
5 | use MBTest tests => 9; | |
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 | ||
20 | # make sure Test::Harness loaded before we define Test::Harness::runtests otherwise we'll | |
21 | # get another redefined warning inside Test::Harness::runtests | |
22 | use Test::Harness; | |
23 | ||
24 | { | |
25 | package MB::Subclass; | |
26 | use base qw(Module::Build); | |
27 | sub harness_switches { } | |
28 | } | |
29 | ||
30 | { | |
31 | local $SIG{__WARN__} = sub { die "Termination after a warning: $_[0]"}; | |
32 | my $mock1 = { A => 1 }; | |
33 | my $mock2 = { B => 2 }; | |
34 | ||
35 | no warnings qw[redefine once]; | |
36 | ||
37 | # This runs run_test_harness with Test::Harness::switches = undef and harness_switches() returning empty list, | |
38 | # ensure there are no warnings, and output is undef too | |
39 | { | |
40 | my $mb = MB::Subclass->new( module_name => $dist->name ); | |
41 | local *Test::Harness::runtests = sub { | |
42 | is shift(), $mock1, "runtests ran with expected parameters"; | |
43 | is shift(), $mock2, "runtests ran with expected parameters"; | |
44 | is $Test::Harness::switches, undef, "switches are undef"; | |
45 | is $Test::Harness::Switches, undef, "switches are undef"; | |
46 | }; | |
47 | ||
48 | # $Test::Harness::switches and $Test::Harness::switches are aliases, but we pretend we don't know this | |
49 | local $Test::Harness::switches = undef; | |
50 | local $Test::Harness::switches = undef; | |
51 | $mb->run_test_harness([$mock1, $mock2]); | |
52 | ||
53 | ok 1, "run_test_harness should not produce warning if Test::Harness::[Ss]witches are undef and harness_switches() return empty list"; | |
54 | } | |
55 | ||
56 | # This runs run_test_harness with Test::Harness::switches = '' and harness_switches() returning empty list, | |
57 | # ensure there are no warnings, and switches are empty string | |
58 | { | |
59 | my $mb = MB::Subclass->new( module_name => $dist->name ); | |
60 | local *Test::Harness::runtests = sub { | |
61 | is shift(), $mock1, "runtests ran with expected parameters"; | |
62 | is shift(), $mock2, "runtests ran with expected parameters"; | |
63 | is $Test::Harness::switches, '', "switches are empty string"; | |
64 | is $Test::Harness::Switches, '', "switches are empty string"; | |
65 | }; | |
66 | ||
67 | # $Test::Harness::switches and $Test::Harness::switches are aliases, but we pretend we don't know this | |
68 | local $Test::Harness::switches = ''; | |
69 | local $Test::Harness::switches = ''; | |
70 | $mb->run_test_harness([$mock1, $mock2]); | |
71 | } | |
72 | ||
73 | } |