1use Sub::Install;
2use Test::More tests => 17;
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  my $sub_ref = Sub::Install::install_sub({ code => \&ok, as => 'ok1' });
11
12  isa_ok($sub_ref, 'CODE', 'return value of first install_sub');
13
14  is_deeply($sub_ref, \&ok, 'it returns the correct code ref');
15
16  ok1(1, 'installed sub runs');
17}
18
19{
20  my $to_avail = eval "use Test::Output; 1";
21  SKIP: {
22    skip "can't run this test without Test::Output", 1 unless $to_avail;
23    Sub::Install::install_sub({ code => \&ok, as => 'tmp_ok' });
24    
25    my $expected_warning = <<'END_WARNING';
26Subroutine main::tmp_ok redefined at t/install.t line 31
27Prototype mismatch: sub main::tmp_ok ($;$) vs ($$;$) at t/install.t line 31
28END_WARNING
29
30    my $stderr = Test::Output::stderr_from(
31      sub { Sub::Install::install_sub({ code => \&is, as => 'tmp_ok' }) }
32    );
33
34    $stderr =~ s!\\!/!g;
35    is(
36      $stderr,
37      $expected_warning,
38      "got expected warning",
39    );
40  }
41}
42
43{ # Install the same sub in the same package...
44  my $redef = 0;
45  my $proto = 0;
46
47  local $SIG{__WARN__} = sub {
48    return ($redef = 1) if $_[0] =~ m{Subroutine \S+ redef.+t.install\.t};
49    return ($proto = 1) if $_[0] =~ m{Prototype mismatch.+t.install\.t};
50    # pass("warned as expected: $_[0]") if $_[0] =~ /redefined/;
51    die "unexpected warning: @_";
52  };
53
54  my $sub_ref = Sub::Install::install_sub({ code => \&is, as => 'ok1' });
55
56  ok($redef, 'correct redefinition warning went to $SIG{__WARN__}');
57  ok($proto, 'correct prototype warning went to $SIG{__WARN__}');
58
59  isa_ok($sub_ref, 'CODE', 'return value of second install_sub');
60
61  is_deeply($sub_ref, \&is, 'install2 returns correct code ref');
62
63  ok1(1,1, 'installed sub runs (with new arguments)');
64}
65
66{ # Install in another package...
67  my $sub_ref = Sub::Install::install_sub({
68    code => \&ok,
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, \&ok, 'it returns the correct code ref');
76
77  ok1(1,1, 'sub previously installed into main still runs properly');
78
79  package Other;
80  ok1(1,   'remotely installed sub runs properly');
81}
82
83{ # cross-package installation
84  sub Other::Another::foo { return $_[0] }
85
86  my $sub_ref = Sub::Install::install_sub({
87    code => 'foo',
88    from => 'Other::Another',
89    into => 'Other::YetAnother',
90    as   => 'return_lhs'
91  });
92
93  isa_ok($sub_ref, 'CODE', 'return value of fourth install_sub');
94
95  is_deeply(
96    $sub_ref,
97    \&Other::Another::foo,
98    'it returns the correct code ref'
99  );
100
101  is(
102    Other::Another->foo,
103    'Other::Another',
104    'the original code does what we want',
105  );
106
107  is(
108    Other::YetAnother->return_lhs,
109    'Other::YetAnother',
110    'and the installed code works, too',
111  );
112}
113