From 912535f4745aa49106a3f25c302443a12e921085 Mon Sep 17 00:00:00 2001 From: Packit Date: Sep 16 2020 16:26:19 +0000 Subject: perl-Test-Needs-0.002005 base --- diff --git a/Changes b/Changes new file mode 100644 index 0000000..a791cf0 --- /dev/null +++ b/Changes @@ -0,0 +1,33 @@ +Revision history for Test::Needs + +0.002005 - 2016-09-27 + - fix skipping when Test::Tester (Test::More < v2) is loaded + +0.002004 - 2016-08-18 + - fix test counts when Test2 not available + +0.002003 - 2016-08-18 + - fix loud warnings when aborting a test under Test2 + - some kwalitee improvements + +0.002002 - 2016-06-03 + - fix tests on non .0 perl versions + +0.002001 - 2016-06-03 + - additional for error messages and perl version handling + - improved documentation + - use supported API for terminating subtests in Test2 + +0.002000 - 2016-05-19 + - drop support for bare versions meaning perl version checks. The perl + version can still be checked using the hashref interface. + - reject invalid module names rather than treating them as missing. + - fix tests when Test2 and old Test::Builder are installed. + - be backwards compatible with Test::More 0.45 + +0.001001 - 2016-05-17 + - fix compatibility with older Test::More and perl + - fix prerequisites to be more accurate + +0.001000 - 2016-05-17 + - initial release diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..34dc7ad --- /dev/null +++ b/MANIFEST @@ -0,0 +1,13 @@ +Changes +lib/Test/Needs.pm +maint/Makefile.PL.include +Makefile.PL +MANIFEST This list of files +t/basic.t +t/find_missing.t +t/lib/BrokenModule.pm +t/lib/ModuleWithVersion.pm +t/lib/TestScript.pm +META.yml Module YAML meta-data (added by MakeMaker) +META.json Module JSON meta-data (added by MakeMaker) +README README file (added by Distar) diff --git a/META.json b/META.json new file mode 100644 index 0000000..be8fdd3 --- /dev/null +++ b/META.json @@ -0,0 +1,66 @@ +{ + "abstract" : "Skip tests when modules not available", + "author" : [ + "haarg - Graham Knop (cpan:HAARG) " + ], + "dynamic_config" : 0, + "generated_by" : "ExtUtils::MakeMaker version 7.1001, CPAN::Meta::Converter version 2.150005", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : "2" + }, + "name" : "Test-Needs", + "no_index" : { + "directory" : [ + "t", + "xt" + ] + }, + "prereqs" : { + "build" : {}, + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, + "develop" : { + "requires" : {} + }, + "runtime" : { + "requires" : { + "perl" : "5.006" + } + }, + "test" : { + "requires" : { + "Test::More" : "0.45" + } + } + }, + "release_status" : "stable", + "resources" : { + "bugtracker" : { + "mailto" : "bug-Test-Needs@rt.cpan.org", + "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Test-Needs" + }, + "license" : [ + "http://dev.perl.org/licenses/" + ], + "repository" : { + "type" : "git", + "url" : "https://github.com/haarg/Test-Needs.git", + "web" : "https://github.com/haarg/Test-Needs" + }, + "x_IRC" : "irc://irc.perl.org/#perl-qa" + }, + "version" : "0.002005", + "x_cpants" : { + "ignore" : { + "prereq_matches_use" : "required modules detected incorrectly" + } + }, + "x_serialization_backend" : "JSON::PP version 2.27300" +} diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..c80c1f3 --- /dev/null +++ b/META.yml @@ -0,0 +1,31 @@ +--- +abstract: 'Skip tests when modules not available' +author: + - 'haarg - Graham Knop (cpan:HAARG) ' +build_requires: + Test::More: '0.45' +configure_requires: + ExtUtils::MakeMaker: '0' +dynamic_config: 0 +generated_by: 'ExtUtils::MakeMaker version 7.1001, CPAN::Meta::Converter version 2.150005' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Test-Needs +no_index: + directory: + - t + - xt +requires: + perl: '5.006' +resources: + IRC: irc://irc.perl.org/#perl-qa + bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Test-Needs + license: http://dev.perl.org/licenses/ + repository: https://github.com/haarg/Test-Needs.git +version: '0.002005' +x_cpants: + ignore: + prereq_matches_use: 'required modules detected incorrectly' +x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..98eeccd --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,92 @@ +use strict; +use warnings FATAL => 'all'; +use 5.006; + +my %META = ( + name => 'Test-Needs', + license => 'perl_5', + prereqs => { + configure => { requires => { + 'ExtUtils::MakeMaker' => 0, + } }, + test => { + requires => { + 'Test::More' => 0.45, + }, + }, + runtime => { + requires => { + 'perl' => 5.006, + }, + }, + develop => { + requires => { + }, + }, + }, + resources => { + repository => { + url => 'https://github.com/haarg/Test-Needs.git', + web => 'https://github.com/haarg/Test-Needs', + type => 'git', + }, + x_IRC => 'irc://irc.perl.org/#perl-qa', + bugtracker => { + web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Test-Needs', + mailto => 'bug-Test-Needs@rt.cpan.org', + }, + license => [ 'http://dev.perl.org/licenses/' ], + }, + no_index => { + directory => [ 't', 'xt' ] + }, + dynamic_config => 0, + x_cpants => { ignore => { + prereq_matches_use => 'required modules detected incorrectly', + } }, +); + +my %MM_ARGS = (); + +## BOILERPLATE ############################################################### +require ExtUtils::MakeMaker; +(do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; + +# have to do this since old EUMM dev releases miss the eval $VERSION line +my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; +my $mymeta = $eumm_version >= 6.57_02; +my $mymeta_broken = $mymeta && $eumm_version < 6.57_07; + +($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g; +($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g; +$META{license} = [ $META{license} ] + if $META{license} && !ref $META{license}; +$MM_ARGS{LICENSE} = $META{license}[0] + if $META{license} && $eumm_version >= 6.30; +$MM_ARGS{NO_MYMETA} = 1 + if $mymeta_broken; +$MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META } + unless -f 'META.yml'; + +for (qw(configure build test runtime)) { + my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; + my $r = $MM_ARGS{$key} = { + %{$META{prereqs}{$_}{requires} || {}}, + %{delete $MM_ARGS{$key} || {}}, + }; + defined $r->{$_} or delete $r->{$_} for keys %$r; +} + +$MM_ARGS{MIN_PERL_VERSION} = delete $MM_ARGS{PREREQ_PM}{perl} || 0; + +delete $MM_ARGS{MIN_PERL_VERSION} + if $eumm_version < 6.47_01; +$MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}} + if $eumm_version < 6.63_03; +$MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}} + if $eumm_version < 6.55_01; +delete $MM_ARGS{CONFIGURE_REQUIRES} + if $eumm_version < 6.51_03; + +ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS); +## END BOILERPLATE ########################################################### diff --git a/README b/README new file mode 100644 index 0000000..b3c9c72 --- /dev/null +++ b/README @@ -0,0 +1,83 @@ +NAME + Test::Needs - Skip tests when modules not available + +SYNOPSIS + # need one module + use Test::Needs 'Some::Module'; + + # need multiple modules + use Test::Needs 'Some::Module', 'Some::Other::Module'; + + # need a given version of a module + use Test::Needs { + 'Some::Module' => '1.005', + }; + + # check later + use Test::Needs; + test_needs 'Some::Module'; + + # skips remainder of subtest + use Test::More; + use Test::Needs; + subtest 'my subtest' => sub { + test_needs 'Some::Module'; + ... + }; + + # check perl version + use Test::Needs { perl => 5.020 }; + +DESCRIPTION + Skip test scripts if modules are not available. The requested modules + will be loaded, and optionally have their versions checked. If the + module is missing, the test script will be skipped. Modules that are + found but fail to compile will exit with an error rather than skip. + + If used in a subtest, the remainder of the subtest will be skipped. + + Skipping will work even if some tests have already been run, or if a + plan has been declared. + + Versions are checked via a "$module->VERSION($wanted_version)" call. + Versions must be provided in a format that will be accepted. No extra + processing is done on them. + + If "perl" is used as a module, the version is checked against the + running perl version ($]). The version can be specified as a number, + dotted-decimal string, v-string, or version object. + + If the "RELEASE_TESTING" environment variable is set, the tests will + fail rather than skip. Subtests will be aborted, but the test script + will continue running after that point. + +EXPORTS + test_needs + Has the same interface as when using Test::Needs in a "use". + +SEE ALSO + Test::Requires + A similar module, with some important differences. Test::Requires + will act as a "use" statement (despite its name), calling the import + sub. Under "RELEASE_TESTING", it will BAIL_OUT if a module fails to + load rather than using a normal test fail. It also doesn't + distinguish between missing modules and broken modules. + + Test2::Require::Module + Part of the Test2 ecosystem. Only supports running as a "use" + command to skip an entire plan. + +AUTHOR + haarg - Graham Knop (cpan:HAARG) + +CONTRIBUTORS + None so far. + +COPYRIGHT + Copyright (c) 2016 the Test::Needs "AUTHOR" and "CONTRIBUTORS" as listed + above. + +LICENSE + This library is free software and may be distributed under the same + terms as perl itself. See . + diff --git a/lib/Test/Needs.pm b/lib/Test/Needs.pm new file mode 100644 index 0000000..f3db264 --- /dev/null +++ b/lib/Test/Needs.pm @@ -0,0 +1,315 @@ +package Test::Needs; +use strict; +use warnings; +no warnings 'once'; +our $VERSION = '0.002005'; +$VERSION =~ tr/_//d; + +BEGIN { + *_WORK_AROUND_HINT_LEAKAGE + = "$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001) + ? sub(){1} : sub(){0}; + *_WORK_AROUND_BROKEN_MODULE_STATE + = "$]" < 5.009 + ? sub(){1} : sub(){0}; +} + +sub _try_require { + local %^H + if _WORK_AROUND_HINT_LEAKAGE; + my ($module) = @_; + (my $file = "$module.pm") =~ s{::|'}{/}g; + my $err; + { + local $@; + eval { require $file } + or $err = $@; + } + if (defined $err) { + delete $INC{$file} + if _WORK_AROUND_BROKEN_MODULE_STATE; + die $err + unless $err =~ /\ACan't locate \Q$file\E/; + return !1; + } + !0; +} + +sub _find_missing { + my @bad = map { + my ($module, $version) = @$_; + if ($module eq 'perl') { + $version + = !$version ? 0 + : $version =~ /^[0-9]+\.[0-9]+$/ ? sprintf('%.6f', $version) + : $version =~ /^v?([0-9]+(?:\.[0-9]+)+)$/ ? do { + my @p = split /\./, $1; + push @p, 0 + until @p >= 3; + sprintf '%d.%03d%03d', @p; + } + : $version =~ /^\x05..?$/s ? do { + my @p = map ord, split //, $version; + push @p, 0 + until @p >= 3; + sprintf '%d.%03d%03d', @p; + } + : do { + use warnings FATAL => 'numeric'; + no warnings 'void'; + eval { 0 + $version; 1 } ? $version + : die sprintf qq{version "%s" for perl does not look like a number at %s line %s.\n}, + $version, (caller( 1 + ($Test::Builder::Level||0) ))[1,2]; + }; + if ("$]" < $version) { + sprintf "perl %s (have %.6f)", $version, $]; + } + else { + (); + } + } + elsif ($module =~ /^\d|[^\w:]|:::|[^:]:[^:]|^:|:$/) { + die sprintf qq{"%s" does not look like a module name at %s line %s.\n}, + $module, (caller( 1 + ($Test::Builder::Level||0) ))[1,2]; + die + } + elsif (_try_require($module)) { + local $@; + if (defined $version && !eval { $module->VERSION($version); 1 }) { + "$module $version (have ".$module->VERSION.')'; + } + else { + (); + } + } + else { + $version ? "$module $version" : $module; + } + } + map { + if (ref eq 'HASH') { + my $arg = $_; + map [ $_ => $arg->{$_} ], sort keys %$arg; + } + elsif (ref eq 'ARRAY') { + my $arg = $_; + map [ @{$arg}[$_*2,$_*2+1] ], 0 .. int($#$arg / 2); + } + else { + [ $_ => undef ]; + } + } @_; + @bad ? "Need " . join(', ', @bad) : undef; +} + +sub import { + my $class = shift; + my $target = caller; + if (@_) { + local $Test::Builder::Level = ($Test::Builder::Level||0) + 1; + test_needs(@_); + } + no strict 'refs'; + *{"${target}::test_needs"} = \&test_needs; +} + +sub test_needs { + my $missing = _find_missing(@_); + local $Test::Builder::Level = ($Test::Builder::Level||0) + 1; + _fail_or_skip($missing, $ENV{RELEASE_TESTING}) + if $missing; +} + +sub _skip { _fail_or_skip($_[0], 0) } +sub _fail { _fail_or_skip($_[0], 1) } + +sub _fail_or_skip { + my ($message, $fail) = @_; + if ($INC{'Test2/API.pm'}) { + my $ctx = Test2::API::context(); + my $hub = $ctx->hub; + if ($fail) { + $ctx->ok(0, "Test::Needs modules available", [$message]); + } + else { + my $plan = $hub->plan; + my $tests = $hub->count; + if ($plan || $tests) { + my $skips + = $plan && $plan ne 'NO PLAN' ? $plan - $tests : 1; + $ctx->skip("Test::Needs modules not available") for 1 .. $skips; + $ctx->note($message); + } + else { + $ctx->plan(0, 'SKIP', $message); + } + } + $ctx->done_testing; + $ctx->release if $Test2::API::VERSION < 1.302053; + $ctx->send_event('+'._t2_terminate_event()); + } + elsif ($INC{'Test/Builder.pm'}) { + my $tb = Test::Builder->new; + my $has_plan = Test::Builder->can('has_plan') ? 'has_plan' + : sub { $_[0]->expected_tests || eval { $_[0]->current_test($_[0]->current_test); 'no_plan' } }; + if ($fail) { + $tb->plan(tests => 1) + unless $tb->$has_plan; + $tb->ok(0, "Test::Needs modules available"); + $tb->diag($message); + } + else { + my $plan = $tb->$has_plan; + my $tests = $tb->current_test; + if ($plan || $tests) { + my $skips + = $plan && $plan ne 'no_plan' ? $plan - $tests : 1; + $tb->skip("Test::Needs modules not available") + for 1 .. $skips; + Test::Builer->can('note') ? $tb->note($message) : print "# $message\n"; + } + else { + $tb->skip_all($message); + } + } + $tb->done_testing + if Test::Builder->can('done_testing'); + die bless {} => 'Test::Builder::Exception' + if Test::Builder->can('parent') && $tb->parent; + } + else { + if ($fail) { + print "1..1\n"; + print "not ok 1 - Test::Needs modules available\n"; + print STDERR "# $message\n"; + exit 1; + } + else { + print "1..0 # SKIP $message\n"; + } + } + exit 0; +} + +my $terminate_event; +sub _t2_terminate_event () { + local $@; + $terminate_event ||= eval q{ + $INC{'Test/Needs/Event/Terminate.pm'} = $INC{'Test/Needs.pm'}; + package # hide + Test::Needs::Event::Terminate; + use Test2::Event (); + our @ISA = qw(Test2::Event); + sub no_display { 1 } + sub terminate { 0 } + __PACKAGE__; + } or die "$@"; +} + +1; +__END__ + +=pod + +=encoding utf-8 + +=head1 NAME + +Test::Needs - Skip tests when modules not available + +=head1 SYNOPSIS + + # need one module + use Test::Needs 'Some::Module'; + + # need multiple modules + use Test::Needs 'Some::Module', 'Some::Other::Module'; + + # need a given version of a module + use Test::Needs { + 'Some::Module' => '1.005', + }; + + # check later + use Test::Needs; + test_needs 'Some::Module'; + + # skips remainder of subtest + use Test::More; + use Test::Needs; + subtest 'my subtest' => sub { + test_needs 'Some::Module'; + ... + }; + + # check perl version + use Test::Needs { perl => 5.020 }; + +=head1 DESCRIPTION + +Skip test scripts if modules are not available. The requested modules will be +loaded, and optionally have their versions checked. If the module is missing, +the test script will be skipped. Modules that are found but fail to compile +will exit with an error rather than skip. + +If used in a subtest, the remainder of the subtest will be skipped. + +Skipping will work even if some tests have already been run, or if a plan has +been declared. + +Versions are checked via a C<< $module->VERSION($wanted_version) >> call. +Versions must be provided in a format that will be accepted. No extra +processing is done on them. + +If C is used as a module, the version is checked against the running perl +version (L<$]|perlvar/$]>). The version can be specified as a number, +dotted-decimal string, v-string, or version object. + +If the C environment variable is set, the tests will fail +rather than skip. Subtests will be aborted, but the test script will continue +running after that point. + +=head1 EXPORTS + +=head2 test_needs + +Has the same interface as when using Test::Needs in a C. + +=head1 SEE ALSO + +=over 4 + +=item L + +A similar module, with some important differences. L will act +as a C statement (despite its name), calling the import sub. Under +C, it will BAIL_OUT if a module fails to load rather than +using a normal test fail. It also doesn't distinguish between missing modules +and broken modules. + +=item L + +Part of the L ecosystem. Only supports running as a C command to +skip an entire plan. + +=back + +=head1 AUTHOR + +haarg - Graham Knop (cpan:HAARG) + +=head1 CONTRIBUTORS + +None so far. + +=head1 COPYRIGHT + +Copyright (c) 2016 the Test::Needs L and L +as listed above. + +=head1 LICENSE + +This library is free software and may be distributed under the same terms +as perl itself. See L. + +=cut diff --git a/maint/Makefile.PL.include b/maint/Makefile.PL.include new file mode 100644 index 0000000..777e91d --- /dev/null +++ b/maint/Makefile.PL.include @@ -0,0 +1,9 @@ +BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } +use lib 'Distar/lib'; +use Distar 0.001; + +use ExtUtils::MakeMaker 6.57_10 (); + +author 'haarg - Graham Knop (cpan:HAARG) '; + +1; diff --git a/t/basic.t b/t/basic.t new file mode 100644 index 0000000..2cadc1e --- /dev/null +++ b/t/basic.t @@ -0,0 +1,204 @@ +use strict; +use warnings; +use Test::More tests => 9*3 + 16*2; +use IPC::Open3; + +delete $ENV{RELEASE_TESTING}; + +my @perl = ($^X, map "-I$_", @INC, 't/lib'); + +my $missing = "Module::Does::Not::Exist::".time; + +sub capture { + my $pid = open3 my $stdin, my $stdout, undef, @_ + or die "can't run @_: $!"; + my $out = do { local $/; <$stdout> }; + close $stdout; + waitpid $pid, 0; + my $exit = $?; + return wantarray ? ($exit, $out) : $exit; +} + +for my $api ( + ['standalone'], + ['Test2' => 'Test2::API'], + ['Test::Builder' => 'Test::Builder'] +) { + SKIP: { + my ($label, @load) = @$api; + my @using = map { + my ($e, $o) = capture @perl, "-m$_", "-eprint+$_->VERSION"; + skip "$label not available", 9+16 + if $e; + "$_ $o"; + } @load; + printf "# Checking against ".join(', ', @using)."\n" + if @using; + my $check = sub { + my ($args, $match, $name) = @_; + my @args = ((map "--load=$_", @load), @$args); + my ($exit, $out) + = capture @perl, '-MTestScript' . (@args ? '='.join(',', @args) : ''); + $name = "$label: $name"; + my $want_exit; + my $unmatch; + if (ref $match eq 'HASH') { + $want_exit = $match->{exit}; + $unmatch = $match->{unmatch}; + $match = $match->{match}; + } + $match = !defined $match ? [] : ref $match eq 'ARRAY' ? $match : [$match]; + $unmatch = !defined $unmatch ? [] : ref $unmatch eq 'ARRAY' ? $unmatch : [$unmatch]; + if ($exit && !$want_exit) { + ok 0, $name + for 0 .. ($#$match + $#$unmatch)||1; + diag "Exit status $exit\nOutput:\n$out"; + } + else { + for my $m (@$match) { + like $out, $m, $name; + } + for my $um (@$unmatch) { + unlike $out, $um, $name; + } + } + }; + + $check->( + [$missing], + qr/^1\.\.0 # SKIP/i, + 'Missing module SKIPs', + ); + $check->( + ['BrokenModule'], + { match => qr/syntax error/, exit => 1 }, + 'Broken module dies', + ); + $check->( + ['ModuleWithVersion'], + qr/^(?!1\.\.0 # SKIP)/i, + 'Working module runs', + ); + $check->( + ['ModuleWithVersion', 2], + qr/^1\.\.0 # SKIP/i, + 'Outdated module SKIPs', + ); + + { + local $ENV{RELEASE_TESTING} = 1; + $check->( + [$missing], + { match => qr/^not ok/m, exit => 1 }, + 'Missing module fails with RELEASE_TESTING', + ); + $check->( + ['BrokenModule'], + { match => qr/syntax error/, exit => 1 }, + 'Broken module dies with RELEASE_TESTING', + ); + $check->( + ['ModuleWithVersion'], + qr/^(?!1\.\.0 # SKIP)/i, + 'Working module runs with RELEASE_TESTING', + ); + $check->( + ['ModuleWithVersion', 2], + { match => qr/^not ok/m, unmatch => qr/Cleaning up the CONTEXT stack/, exit => 1 }, + 'Outdated module fails with RELEASE_TESTING', + ); + } + + next + unless @load; + + $check->( + [$missing, '--plan'], + qr/# skip/, + 'Missing module skips with plan', + ); + $check->( + [$missing, '--no_plan'], + qr/# skip/, + 'Missing module skips with no_plan', + ); + SKIP: { + skip 'Test::More too old to run tests without plan', 1 + if !Test::More->can('done_testing'); + $check->( + [$missing, '--tests'], + qr/# skip/, + 'Missing module skips with tests', + ); + } + $check->( + [$missing, '--plan', '--tests'], + qr/# skip/, + 'Missing module passes with plan and tests', + ); + $check->( + [$missing, '--no_plan', '--tests'], + qr/# skip/, + 'Missing module passes with no_plan and tests', + ); + + SKIP: { + skip 'Test::More too old to run subtests', 11 + if !Test::More->can('subtest'); + + $check->( + [$missing, '--subtest'], + qr/^ +1\.\.0 # SKIP/mi, + 'Missing module skips in subtest', + ); + $check->( + ['BrokenModule', '--subtest'], + { match => qr/syntax error/, exit => 1 }, + 'Broken module dies in subtest', + ); + $check->( + ['ModuleWithVersion', '--subtest'], + [ qr/^ +1\.\.(?!0 # SKIP)/mi, qr/^ok[^\n#]+(?!# skip)/m ], + 'Working module runs in subtest', + ); + $check->( + ['ModuleWithVersion', 2, '--subtest'], + qr/^ +1\.\.0 # SKIP/mi, + 'Outdated module skips in subtest', + ); + + $check->( + [$missing, '--subtest', '--plan'], + qr/# skip/, + 'Missing module skips with plan in subtest', + ); + $check->( + [$missing, '--subtest', '--no_plan'], + qr/# skip/, + 'Missing module skips with no_plan in subtest', + ); + $check->( + [$missing, '--subtest', '--tests'], + qr/# skip/, + 'Missing module skips with tests in subtest', + ); + $check->( + [$missing, '--subtest', '--plan', '--tests'], + qr/# skip/, + 'Missing module passes with plan and tests in subtest', + ); + $check->( + [$missing, '--subtest', '--no_plan', '--tests'], + qr/# skip/, + 'Missing module passes with no_plan and tests in subtest', + ); + + local $ENV{RELEASE_TESTING} = 1; + $check->( + [$missing, '--subtest'], + { match => qr/^ +not ok/m, exit => 1 }, + 'Missing module fails in subtest with RELEASE_TESTING', + ); + } + } +} diff --git a/t/find_missing.t b/t/find_missing.t new file mode 100644 index 0000000..1ff1b41 --- /dev/null +++ b/t/find_missing.t @@ -0,0 +1,68 @@ +use strict; +use warnings; +use Test::More tests => 3*5 + 9; +use Test::Needs (); +use lib 't/lib'; + +*_find_missing = \&Test::Needs::_find_missing; + +my $have_vpm = eval { require version }; + +for my $v ($] - 0.001, $], $] + 0.001) { + my $fail = $v > $]; + my @parts = sprintf('%.6f', $v) =~ /^(\d+)\.(\d{3})(\d{3})/; + my $str_v = join '.', map $_+0, @parts; + for my $c ( + $v, + qq["$str_v"], + qq["v$str_v"], + qq[v$str_v], + qq[version->parse("$str_v")] + ) { + SKIP: { + skip "version.pm not available", 1 + if !$have_vpm && $c =~ /version->/; + my $check = eval $c or die $@; + my $message = _find_missing({ perl => $check }); + if ($fail) { + is $message, sprintf("Need perl %.6f (have %.6f)", $v, $]), + "perl prereq of $c failed"; + } + else { + is $message, undef, + "perl prereq of $c passed"; + } + } + } +} + +my $missing = "Module::Does::Not::Exist::".time; + +is _find_missing('ModuleWithVersion'), undef, + 'existing module accepted'; + +is _find_missing({ 'ModuleWithVersion' => 1 }), undef, + 'existing module with version accepted'; + +is _find_missing($missing), "Need $missing", + 'missing module rejected'; + +is _find_missing({ $missing => 1 }), "Need $missing 1", + 'missing module with version rejected'; + +is _find_missing({ 'ModuleWithVersion' => 2 }), "Need ModuleWithVersion 2 (have 1)", + 'existing module with old version rejected'; + +is _find_missing([ $missing ]), "Need $missing", + 'missing module rejected (arrayref)'; + +is _find_missing([ $missing => 1 ]), "Need $missing 1", + 'missing module with version rejected (arrayref)'; + +eval { _find_missing('BrokenModule') }; +like $@, qr/Compilation failed/, + 'broken module dies'; + +eval { _find_missing('BrokenModule') }; +like $@, qr/Compilation failed/, + 'broken module dies again'; diff --git a/t/lib/BrokenModule.pm b/t/lib/BrokenModule.pm new file mode 100644 index 0000000..3d34ee3 --- /dev/null +++ b/t/lib/BrokenModule.pm @@ -0,0 +1 @@ +]; diff --git a/t/lib/ModuleWithVersion.pm b/t/lib/ModuleWithVersion.pm new file mode 100644 index 0000000..a4dd8a2 --- /dev/null +++ b/t/lib/ModuleWithVersion.pm @@ -0,0 +1,5 @@ +package ModuleWithVersion; + +our $VERSION = 1; + +1; diff --git a/t/lib/TestScript.pm b/t/lib/TestScript.pm new file mode 100644 index 0000000..1a7d126 --- /dev/null +++ b/t/lib/TestScript.pm @@ -0,0 +1,91 @@ +package TestScript; +use strict; +use warnings; +use Test::Needs; + +sub plan; +sub subtest; +sub done_testing; +sub ok; + +for my $sub (qw(plan ok subtest done_testing)) { + no strict 'refs'; + no warnings 'redefine'; + *$sub = sub { + if (!$INC{'Test2/API.pm'}) { + require Test::Builder; + my $tb = Test::Builder->new; + for my $install (qw(plan ok subtest done_testing)) { + *{$install} = sub { + $tb->$install(@_); + }; + } + } + else { + *plan = sub { + my $ctx = Test2::API::context(); + $ctx->plan( + $_[0] eq 'no_plan' ? (0, 'NO PLAN') + : $_[0] eq 'tests' ? ($_[1]) + : @_ + ); + $ctx->release; + }; + *subtest = \&Test2::API::run_subtest; + *ok = sub { + my $ctx = Test2::API::context(); + $ctx->ok(@_); + $ctx->release; + }; + *done_testing = sub { + my $ctx = Test2::API::context(); + $ctx->done_testing; + $ctx->release; + }; + } + goto &$sub; + }; +} + +sub import { + my $class = shift; + my $opts = { map { /^--([^=]*)(?:=(.*))?/ ? ($1 => $2||1) : () } @_ }; + my @args = grep !/^--/, @_; + @args = @args == 1 ? @args : { @args }; + if ($opts->{load}) { + eval qq{ package main; use $opts->{load}; 1; } or die $@; + } + + if ($opts->{subtest}) { + plan tests => 1; + subtest subtest => sub { do_test($opts, @args) }; + } + else { + do_test($opts, @args); + } + exit 0; +} + + +sub do_test { + my ($opts, @args) = @_; + if ($opts->{plan}) { + plan tests => 2; + } + elsif ($opts->{no_plan}) { + plan 'no_plan'; + } + if ($opts->{tests}) { + ok 1; + } + test_needs @args; + plan tests => 2 + unless $opts->{tests} || $opts->{plan} || $opts->{no_plan}; + ok 1; + ok 1 + unless $opts->{tests}; + done_testing + if $opts->{tests} && !($opts->{plan} || $opts->{no_plan}); +} + +1;