From: Graham Knop Date: Fri, 30 Jan 2015 10:56:00 +0000 (-0500) Subject: split extras testing into separate file and make it more robust X-Git-Tag: v1.005006~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2Fstrictures.git;a=commitdiff_plain;h=8c8a0b9a00083cf79d1ee44930ab0b4a1f8beaa9 split extras testing into separate file and make it more robust Change extras testing script to not rely on extras actually being installed, and use inline evals rather than separate files to make it more obvious what is being checked. --- diff --git a/t/dep_constellations/broken/bareword/filehandles.pm b/t/dep_constellations/broken/bareword/filehandles.pm deleted file mode 100644 index e69de29..0000000 diff --git a/t/dep_constellations/broken/indirect.pm b/t/dep_constellations/broken/indirect.pm deleted file mode 100644 index e69de29..0000000 diff --git a/t/dep_constellations/broken/multidimensional.pm b/t/dep_constellations/broken/multidimensional.pm deleted file mode 100644 index e69de29..0000000 diff --git a/t/extras.t b/t/extras.t new file mode 100644 index 0000000..d314290 --- /dev/null +++ b/t/extras.t @@ -0,0 +1,118 @@ +BEGIN { delete $ENV{PERL_STRICTURES_EXTRA} } +use strict; +use warnings; +use Test::More $] >= 5.008_004 ? qw(no_plan) + : (skip_all => 'Extra tests disabled on perls <= 5.008003'); + +use File::Temp; + +my $tempdir = File::Temp::tempdir(CLEANUP => 1, TMPDIR => 1); +chdir $tempdir; + +my %extras; +BEGIN { + %extras = map { $_ => 1 } qw( + indirect.pm + multidimensional.pm + bareword/filehandles.pm + ); + $INC{$_} = __FILE__ + for keys %extras; +} + +use strictures (); + +my $indirect = 0; +sub indirect::unimport { + $indirect++; +}; + +{ + local $strictures::Smells_Like_VCS = undef; + eval qq{ +#line 1 "t/nogit.t" +use strictures; +1; +} or die "$@"; + ok defined $strictures::Smells_Like_VCS, 'VCS dir has been checked'; + ok !$strictures::Smells_Like_VCS, 'VCS dir not detected with no .git'; +} + +mkdir '.git'; + +{ + local $strictures::Smells_Like_VCS = undef; + eval qq{ +#line 1 "t/withgit.t" +use strictures; +1; +} or die "$@"; + ok defined $strictures::Smells_Like_VCS, 'VCS dir has been checked'; + ok $strictures::Smells_Like_VCS, 'VCS dir detected with .git'; +} + +$strictures::Smells_Like_VCS = 1; + +for my $check ( + ["file.pl" => 0], + ["test.pl" => 0], + ["library.pm" => 0], + ["t/test.t" => 1], + ["xt/test.t" => 1], + ["t/one.faket" => 1], + ["lib/module.pm" => 1], + ["other/one.pl" => 0], + ["other/t/test.t" => 0], + ["blib/module.pm" => 1], +) { + my ($file, $want) = @$check; + $indirect = 0; + eval qq{ +#line 1 "$file" +use strictures; +1; + } or die "$@"; + my $not = $want ? '' : ' not'; + is $indirect, $want, + "file named $file does$not get extras"; +} + +{ + local $ENV{PERL_STRICTURES_EXTRA} = 1; + local $strictures::extra_load_states = undef; + local @INC = (sub { + die "Can't locate $_[1] in \@INC (...).\n" + if $extras{$_[1]}; + }, @INC); + local %INC = %INC; + delete $INC{$_} + for keys %extras; + + { + open my $fh, '>', \(my $str = ''); + local *STDERR = $fh; + eval qq{ +#line 1 "t/load_fail.t" +use strictures; +1; + } or die "$@"; + + strictures->import; + like( + $str, + qr/Missing were:\n\n indirect multidimensional bareword::filehandles/, + "failure to load all three extra deps is reported" + ); + } + + { + open my $fh, '>', \(my $str = ''); + local *STDERR = $fh; + eval qq{ +#line 1 "t/load_fail.t" +use strictures; +1; + } or die "$@"; + is $str, '', "extra dep load failure is not reported a second time"; + } +} diff --git a/t/smells-of-vcs/.exists b/t/smells-of-vcs/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/t/smells-of-vcs/lib/one.pm b/t/smells-of-vcs/lib/one.pm deleted file mode 100644 index 68e9001..0000000 --- a/t/smells-of-vcs/lib/one.pm +++ /dev/null @@ -1,5 +0,0 @@ -package one; - -use strictures 1; - -new Foo 1, 2, 3; diff --git a/t/smells-of-vcs/other/one.pl b/t/smells-of-vcs/other/one.pl deleted file mode 100644 index 362d179..0000000 --- a/t/smells-of-vcs/other/one.pl +++ /dev/null @@ -1,3 +0,0 @@ -use strictures 1; - -new Foo 1, 2, 3; diff --git a/t/smells-of-vcs/t/one.faket b/t/smells-of-vcs/t/one.faket deleted file mode 100644 index 362d179..0000000 --- a/t/smells-of-vcs/t/one.faket +++ /dev/null @@ -1,3 +0,0 @@ -use strictures 1; - -new Foo 1, 2, 3; diff --git a/t/strictures.t b/t/strictures.t index 58104fa..9a107ed 100644 --- a/t/strictures.t +++ b/t/strictures.t @@ -1,10 +1,5 @@ BEGIN { delete $ENV{PERL_STRICTURES_EXTRA} } -# -e is sufficient here. --e 't/smells-of-vcs/.git' - or mkdir('t/smells-of-vcs/.git') - or die "Couldn't create fake .git: $!"; - use Test::More qw(no_plan); our (@us, @expect); @@ -38,54 +33,4 @@ my $v; eval { $v = strictures->VERSION; 1 } or diag $@; is $v, $strictures::VERSION, '->VERSION returns version correctly'; -SKIP: { - skip 'Extra tests disabled on perls <= 5.008003', 1 - if $] < 5.008004; - skip 'Not got all the modules to do this', 1 - unless eval { - require indirect; - require multidimensional; - require bareword::filehandles; - 1; - }; - sub Foo::new { 1 } - chdir("t/smells-of-vcs"); - local $strictures::Smells_Like_VCS = 1; - foreach my $file (qw(lib/one.pm t/one.faket)) { - ok(!eval { require $file; 1 }, "Failed to load ${file}"); - like($@, qr{Indirect call of method}, "Failed due to indirect.pm, ok"); - } - ok(eval { require "other/one.pl"; 1 }, "Loaded other/one.pl ok"); - chdir("../.."); -} - ok(!eval q{use strictures 2; 1; }, "Can't use strictures 2 (this is version 1)"); - -SKIP: { - skip 'Extra tests disabled on perls <= 5.008003', 1 - if $] < 5.008004; - local $ENV{PERL_STRICTURES_EXTRA} = 1; - local $strictures::extra_load_states = undef; - local @INC = ("t/dep_constellations/broken", @INC); - local %INC = %INC; - delete $INC{$_} - for qw( indirect.pm multidimensional.pm bareword/filehandles.pm ); - - { - open my $fh, '>', \my $str; - local *STDERR = $fh; - strictures->import; - like( - $str, - qr/Missing were:\n\n indirect multidimensional bareword::filehandles/, - "failure to load all three extra deps is reported" - ); - } - - { - open my $fh, '>', \my $str; - local *STDERR = $fh; - strictures->import; - ok( !$str, "extra dep load failure is not reported a second time" ); - } -}