view release on metacpan or  search on metacpan

lib/Dist/Zilla/Util/Test/KENTNL/dztest.pm  view on Meta::CPAN

use 5.006;
use strict;
use warnings;

package Dist::Zilla::Util::Test::KENTNL::dztest;

our $VERSION = '1.005014';

# ABSTRACT: Shared dist testing logic for easy dzil things

our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY

use Carp qw( croak );
use Moo qw( has );
use Test::Fatal qw( exception );
use Test::More 0.96 qw( );    # subtest
use Path::Tiny qw(path);
use Dist::Zilla::Util;
use Dist::Zilla::App::Tester qw( test_dzil );
use Module::Runtime qw();

## no critic (ValuesAndExpressions::ProhibitConstantPragma,ErrorHandling::RequireCheckingReturnValueOfEval,Subroutines::ProhibitSubroutinePrototypes)
use recommended 'Test::Differences', 'Test::TempDir::Tiny';
use Data::DPath qw( dpath );
## use critic













sub add_file {
  my ( $self, $path, $content ) = @_;
  my $target = $self->tempdir->child( _file_list($path) );
  $target->parent->mkpath;
  $target->spew_raw($content);
  $self->files->{ $target->relative( $self->tempdir ) } = $target;
  return;
}









sub _subtest_build_ok {
  my ($self) = @_;

  for my $file ( values %{ $self->files } ) {
    next if -e $file and not -d $file;
    return $self->tb->BAIL_OUT("expected file $file failed to add to tempdir");
  }
  $self->note_tempdir_files;

  my $exception;
  $self->tb->is_eq( $exception = $self->safe_configure, undef, 'Can load config' );
  $self->tb->diag($exception) if $exception;

  $self->tb->is_eq( $exception = $self->safe_build, undef, 'Can build' );
  $self->tb->diag($exception) if $exception;

  $self->note_builddir_files;
  return;
}

sub build_ok {
  my ($self) = @_;
  return $self->tb->subtest(
    'Configure and build' => sub {
      $self->tb->plan( tests => 2 );
      return $self->_subtest_build_ok;
    },
  );
}













sub _subtest_prereqs_deeply {
  my ( $self, $prereqs ) = @_;
  my $meta = $self->distmeta;
  $self->tb->ok( defined $meta, 'distmeta defined' );
  $self->tb->note( $self->tb->explain( $meta->{prereqs} ) );

  if ( recommended->has('Test::Differences') ) {
    Test::Differences::eq_or_diff( $meta->{prereqs}, $prereqs, 'Prereqs match expected set' );
  }
  else {
    ## no critic (Subroutines::ProhibitCallsToUnexportedSubs)
    Test::More::is_deeply( $meta->{prereqs}, $prereqs, 'Prereqs match expected set' );
  }
  return;
}

sub prereqs_deeply {
  my ( $self, $prereqs ) = @_;
  return $self->tb->subtest(
    'distmeta prereqs comparison' => sub {
      $self->tb->plan( tests => 2 );
      $self->_subtest_prereqs_deeply($prereqs);
    },
  );
}












sub _test_has_message {
  my ( $self, $log, $regex, $reason ) = @_;
  my $i = 0;
  for my $item ( @{$log} ) {
    if ( $item =~ $regex ) {
      $self->tb->note( qq[item $i: ], $self->tb->explain($item) );
      $self->tb->ok( 1, "log message $i matched $regex$reason" );
      return 1;
    }
    $i++;
  }
  $self->tb->ok( undef, "No log messages matched $regex$reason" );
  return;
}

sub _subtest_has_messages {
  my ( $self, $map ) = @_;
  my $log = $self->builder->log_messages;
  $self->tb->ok( scalar @{$log}, ' has messages' );
  my $need_diag;
  for my $entry ( @{$map} ) {
    my ( $regex, $reason ) = @{$entry};
    $reason = ": $reason" if $reason;
    $reason = q[] unless $reason;
    $need_diag = 1 unless $self->_test_has_message( $log, $regex, $reason );
  }
  if ($need_diag) {
    $self->tb->diag( $self->tb->explain($log) );
    return;
  }
  return 1;
}

sub has_messages {
  my $nargs = ( my ( $self, $label, $map ) = @_ );

  croak 'Invalid number of arguments ( < 2 )' if 1 == $nargs;
  croak 'Invalid number of arguments ( > 3 )' if $nargs > 3;

  if ( 2 == $nargs ) {
    $map   = $label;
    $label = 'log messages check';
  }
  return $self->tb->subtest(
    $label => sub {
      $self->tb->plan( tests => 1 + scalar @{$map} );
      $self->_subtest_has_messages($map);
    },
  );
}
















sub _subtest_meta_path_deeply {
  my ( $self, $expression, $expected ) = @_;
  if ( not 'ARRAY' eq ref $expected ) {
    $self->tb->diag(<<'EOF');
WARNING: Author appears to have forgotten to wrap $expected with [], and this may cause a bug.
EOF
    $expected = [$expected];
  }
  my (@results) = dpath($expression)->match( $self->builder->distmeta );
  $self->tb->ok( @results > 0, "distmeta matched expression $expression" );
  $self->tb->note( $self->tb->explain( \@results ) );
  if ( recommended->has('Test::Differences') ) {
    Test::Differences::eq_or_diff( \@results, $expected, 'distmeta matched expectations' );
  }
  else {
    ## no critic (Subroutines::ProhibitCallsToUnexportedSubs)
    Test::More::is_deeply( \@results, $expected, 'distmeta matched expectations' );
  }
  return;
}

sub meta_path_deeply {
  my ( $self, $expression, $expected, $reason ) = @_;
  if ( not $reason ) {
    $reason = "distmeta at $expression matches expected";
  }
  return $self->tb->subtest(
    $reason => sub {
      $self->tb->plan( tests => 2 );
      return $self->_subtest_meta_path_deeply( $expression, $expected );
    },
  );
}













sub test_has_built_file {
  my ( $self, $path ) = @_;
  if ( not -e $self->_build_root or not -d $self->_build_root ) {
    $self->tb->ok( undef, 'build root does not exist, cant have files' );
    return;
  }
  my $file = $self->_build_root->child( _file_list($path) );
  if ( defined $file and -e $file and not -d $file ) {
    $self->tb->ok( 1, "$file exists" );
    return $file;
  }
  $self->tb->ok( undef, "$file exists" );
  return;
}