App-Project-Doctor

 view release on metacpan or  search on metacpan

lib/App/Project/Doctor/Check/CpanReadiness.pm  view on Meta::CPAN

				message  => 'Changes file has no version entries.',
				file     => 'Changes',
			);
		}
	}

	# MANIFEST stale-check requires 'make manifest' -- too invasive; just advise.
	if ($ctx->has_file('MANIFEST')) {
		push @findings, _f(
			severity => 'info',
			message  => "MANIFEST present -- run 'make manifest' to verify it is not stale.",
		);
	}

	# Emit a pass only when there are no errors or warnings.
	my $has_problem = grep { $_->severity =~ /^(?:error|warning)$/ } @findings;
	unless ($has_problem) {
		push @findings, _f(
			severity => 'pass',
			message  => 'Distribution meets basic CPAN readiness requirements.',
		);

t/edge_cases.t  view on Meta::CPAN

	my $dir = tempdir(CLEANUP => 1);
	my $ctx = $Context->new(root => $dir);
	my $result;
	lives_ok { $result = $ctx->perl_files('lib', 't', 'nonexistent') }
		'missing dirs do not cause perl_files to die';
	returns_ok( $result, { type => 'arrayref' }, 'still returns arrayref' );
	is( scalar @{$result}, 0, 'empty arrayref for missing dirs' );
};

subtest 'Context::perl_files -- does not clobber outer $_' => sub {
	# File::Find localises $_ internally; we verify the outer value survives.
	my $ctx = _ctx(_distro('lib/A.pm' => '1;'));
	local $_ = 'sentinel_value';
	$ctx->perl_files;
	is( $_, 'sentinel_value', '$_ unchanged by perl_files' );
};

subtest 'Context::find_files -- undef dir argument croaks' => sub {
	throws_ok { _ctx()->find_files(undef) }
		qr/requires a directory/,
		'find_files(undef) croaks';

t/extended_tests.t  view on Meta::CPAN

		'lib/Bare.pm' => "package Bare;\n1;\n",
	);
	my $ctx = $CONTEXT->new(root => $dir);
	my @f   = $CHECK_POD->new->check($ctx);

	my @errs = grep { $_->severity eq $SEV_ERROR } @f;
	is(  scalar @errs, 1, 'one error for missing POD' );
	like($errs[0]->message, qr/No POD found/i, 'message says No POD found' );
	ok(  $errs[0]->is_fixable, 'finding carries fix coderef' );

	# Apply the fix and verify POD skeleton was written (not just appended).
	my $out;
	open(local *STDOUT, '>', \$out) or die;
	$errs[0]->fix->($ctx);
	my $content = $ctx->slurp('lib/Bare.pm');
	like($content, qr/=head1 NAME/, 'fix wrote =head1 NAME' );
	like($content, qr/Bare/,        'fix included the package name' );

	# Regression: _fix_scaffold_pod previously used '>>' (append) which produced
	# a duplicate `1;` line.  Verify the file has exactly one `1;` at the top level.
	my @one_lines = $content =~ /^1;$/mg;

t/function.t  view on Meta::CPAN

};

subtest 'Check::Base -- optional method defaults' => sub {
	my $b = App::Project::Doctor::Check::Base->new;
	is $b->can_fix,  0,         'can_fix defaults to 0 (not just false)';
	is $b->category, 'general', 'category defaults to "general"';
	is $b->order,    50,        'order defaults to 50';
};

subtest 'Check::Base -- subclass inherits and overrides' => sub {
	# Create an inline subclass to verify inheritance mechanics.
	{
		package My::ConcreteCheck;
		use parent -norequire, 'App::Project::Doctor::Check::Base';
		sub name        { 'Concrete' }
		sub description { 'A test check.' }
		sub check       { () }
		sub can_fix     { 1 }
		sub order       { 99 }
	}

t/function.t  view on Meta::CPAN

subtest 'Check::Meta::check -- error when META parse fails' => sub {
	mock_exception 'CPAN::Meta::load_file' => 'bad yaml';
	my $dir = make_distro('META.yml' => 'invalid: [yaml');
	my @f   = App::Project::Doctor::Check::Meta->new->check(_make_ctx($dir));
	my $parse_err = grep { $_->severity eq $ERR_SEV && $_->message =~ /Failed to parse/i } @f;
	ok $parse_err, 'error emitted on parse failure';
	restore_all 'CPAN::Meta';
};

subtest 'Check::Meta::check -- error per missing required field' => sub {
	# license is intentionally absent to verify that field is required.
	my $struct = {
		name     => 'MyDist',
		version  => '0.01',
		author   => ['Test Author'],
		abstract => 'Something',
	};
	my $g = mock_scoped('CPAN::Meta',
		load_file => sub { return bless {}, 'CPAN::Meta' },
		as_struct  => sub { return $struct },
	);

t/integration.t  view on Meta::CPAN

		open(local *STDIN,  '<', \$input) or die "Cannot redirect STDIN: $!";
		$count = $fixer->run;
	}
	diag "Fixer output:\n$out" if $ENV{TEST_VERBOSE} && $out;
	return $count;
}

# ─────────────────────────────────────────────────────────────────────────────
# 1. FINDING -> REPORT ACCUMULATION
# Strategy: Exercise the full Finding+Report pipeline by creating all four
# severity types and verifying that each filter method is independently correct.
# A passing report and a failing report are tested to ensure exit_code and the
# has_* predicates agree.
# ─────────────────────────────────────────────────────────────────────────────

subtest 'finding-report accumulation across all severity types' => sub {
	my $fix_called = 0;
	my $report     = $Report->new;

	$report->add_findings(
		_f(severity => 'error',   message => 'E1',    check_name => 'A'),

t/integration.t  view on Meta::CPAN

	my $doctor = $Doctor->new(path => $dir, checks => ['Security']);
	my $report = $doctor->run;

	my @non_security = grep { $_->check_name ne 'Security' } $report->all_findings;
	is( scalar @non_security, 0, 'no findings from other check classes when checks => [Security]' );
	ok( scalar($report->all_findings) > 0, 'at least one Security finding present' );
};

# ─────────────────────────────────────────────────────────────────────────────
# 10. SECURITY CHECK INTEGRATION
# Strategy: Run Check::Security directly on crafted distros to verify the
# strict/warnings detection produces a fixable error finding that correctly
# identifies the source file. A clean file must yield only a pass finding.
# ─────────────────────────────────────────────────────────────────────────────

subtest 'security check detects missing "use strict" and produces fixable error' => sub {
	require App::Project::Doctor::Check::Security;

	my $dir = _make_distro(
		'lib/Broken.pm' => "package Broken;\nuse warnings;\n1;\n",
	);

t/integration.t  view on Meta::CPAN

	is( $findings[0]->severity, 'warning', 'finding is a warning, not an exception' );
	ok( scalar @carped,                    'carp was called to report the failure' );

	diag 'warning: ' . $findings[0]->message if $ENV{TEST_VERBOSE};
	diag 'carped: '  . $carped[0]            if $ENV{TEST_VERBOSE} && @carped;
};

# ─────────────────────────────────────────────────────────────────────────────
# 12. CONCURRENT OBJECT NON-INTERFERENCE
# Strategy: Create two independent instances of the same class within the same
# test block and verify they accumulate state in isolation -- no shared %INC
# side effects, no shared internal _findings arrays between Report instances,
# and no cross-contamination between Doctor runs on different distros.
# ─────────────────────────────────────────────────────────────────────────────

subtest 'two concurrent Report instances accumulate state independently' => sub {
	my $report_a = $Report->new;
	my $report_b = $Report->new;

	$report_a->add_findings(_f(severity => 'error',   message => 'Err A',  check_name => 'A'));
	$report_b->add_findings(_f(severity => 'warning', message => 'Warn B', check_name => 'B'));