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