view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

#
# Hostile, pathological, boundary-condition, and security tests.
# Strategy: actively try to break or subvert each module.
#
use strict;
use warnings;

use Test::Most;
use Test::Returns;
use Test::Mockingbird qw(mock_scoped restore_all);
use Readonly;
use File::Temp    qw(tempdir);
use File::Spec;
use File::Path    qw(make_path);
use File::Basename qw(dirname);
use Scalar::Util  qw(blessed);

our $INJECT_SENTINEL;

# ---------------------------------------------------------------------------
# Constants
# ---------------------------------------------------------------------------

Readonly::Scalar my $EMPTY      => '';
Readonly::Scalar my $WHITESPACE => "   \t\n  ";
Readonly::Scalar my $HUGE       => 'A' x 1_000_000;
Readonly::Scalar my $VALID_MSG  => 'A valid finding message';

Readonly::Scalar my $Finding => 'App::Project::Doctor::Finding';
Readonly::Scalar my $Context => 'App::Project::Doctor::Context';
Readonly::Scalar my $Report  => 'App::Project::Doctor::Report';
Readonly::Scalar my $Fixer   => 'App::Project::Doctor::Fixer';
Readonly::Scalar my $Doctor  => 'App::Project::Doctor';

Readonly::Scalar my $SEV_ERROR   => 'error';
Readonly::Scalar my $SEV_WARNING => 'warning';
Readonly::Scalar my $SEV_PASS    => 'pass';
Readonly::Scalar my $SEV_INFO    => 'info';

# ---------------------------------------------------------------------------
# Module bootstrap
# ---------------------------------------------------------------------------

use_ok $Finding;
use_ok $Context;
use_ok $Report;
use_ok $Fixer;
use_ok $Doctor;
require App::Project::Doctor::Check::Security;
require App::Project::Doctor::Check::Dependencies;

# ---------------------------------------------------------------------------
# Helpers
# ---------------------------------------------------------------------------

# Build a minimal temp distro from a { relative/path => content } hash.
sub _distro {
	my (%files) = @_;
	my $dir = tempdir(CLEANUP => 1);
	for my $rel (sort keys %files) {
		my @parts = split m{/}, $rel;
		my $abs   = File::Spec->catfile($dir, @parts);
		make_path(dirname($abs)) unless -d dirname($abs);
		open my $fh, '>', $abs or die "Cannot write $abs: $!";
		print $fh $files{$rel};
		close $fh;
	}
	return $dir;
}

# Return a Context rooted at a fresh temp dir (or supplied dir).
sub _ctx {
	my $dir = shift // tempdir(CLEANUP => 1);
	return $Context->new(root => $dir);
}

# Minimal valid Finding with optional overrides.
sub _f {
	my (%args) = @_;
	return $Finding->new(
		message    => $VALID_MSG,
		check_name => 'EdgeTest',
		severity   => $SEV_ERROR,
		%args,
	);
}

# Empty Report with N added findings.
sub _report_with {
	my (@f) = @_;
	my $r = $Report->new;
	$r->add_findings(@f) if @f;
	return $r;
}

# Run the Fixer in interactive mode, feeding $input as STDIN.
# Captures STDOUT into $$out_ref and $SIG{__WARN__} into @$warn_ref.
sub _run_fixer_interactive {
	my ($report, $input, $out_ref, $warn_ref) = @_;
	my $ctx   = _ctx();
	my $fixer = $Fixer->new(report => $report, context => $ctx);
	my $count;
	{
		open(local *STDOUT, '>', $out_ref) or die;
		open(local *STDIN,  '<', \$input) or die;
		local $SIG{__WARN__} = sub { push @{$warn_ref}, $_[0] };
		$count = $fixer->run;
	}
	return $count;
}

# ===========================================================================
# Finding -- hostile constructor inputs
# ===========================================================================

subtest 'Finding::new -- undef message croaks immediately (pre-PVS guard)' => sub {
	# The early guard fires before Params::Validate::Strict sees the args;
	# the documented error message must be exact.
	throws_ok { $Finding->new(message => undef, check_name => 'T') }
		qr/message must be a non-empty string/,
		'undef message produces documented croak';