1use Sub::Install qw(reinstall_sub);
2use Test::More tests => 15;
3
4use strict;
5use warnings;
6
7# These tests largely copied from Damian Conway's Sub::Installer tests.
8
9{ # Install a sub in a package...
10
11  my $sub_ref = reinstall_sub({ code => \&ok, as => 'ok1' });
12
13  isa_ok($sub_ref, 'CODE', 'return value of first install_sub');
14
15  is_deeply($sub_ref, \&Test::More::ok, 'it returned the right coderef');
16
17  $sub_ref->(1, 'returned code ref runs');
18  ok1(1, "reinstalled sub runs");
19}
20
21{
22  my $to_avail = eval "use Test::Output; 1";
23  SKIP: {
24    skip "can't run this test without Test::Output", 1 unless $to_avail;
25    Sub::Install::reinstall_sub({ code => \&ok, as => 'tmp_ok' });
26    
27    my $expected_warning = <<'END_WARNING';
28Prototype mismatch: sub main::tmp_ok ($;$) vs ($$;$) at t/reinstall.t line 32
29END_WARNING
30
31    my $stderr = Test::Output::stderr_from(
32      sub { Sub::Install::reinstall_sub({ code => \&is, as => 'tmp_ok' }) }
33    );
34
35    $stderr =~ s!\\!/!g;
36    is(
37      $stderr,
38      $expected_warning,
39      "got expected warning",
40    );
41  }
42}
43
44{ # Install the same sub in the same package...
45  my $proto = 0;
46
47  local $SIG{__WARN__} = sub {
48    return ($proto = 1) if $_[0] =~ m{Prototype mismatch.+t.reinstall\.t};
49    die "unexpected warning: @_";
50  };
51
52  my $sub_ref = reinstall_sub({ code => \&is, as => 'ok1' });
53
54  ok($proto, 'correct warning went to $SIG{__WARN__}');
55
56  isa_ok($sub_ref, 'CODE', 'return value of second install_sub');
57
58  is_deeply($sub_ref, \&Test::More::is, 'it returned the right coderef');
59
60  $sub_ref->(1, 1, 'returned code ref runs');
61  ok1(1,1, 'reinstalled sub reruns');
62}
63
64{ # Install in another package...
65  my $new_code = sub { ok(1, "remotely installed sub runs") };
66
67  my $sub_ref = reinstall_sub({
68    code => $new_code,
69    into => 'Other',
70    as   => 'ok1',
71  });
72
73  isa_ok($sub_ref, 'CODE', 'return value of third install_sub');
74
75  is_deeply($sub_ref, $new_code, 'it returned the right coderef');
76
77  ok1(1,1, 'reinstalled sub reruns');
78
79  package Other;
80  ok1();
81}
82
83eval {
84  my $arg = { code => sub {}, into => 'Other', as => 'ok1' };
85  Sub::Install::_build_public_installer(\&Sub::Install::_install_fatal)->($arg);
86};
87
88like($@, qr/redefine/, "(experimental fatal installer should croak)");
89