view release on metacpan or  search on metacpan

lib/Devel/Cover/Test.pm  view on Meta::CPAN

# Copyright 2002-2026, Paul Johnson (paul@pjcj.net)

# This software is free.  It is licensed under the same terms as Perl itself.

# The latest version of this software should be available from my homepage:
# https://pjcj.net

package Devel::Cover::Test;

use strict;
use warnings;

our $VERSION = '1.52'; # VERSION

use Carp;

use File::Spec;
use Test::More;

use Devel::Cover::Inc;

my $LATEST_RELEASED_PERL = 42;

sub new {
  my $class = shift;
  my $test  = shift;
  croak "No test specified" unless $test;
  my %params = @_;

  my $criteria
    = delete $params{criteria} || "statement branch condition subroutine";

  eval "use Test::Differences";
  my $differences = $INC{"Test/Differences.pm"};

  my $self = bless {
    test             => $test,
    criteria         => [$criteria],
    skip             => "",
    uncoverable_file => [],
    select           => "",
    ignore           => [],
    changes          => [],
    test_parameters  => [],
    debug            => $ENV{DEVEL_COVER_DEBUG} || 0,
    differences      => $differences,
    no_coverage      => $ENV{DEVEL_COVER_NO_COVERAGE} || 0,
    delay_after_run  => 0,
    %params,
  }, $class;

  $self->get_params
}

sub set_test {
  my $self = shift;
  my ($test) = @_;
  $self->{test} = $test;
}

sub shell_quote {
  my ($item) = @_;
  $^O eq "MSWin32" ? (/ / and $_ = qq("$_")) : s/ /\\ /g for $item;
  $item
}

sub get_params {
  my $self = shift;

  my $test = $self->test_file;
  if (open my $fh, "<", $test) {
    while (<$fh>) {
      push @{ $self->{$1} }, $2 if /__COVER__\s+(\w+)\s+(.*)/;
    }
    close $fh or die "Cannot close $test: $!";
  }

  $self->{criteria} = $self->{criteria}[-1];
  $self->{select} ||= "-select /tests/$self->{test}\\b";
  $self->{test_parameters}
    = "$self->{select}"
    . " -ignore blib Devel/Cover @{$self->{ignore}}"
    . " -merge 0 -coverage $self->{criteria} "
    . "@{$self->{test_parameters}}";
  $self->{criteria} =~ s/-\w+//g;
  $self->{db_name} ||= $self->{test};
  $self->{cover_db} = "./t/e2e/cover_db_$self->{db_name}/";
  unless (mkdir $self->{cover_db}) {
    die "Can't mkdir $self->{cover_db}: $!" unless -d $self->{cover_db};
  }
  my $p = $self->{cover_parameters} || [];
  $self->{cover_parameters}
    = join(" ", map "-coverage $_", split " ", $self->{criteria})
    . " @$p -report text "