view release on metacpan or  search on metacpan

t/unit.t  view on Meta::CPAN

# t/unit.t -- Black-box unit tests, one subtest per documented public API.
#
# Strategy: every test asserts a contract stated in the module's POD, not an
# implementation detail.  Internal helpers (_collect_files, _worst_severity,
# etc.) are tested separately in t/function.t.
#
# Libraries:
#   Test::Most        -- strict mode + Test::More + Test::Exception exports
#   Test::Mockingbird -- mock_scoped / spy / mock_return / mock_exception
#   Test::Returns     -- returns_ok / returns_not_ok (schema validation)

use strict;
use warnings;

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

# ---------------------------------------------------------------------------
# Test constants -- every magic string lives here, not in the subtests.
# ---------------------------------------------------------------------------

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

Readonly::Hash my %ICON_FOR => (
	$SEV_ERROR => '[X]',
	$SEV_WARN  => '[!]',
	$SEV_PASS  => '[v]',
	$SEV_INFO  => '[i]',
);

Readonly::Scalar my $DEFAULT_CHECK_NAME => 'Unknown';
Readonly::Scalar my $DEFAULT_CATEGORY   => 'general';
Readonly::Scalar my $DEFAULT_ORDER      => 50;

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

# Create a temporary distribution directory tree from a flat path=>content map.
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;
}

# Build a minimal Finding, defaulting check_name so callers can omit it.
sub _f {
	require App::Project::Doctor::Finding;
	return App::Project::Doctor::Finding->new(check_name => 'Unit', @_);
}

# Build a minimal Context over an optional tempdir.
sub _ctx {
	require App::Project::Doctor::Context;
	return App::Project::Doctor::Context->new(root => shift // tempdir(CLEANUP => 1));
}

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

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

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

# --- Constructor and accessors ---------------------------------------------

subtest 'Finding::new -- documented defaults when only message supplied' => sub {
	# POD: severity defaults to 'info', check_name to 'Unknown',
	#      detail to '', file to '', line undef.
	my $f = App::Project::Doctor::Finding->new(message => 'minimal');
	is  $f->severity,   $SEV_INFO,           'severity defaults to info';
	is  $f->check_name, $DEFAULT_CHECK_NAME, 'check_name defaults to Unknown';
	is  $f->detail,     '',                  'detail defaults to empty string';
	is  $f->file,       '',                  'file defaults to empty string';
	ok !defined $f->line,                    'line is undef by default';
};

subtest 'Finding::new -- all documented fields round-trip through accessors' => sub {
	my $cref = sub { 1 };
	my $f = App::Project::Doctor::Finding->new(
		severity   => $SEV_ERROR,
		message    => 'broken',
		detail     => 'extended',
		fix        => $cref,
		check_name => 'Tests',
		file       => 'lib/A.pm',
		line       => 7,
	);
	is $f->severity,   $SEV_ERROR,   'severity';
	is $f->message,    'broken',     'message';
	is $f->detail,     'extended',   'detail';
	is $f->check_name, 'Tests',      'check_name';
	is $f->file,       'lib/A.pm',   'file';
	is $f->line,       7,            'line';