view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

# t/function.t -- White-box function tests for every .pm in lib/
#
# Tests are organized one subtest-block per module, in dependency order
# (value objects first, orchestrators last).
#
# Mocking: Test::Mockingbird -- mock/mock_scoped/mock_return/mock_exception/
# mock_once/mock_sequence/spy/restore_all.
# Return validation: Test::Returns -- returns_ok / returns_not_ok.

use strict;
use warnings;

use Test::Most;
use Test::Mockingbird;
use Test::Returns;
use Test::Memory::Cycle;
use File::Temp  qw(tempdir);
use File::Spec;
use File::Path  qw(make_path);
use Scalar::Util qw(blessed);
use Readonly;

Readonly::Scalar my $EMPTY    => '';
Readonly::Scalar my $NL       => "\n";
Readonly::Scalar my $PASS_SEV => 'pass';
Readonly::Scalar my $ERR_SEV  => 'error';
Readonly::Scalar my $WARN_SEV => 'warning';
Readonly::Scalar my $INFO_SEV => 'info';

# ---------------------------------------------------------------------------
# Shared helpers
# ---------------------------------------------------------------------------

# Build a temporary directory tree from a flat hash of rel-path => content.
sub make_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);
		(my $parent = $abs) =~ s{[/\\][^/\\]+$}{};
		make_path($parent) unless -d $parent;
		open my $fh, '>', $abs or die "Cannot write $abs: $!";
		print {$fh} $files{$rel};
		close $fh;
	}
	return $dir;
}

# Construct a minimal Finding for use in other module tests.
sub _make_finding {
	require App::Project::Doctor::Finding;
	return App::Project::Doctor::Finding->new(@_);
}

# Construct a minimal Context for a given tempdir root.
sub _make_ctx {
	my $root = shift;
	require App::Project::Doctor::Context;
	return App::Project::Doctor::Context->new(root => $root);
}

# Construct a Report with an optional list of pre-loaded findings.
sub _make_report {
	require App::Project::Doctor::Report;
	my $r = App::Project::Doctor::Report->new;
	$r->add_findings(@_) if @_;
	return $r;
}

diag "Perl $]" if $ENV{TEST_VERBOSE};

# ===========================================================================
# 1. App::Project::Doctor::Finding
# ===========================================================================

require_ok 'App::Project::Doctor::Finding';

subtest 'Finding::new -- defaults' => sub {
	# When only message is supplied the other fields should carry documented
	# defaults so callers can safely omit them.
	my $f = App::Project::Doctor::Finding->new(message => 'ok');
	is  $f->severity,   $INFO_SEV,  'default severity is info';
	is  $f->detail,     $EMPTY,     'default detail is empty string';
	is  $f->check_name, 'Unknown',  'default check_name is Unknown';
	is  $f->file,       $EMPTY,     'default file is empty string';
	ok !defined $f->line,           'line undef by default';
};

subtest 'Finding::new -- all attributes round-trip' => sub {
	my $fix_called = 0;
	my $f = App::Project::Doctor::Finding->new(
		severity   => $ERR_SEV,
		message    => 'Something broke',
		detail     => 'Extra info',
		fix        => sub { $fix_called++ },
		check_name => 'Tests',
		file       => 'lib/Foo.pm',
		line       => 42,