view release on metacpan or  search on metacpan

t/logic.t  view on Meta::CPAN

use strict;
use warnings;

# Logic tests: each subtest is a proof of one rule the code relies on.
#
# The simplifications in lib/App/makefilepl2cpanfile.pm are only correct
# if these premises hold, so they are tested first, against every source
# of data, with deliberately hostile input:
#
#   P1  Every stored version is 0, '' (config only), or passes
#       _valid_requirement (a version or a version range).
#   P2  Every stored comment is undef or a non-empty string.
#
# Then each reduced condition is tested with one case per logical
# partition (never two cases from the same partition), and each guard
# clause is shown to stop the call before any later work happens.
#
# The second half exhausts the truth table of every conditional in the
# module, checks De Morgan's laws row by row, walks all 40 combinations
# of generate()'s inputs against its formal specification, asserts the
# invariants before, during and after a call, and shows that inputs
# contradicting a premise are refused by the first guard able to see them.

use Test::Most;
use lib 't/lib';
use Test::Permissions qw(can_revoke_read can_revoke_search);
use Test::Mockingbird;
use Test::Returns;
use File::Temp qw(tempdir);
use Path::Tiny;
use Readonly;
use YAML::Tiny;

use App::makefilepl2cpanfile;

Readonly my $PKG => 'App::makefilepl2cpanfile';

Readonly my %CFG => (
	header   => '# Generated from Makefile.PL using makefilepl2cpanfile',
	cfg_dir  => '.config',
	cfg_file => 'makefilepl2cpanfile.yml',
);

# Version tokens chosen to hit every branch of every validator: valid,
# zero, empty, no digit, trailing junk, non-ASCII digits, code, ranges.
Readonly my @VERSION_CORPUS => (
	'0', '1', '1.60', 'v1.2.3', '1.23_01', '0.0', 'v0', '', '.', '_', 'v',
	'1e3', '1.0-TRIAL', '>= 1.2', "\x{0661}", '1\\', '$x', 'Inf', 'NaN', ' 1',
);

# Comment tails: printable, blank, and made only of stripped characters.
Readonly my @COMMENT_CORPUS => (
	'#', '#   ', "#\t", '# text', "# \x{202E}", "# \r", "# a\x{202E}b", "# \x{1F680}",
);

sub use_home {
	my $data = $_[0];
	my $home = path(tempdir(CLEANUP => 1));
	my $cfg  = $home->child($CFG{cfg_dir}, $CFG{cfg_file});
	if(defined $data) {
		$cfg->parent->mkpath;
		ref $data ? YAML::Tiny->new($data)->write("$cfg") : $cfg->spew_utf8($data);
	}
	return (mock_scoped('File::HomeDir::my_home' => sub { "$home" }), $cfg);
}

sub make_mf {
	my $mf = path(tempdir(CLEANUP => 1))->child('Makefile.PL');
	$mf->spew_utf8($_[0]);
	return "$mf";
}

sub quiet_warnings {
	my $code = $_[0];
	my @w;
	local $SIG{__WARN__} = sub { push @w, $_[0] };
	my $r = $code->();
	return ($r, @w);
}

# Every [phase, rel, module, entry] in a deps structure.
sub all_entries {
	my $deps = $_[0];
	return map {
		my $p = $_;
		map {
			my $r = $_;
			map { [ $p, $r, $_, $deps->{$p}{$r}{$_} ] } keys %{ $deps->{$p}{$r} }
		} keys %{ $deps->{$p} }
	} keys %{$deps};
}

# Captures the structure generate() hands to _emit.
sub capture_emit {
	my $slot = $_[0];
	my $real = \&App::makefilepl2cpanfile::_emit;
	return mock_scoped "${PKG}::_emit" => sub { ${$slot} = $_[0]; $real->(@_) };
}

# -----------------------------------------------------------------------
# P1: every stored version is in the domain _has_version assumes
#
# Premise 1: _has_version only tests for a digit from 1 to 9.
# Premise 2: that is correct only for undef, 0, '' and valid versions.
# So: every source must store nothing else.  Feed every corpus token
# through all three sources and check each stored value.
# -----------------------------------------------------------------------
subtest 'P1: all three sources store only in-domain versions' => sub {