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 (file)
--- 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</-list_missing>.
 
+=head2 skip_without
+
+=over
+
+=item Arguments: $group_name | \@group_names
+
+=back
+
+A convenience wrapper around L<skip|Test::More/SKIP>. It does not take neither
+a reason (it is generated by L</req_missing_for>) nor an amount of skipped tests
+(it is always C<1>, thus mandating unconditional use of
+L<done_testing|Test::More/done_testing>). Most useful in combination with ad hoc
+requirement specifications:
+EOC
+
+  push @chunks, <<EOC;
+  SKIP: {
+    $class->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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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');