1use strict; 2use warnings; 3 4use Test2::IPC; 5use Test2::Tools::Tiny; 6use Test2::API::Breakage; 7my $CLASS = 'Test2::API::Breakage'; 8 9for my $meth (qw/upgrade_suggested upgrade_required known_broken/) { 10 my @list = $CLASS->$meth; 11 ok(!(@list % 2), "Got even list ($meth)"); 12 ok(!(grep {!defined($_)} @list), "No undefined items ($meth)"); 13} 14 15{ 16 no warnings 'redefine'; 17 local *Test2::API::Breakage::upgrade_suggested = sub { 18 return ('T2Test::UG1' => '1.0', 'T2Test::UG2' => '0.5'); 19 }; 20 21 local *Test2::API::Breakage::upgrade_required = sub { 22 return ('T2Test::UR1' => '1.0', 'T2Test::UR2' => '0.5'); 23 }; 24 25 local *Test2::API::Breakage::known_broken = sub { 26 return ('T2Test::KB1' => '1.0', 'T2Test::KB2' => '0.5'); 27 }; 28 use warnings 'redefine'; 29 30 ok(!$CLASS->report, "Nothing to report"); 31 ok(!$CLASS->report(1), "Still nothing to report"); 32 33 { 34 local %INC = ( 35 %INC, 36 'T2Test/UG1.pm' => 'T2Test/UG1.pm', 37 'T2Test/UG2.pm' => 'T2Test/UG2.pm', 38 'T2Test/UR1.pm' => 'T2Test/UR1.pm', 39 'T2Test/UR2.pm' => 'T2Test/UR2.pm', 40 'T2Test/KB1.pm' => 'T2Test/KB1.pm', 41 'T2Test/KB2.pm' => 'T2Test/KB2.pm', 42 ); 43 local $T2Test::UG1::VERSION = '0.9'; 44 local $T2Test::UG2::VERSION = '0.9'; 45 local $T2Test::UR1::VERSION = '0.9'; 46 local $T2Test::UR2::VERSION = '0.9'; 47 local $T2Test::KB1::VERSION = '0.9'; 48 local $T2Test::KB2::VERSION = '0.9'; 49 50 my @report = $CLASS->report; 51 52 $_ =~ s{\S+/Breakage\.pm}{Breakage.pm}g for @report; 53 54 is_deeply( 55 [sort @report], 56 [ 57 sort 58 " * Module 'T2Test::UR1' is outdated and known to be broken, please update to 1.0 or higher.", 59 " * Module 'T2Test::KB1' is known to be broken in version 1.0 and below, newer versions have not been tested. You have: 0.9", 60 " * Module 'T2Test::KB2' is known to be broken in version 0.5 and below, newer versions have not been tested. You have: 0.9", 61 " * Module 'T2Test::UG1' is outdated, we recommed updating above 1.0. error was: 'T2Test::UG1 version 1.0 required--this is only version 0.9 at Breakage.pm line 75.'; INC is T2Test/UG1.pm", 62 ], 63 "Got expected report items" 64 ); 65 } 66 67 my %look; 68 unshift @INC => sub { 69 my ($this, $file) = @_; 70 $look{$file}++ if $file =~ m{T2Test}; 71 return; 72 }; 73 ok(!$CLASS->report, "Nothing to report"); 74 is_deeply(\%look, {}, "Did not try to load anything"); 75 76 ok(!$CLASS->report(1), "Nothing to report"); 77 is_deeply( 78 \%look, 79 { 80 'T2Test/UG1.pm' => 1, 81 'T2Test/UG2.pm' => 1, 82 'T2Test/UR1.pm' => 1, 83 'T2Test/UR2.pm' => 1, 84 'T2Test/KB1.pm' => 1, 85 'T2Test/KB2.pm' => 1, 86 }, 87 "Tried to load modules" 88 ); 89} 90 91done_testing; 92