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