The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

LEONT / Module-Build-0.4234 / t / unit_run_test_harness.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

              
#!/usr/bin/perl -w
use strict;
use lib 't/lib';
use MBTest tests => 9;
blib_load('Module::Build');
my $tmp = MBTest->tmpdir;
use DistGen;
my $dist = DistGen->new( dir => $tmp );
$dist->regen;
$dist->chdir_in;
#########################
# make sure Test::Harness loaded before we define Test::Harness::runtests otherwise we'll
# get another redefined warning inside Test::Harness::runtests
use Test::Harness;
{
  package MB::Subclass;
  use base qw(Module::Build);
  sub harness_switches { return }
}
{
  local $SIG{__WARN__} = sub { die "Termination after a warning: $_[0]"};
  my $mock1 = { A => 1 };
  my $mock2 = { B => 2 };
  no warnings qw[redefine once];
  # This runs run_test_harness with Test::Harness::switches = undef and harness_switches() returning empty list,
  # ensure there are no warnings, and output is empty too
  {
    my $mb = MB::Subclass->new( module_name => $dist->name );
    local *Test::Harness::runtests = sub {
      is shift(), $mock1, "runtests ran with expected parameters";
      is shift(), $mock2, "runtests ran with expected parameters";
      is $Test::Harness::switches, '', "switches are undef";
      is $Test::Harness::Switches, '', "switches are undef";
    };
    # $Test::Harness::switches and $Test::Harness::switches are aliases, but we pretend we don't know this
    local $Test::Harness::switches = '';
    local $Test::Harness::switches = '';
    $mb->run_test_harness([$mock1, $mock2]);
    ok 1, "run_test_harness should not produce warning if Test::Harness::[Ss]witches are undef and harness_switches() return empty list";
  }
  # This runs run_test_harness with Test::Harness::switches = '' and harness_switches() returning empty list,
  # ensure there are no warnings, and switches are empty string
  {
    my $mb = MB::Subclass->new( module_name => $dist->name );
    local *Test::Harness::runtests = sub {
      is shift(), $mock1, "runtests ran with expected parameters";
      is shift(), $mock2, "runtests ran with expected parameters";
      is $Test::Harness::switches, '', "switches are empty string";
      is $Test::Harness::Switches, '', "switches are empty string";
    };
    # $Test::Harness::switches and $Test::Harness::switches are aliases, but we pretend we don't know this
    local $Test::Harness::switches = '';
    local $Test::Harness::switches = '';
    $mb->run_test_harness([$mock1, $mock2]);
  }
}