view release on metacpan or  search on metacpan

t/modules.pm  view on Meta::CPAN

sub random_sublist {
  my @modules = @_;
  my %sublist;
  return 1 if scalar(@modules) < 2;
  while (keys %sublist < 10) {
    my $m = $modules[int(rand(scalar @modules))];
    next unless $modules{$m}; # Don't random test uninstalled modules
    $sublist{$m} = 1;
  }
  return keys %sublist;
}

# for t/testm.sh -s
sub skip_modules {
  my @modules = get_module_list;
  my @skip = ();
  for my $m (@modules) {
    push @skip, ($m) unless $modules{$m};
  }
  @skip;
}

# preparing automatic module tests

package CPAN::Shell;
#{   # add testcc to the dispatching methods
#    no strict "refs";
#    my $command = 'testcc';
#    *$command = sub { shift->rematein($command, @_); };
#}
sub testcc { shift->rematein('testcc', @_); }
package CPAN::Module;
sub testcc   {
    my $self = shift;
    my $inst_file = $self->inst_file or return;
    # only if its a not-deprecated CPAN module. perl core not
    if ($self->can('_in_priv_or_arch')) { # 1.9301 not, 1.94 yes
      return if $self->_in_priv_or_arch($inst_file);
    }
    if ($] >= 5.011){
      if ($self->can('deprecated_in_core')) {
        return if $self->deprecated_in_core;
      } else {
        # CPAN-1.9402 has no such method anymore
        # trying to support deprecated.pm by Nicholas 2009-02
        if (my $distribution = $self->distribution) {
          return if $distribution->isa_perl;
        }
      }
    }
    $self->rematein('testcc', @_);
}
package CPAN::Distribution;
sub testcc   {
    my $self = shift;
    # $CPAN::DEBUG++;
    my $cwd = Cwd::getcwd();
    # posix shell only, but we are using a posix shell here. XXX -Wb=-uTest::Builder
    my $X = $^X =~ m/\s/ ? qq{"$^X"} : $^X;
    # we cannot use that in PERL_CORE, only as module
    $self->prefs->{test}->{commandline} =
      "for t in t/*.t; do "
	. "echo \"# \$t\"; $X -Iblib/arch -Iblib/lib -I\"$cwd/blib/arch\" -I\"$cwd/blib/lib\" \"$cwd/blib/script/perlcc\" -T -r \$t;"
     ."done";
    $self->prefs->{test_report} = ''; # XXX ignored!
    $self->{make_test} = 'NO'; # override YAML check "Has already been tested successfully"
    $self->test(@_);
    # done
}

1;