[Bioperl-guts-l] bioperl-live/t/lib BioperlTest.pm,1.3,1.4

[Senduran Balasubramaniam]

Update of /home/repository/bioperl/bioperl-live/t/lib
In directory dev.open-bio.org:/tmp/cvs-serv32142/t/lib

Modified Files:
	BioperlTest.pm 
Log Message:
added protection again arg typos, new option excludes_os

Index: BioperlTest.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/t/lib/BioperlTest.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** BioperlTest.pm	21 Jun 2007 08:25:37 -0000	1.3
--- BioperlTest.pm	21 Jun 2007 14:11:12 -0000	1.4
***************
*** 145,148 ****
--- 145,151 ----
                                          skipped if network tests haven't been
                                          enabled in Build.PL)
+            -excludes_os         => str (default none, if OS suppied, all tests
+                                         will skip if running on that OS (eg.
+                                         'mswin'))
             -framework           => str (default 'Test::More', the Test module
                                          to load. NB: experimental, avoid using)
***************
*** 193,196 ****
--- 196,202 ----
                                          required; if any don't load, the desired
                                          number of tests will be skipped)
+            -excludes_os         => str (default none, if OS suppied, desired num
+                                         of tests will skip if running on that OS
+                                         (eg. 'mswin'))
             -requires_networking => 1   (if true the desired number of tests will
                                          be skipped if network tests haven't been
***************
*** 248,256 ****
--- 254,280 ----
      my %args = @_;
      my $tests = $args{'-tests'} || die "-tests must be supplied and positive\n";
+     delete $args{'-tests'};
      my @req_mods = @{$args{'-requires_modules'} || []};
+     delete $args{'-requires_modules'};
      my $req_net = $args{'-requires_networking'};
+     delete $args{'-requires_networking'};
+     my $os = $args{'-excludes_os'};
+     delete $args{'-excludes_os'};
      my $framework = $args{'-framework'} || $GLOBAL_FRAMEWORK;
+     delete $args{'-framework'};
+     
+     # catch user mistakes
+     while (my ($key, $val) = each %args) {
+         die "unknown argument '$key' supplied, did you mistake 'required...' for 'requires...'?\n";
+     }
      
      my $skip = '';
+     
+     if ($os) {
+         if ($^O =~ /$os/i) {
+             $skip = 'Not compatible with your Operating System';
+         }
+     }
+     
      my $requires = '';
      foreach my $mod (@req_mods) {
***************
*** 258,265 ****
      }
      eval $requires;
!     if ($@) {
          $skip = (@req_mods == 1 ? 'The optional module ' : 'One or more of the optional modules ').join(', ', @req_mods).' not installed';
      }
!     elsif ($req_net && ! test_network()) {
          $skip = 'Network tests have not been requested';
      }
--- 282,290 ----
      }
      eval $requires;
!     if (!$skip && $@) {
          $skip = (@req_mods == 1 ? 'The optional module ' : 'One or more of the optional modules ').join(', ', @req_mods).' not installed';
      }
!     
!     if (!$skip && $req_net && ! test_network()) {
          $skip = 'Network tests have not been requested';
      }