From: Peter Rabbitson Date: Tue, 10 Feb 2015 12:45:32 +0000 (+0100) Subject: Introduce ad hoc requirements and add skip_without method to optdeps X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=461e818a9c52126c695bbe1501a4113fb7bc9af5;p=dbsrgits%2FDBIx-Class-Historic.git Introduce ad hoc requirements and add skip_without method to optdeps On rare occasions tests need a specific module version, but nothing else in the dist needs this. Additionally only parts of a test may rely on this extra requirement, making the "all or nothing" approach of -skip_all_without not very attractive. Hence introducing ability to supply arbitrary module specifications in lieu of group names. Each specification is checked against a special group 'test_adhoc' which ensures that optional deps are not "forgotten" within the suite (causing a test to never run in practice). --- diff --git a/lib/DBIx/Class/Optional/Dependencies.pm b/lib/DBIx/Class/Optional/Dependencies.pm index e07c732..0ceeb19 100644 --- a/lib/DBIx/Class/Optional/Dependencies.pm +++ b/lib/DBIx/Class/Optional/Dependencies.pm @@ -65,6 +65,16 @@ my $dbic_reqs = { } }, + # must list any dep used by adhoc testing + # this prevents the "skips due to forgotten deps" issue + test_adhoc => { + req => { + 'Date::Simple' => '3.03', + 'YAML' => '0', + 'Class::Unload' => '0.07', + }, + }, + replicated => { req => $moose_basic, pod => { @@ -136,12 +146,6 @@ my $dbic_reqs = { }, }, - test_component_accessor => { - req => { - 'Class::Unload' => '0.07', - }, - }, - test_pod => { req => { 'Test::Pod' => '1.42', @@ -204,7 +208,6 @@ my $dbic_reqs = { req => { 'Class::DBI::Plugin::DeepAbstractSearch' => '0', 'Time::Piece::MySQL' => '0', - 'Date::Simple' => '3.03', }, }, @@ -792,6 +795,23 @@ sub modreq_missing_for { ; } +my $tb; +sub skip_without { + my ($self, $groups) = @_; + + $tb ||= do { local $@; eval { Test::Builder->new } } + or croak "Calling skip_without() before loading Test::Builder makes no sense"; + + if ( my $err = $self->req_missing_for($groups) ) { + my ($fn, $ln) = (caller(0))[1,2]; + $tb->skip("block in $fn around line $ln requires $err"); + local $^W = 0; + last SKIP; + } + + 1; +} + sub die_unless_req_ok_for { if (my $err = shift->req_missing_for(shift) ) { die "Unable to continue due to missing requirements: $err\n"; @@ -823,6 +843,10 @@ sub __envvar_group_desc { join '/', @res; } +my $groupname_re = qr/ [A-Z_a-z][0-9A-Z_a-z]* /x; +my $modname_re = qr/ [A-Z_a-z] [0-9A-Z_a-z]* (?:::[0-9A-Z_a-z]+)* /x; +my $modver_re = qr/ [0-9]+ (?: \. [0-9]+ )? /x; + # Expand includes from a random group in a specific order: # nonvariable groups first, then their includes, then the variable groups, # then their includes. @@ -844,7 +868,7 @@ sub __expand_includes { for my $g (@$groups) { croak "Invalid requirement group name '$g': only ascii alphanumerics and _ are allowed" - if $g !~ /\A [A-Z_a-z][0-9A-Z_a-z]* \z/x; + if $g !~ qr/ \A $groupname_re \z/x; my $r = $dbic_reqs->{$g} or croak "Requirement group '$g' is not defined"; @@ -924,19 +948,42 @@ our %req_unavailability_cache; # this method is just a lister and envvar/metadata checker - it does not try to load anything sub _groups_to_reqs { - my ($self, $groups) = @_; + my ($self, $want) = @_; - $groups = [ $groups || () ] - unless ref $groups eq 'ARRAY'; + $want = [ $want || () ] + unless ref $want eq 'ARRAY'; croak "@{[ (caller(1))[3] ]}() expects a requirement group name or arrayref of group names" - unless @$groups; + unless @$want; my $ret = { modreqs => {}, modreqs_fully_documented => 1, }; + my $groups; + for my $piece (@$want) { + if ($piece =~ qr/ \A $groupname_re \z /x) { + push @$groups, $piece; + } + elsif ( my ($mod, $ver) = $piece =~ qr/ \A ($modname_re) \>\= ($modver_re) \z /x ) { + croak "Ad hoc module specification lists '$mod' twice" + if exists $ret->{modreqs}{$mod}; + + croak "Ad hoc module specification '${mod} >= $ver' (or greater) not listed in the test_adhoc optdep group" if ( + ! defined $dbic_reqs->{test_adhoc}{req}{$mod} + or + $dbic_reqs->{test_adhoc}{req}{$mod} < $ver + ); + + $ret->{modreqs}{$mod} = $ver; + $ret->{modreqs_fully_documented} = 0; + } + else { + croak "Unsupported argument '$piece' supplied to @{[ (caller(1))[3] ]}()" + } + } + my $all_groups = __expand_includes($groups); # pre-assemble list of augmentations, perform basic sanity checks @@ -984,13 +1031,13 @@ sub _groups_to_reqs { for my $req_bag ($group_reqs, @{ $augmentations->{$group} || [] } ) { for (keys %$req_bag) { - $_ =~ /\A [A-Z_a-z][0-9A-Z_a-z]* (?:::[0-9A-Z_a-z]+)* \z /x + $_ =~ / \A $modname_re \z /x or croak "Requirement '$_' in group '$group' is not a valid module name"; # !!!DO NOT CHANGE!!! # remember - version.pm may not be available on the system croak "Requirement '$_' in group '$group' specifies an invalid version '$req_bag->{$_}' (only plain non-underscored floating point decimals are supported)" - if ( ($req_bag->{$_}||0) !~ / \A [0-9]+ (?: \. [0-9]+ )? \z /x ); + if ( ($req_bag->{$_}||0) !~ qr/ \A $modver_re \z /x ); } } @@ -1431,6 +1478,31 @@ EOC See also L. +=head2 skip_without + +=over + +=item Arguments: $group_name | \@group_names + +=back + +A convenience wrapper around L. It does not take neither +a reason (it is generated by L) nor an amount of skipped tests +(it is always C<1>, thus mandating unconditional use of +L). Most useful in combination with ad hoc +requirement specifications: +EOC + + push @chunks, <skip_without([ deploy YAML>=0.90 ]); + + ... + } +EOC + + push @chunks, <<'EOC'; + =head2 die_unless_req_ok_for =over diff --git a/t/99dbic_sqlt_parser.t b/t/99dbic_sqlt_parser.t index 85bf5ab..a1be722 100644 --- a/t/99dbic_sqlt_parser.t +++ b/t/99dbic_sqlt_parser.t @@ -48,8 +48,7 @@ lives_ok { isa_ok (create_schema ({ schema => 'DBICTest::Schema' }), 'SQL::Trans # make sure a connected instance passed via $args does not get the $dbh improperly serialized SKIP: { - # YAML is a build_requires dep of SQLT - it may or may not be here - eval { require YAML } or skip "Test requires YAML.pm", 1; + DBIx::Class::Optional::Dependencies->skip_without( 'YAML>=0' ); lives_ok { diff --git a/t/cdbi/04-lazy.t b/t/cdbi/04-lazy.t index d89d1b4..51d6ad5 100644 --- a/t/cdbi/04-lazy.t +++ b/t/cdbi/04-lazy.t @@ -109,7 +109,7 @@ warning_like { # Now again for inflated values SKIP: { - skip "Requires Date::Simple 3.03", 5 unless eval "use Date::Simple 3.03; 1; "; + DBIx::Class::Optional::Dependencies->skip_without( 'Date::Simple>=3.03' ); Lazy->has_a( orp => 'Date::Simple', inflate => sub { Date::Simple->new($_[0] . '-01-01') }, diff --git a/t/cdbi/columns_as_hashes.t b/t/cdbi/columns_as_hashes.t index f10f522..cddb264 100644 --- a/t/cdbi/columns_as_hashes.t +++ b/t/cdbi/columns_as_hashes.t @@ -86,11 +86,8 @@ warning_is { # Emulate that Class::DBI inflates immediately SKIP: { - unless (eval { require MyFoo }) { - my ($err) = $@ =~ /([^\n]+)/; - skip $err, 3 - } - + DBIx::Class::Optional::Dependencies->skip_without([qw( Date::Simple>=3.03 test_rdbms_mysql )]); + require MyFoo; my $foo = MyFoo->insert({ name => 'Whatever', tdate => '1949-02-01', diff --git a/t/cdbi/testlib/MyFoo.pm b/t/cdbi/testlib/MyFoo.pm index 11a4feb..7df9c6f 100644 --- a/t/cdbi/testlib/MyFoo.pm +++ b/t/cdbi/testlib/MyFoo.pm @@ -6,8 +6,6 @@ use strict; use base 'MyBase'; -use Date::Simple 3.03; - __PACKAGE__->set_table(); __PACKAGE__->columns(All => qw/myid name val tdate/); __PACKAGE__->has_a( diff --git a/t/storage/cursor.t b/t/storage/cursor.t index e6c0ba7..ce0be84 100644 --- a/t/storage/cursor.t +++ b/t/storage/cursor.t @@ -13,9 +13,9 @@ lives_ok { is($schema->resultset("Artist")->search(), 3, "Three artists returned"); } 'Custom cursor autoloaded'; +# test component_class reentrancy SKIP: { - eval { require Class::Unload } - or skip 'component_class reentrancy test requires Class::Unload', 1; + DBIx::Class::Optional::Dependencies->skip_without( 'Class::Unload>=0.07' ); Class::Unload->unload('DBICTest::Cursor');