view release on metacpan or  search on metacpan

t/extended_tests.t  view on Meta::CPAN

	restore_all();
	is(  scalar @f, 1,     'single pass finding' );
	like($f[0]->message, qr/2 workflow file/i, 'count is 2 in message' );
};

subtest 'GitHubActions::check -- lint errors suppress pass finding' => sub {
	# Errors present: the "unless (@findings)" guard is false; no pass emitted.
	my $dir = _distro(
		'Makefile.PL'          => '',
		"$WORKFLOW_DIR/a.yml"  => "x:\n",
		"$WORKFLOW_DIR/b.yml"  => "y:\n",
	);
	my @f;
	{
		my $g = mock_scoped 'App::Project::Doctor::Check::GitHubActions::_lint_workflow'
			=> sub { return ({message => 'error', line => 1}) };
		@f = $GHACTIONS->new->check($CONTEXT->new(root => $dir));
	}
	restore_all();
	is(  scalar @f, 2, 'one error per YAML file (two total)' );
	ok( !(grep { $_->severity eq $SEV_PASS } @f), 'no pass finding when errors present' );
};

# ===========================================================================
# Check::Pod -- previously 87% stmt / 50% branch / 40% cond
#
# Strategy: exercise _check_pod with genuinely malformed POD to cover the
# error-extraction loop, and mock slurp to cover the skip-on-read-failure path.
# ===========================================================================

subtest 'Pod::check -- no lib/ modules returns info' => sub {
	my @f = $CHECK_POD->new->check($CONTEXT->new(root => _distro('Makefile.PL' => '')));
	is( scalar @f, 1,          'single finding' );
	is( $f[0]->severity, $SEV_INFO, 'severity is info' );
	like($f[0]->message, qr/No \.pm files/i, 'message says no .pm files' );
};

subtest 'Pod::check -- valid POD returns pass' => sub {
	my $dir = _distro(
		'Makefile.PL' => '',
		'lib/Good.pm' => "package Good;\n1;\n__END__\n=head1 NAME\nGood - good\n=cut\n",
	);
	my @f = $CHECK_POD->new->check($CONTEXT->new(root => $dir));
	is( scalar @f, 1,           'single pass finding' );
	is( $f[0]->severity, $SEV_PASS, 'severity is pass' );
};

subtest 'Pod::check -- no POD produces fixable error; fix rewrites with skeleton' => sub {
	my $dir = _distro(
		'Makefile.PL' => '',
		'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;
	is( scalar @one_lines, 1, 'exactly one "1;" line in fixed file (no duplication)' );
	diag "fixed content tail:\n" . substr($content, -200) if $ENV{TEST_VERBOSE};
};

subtest 'Pod::check -- nested package name resolved in fix skeleton' => sub {
	# Verifies _fix_scaffold_pod correctly converts lib/My/Module.pm -> My::Module
	my $dir = _distro(
		'Makefile.PL'      => '',
		'lib/My/Module.pm' => "package My::Module;\n1;\n",
	);
	my $ctx = $CONTEXT->new(root => $dir);
	my @f   = $CHECK_POD->new->check($ctx);
	my ($fixable) = grep { $_->is_fixable } @f;
	ok( $fixable, 'fixable finding for nested module' );
	my $out;
	open(local *STDOUT, '>', \$out) or die;
	$fixable->fix->($ctx);
	my $content = $ctx->slurp('lib/My/Module.pm');
	like($content, qr/My::Module/, 'fix skeleton uses :: package name' );
};

subtest 'Pod::check -- malformed POD triggers error findings with line numbers' => sub {
	# =over without =back before the next =head1 forces Pod::Checker to emit
	# an error.  This exercises _check_pod when num_errors > 0 (line 85),
	# the error-extraction loop (lines 88-96), and the 'defined $lineno ?'
	# ternary true-branch (line 51 in check()).
	my $broken_pod = join "\n",
		'package Broken;',
		'1;',
		'__END__',
		'',
		'=head1 NAME',
		'',
		'Broken - a module with broken POD',
		'',
		'=over 4',
		'',
		'=item * item one',
		'',
		'=head1 DESCRIPTION',    # =back missing before new =head1
		'',
		'Some text.',
		'',
		'=cut',
		'';
	my $dir = _distro('Makefile.PL' => '', 'lib/Broken.pm' => $broken_pod);
	my @f = $CHECK_POD->new->check($CONTEXT->new(root => $dir));
	my @errs = grep { $_->severity eq $SEV_ERROR } @f;
	ok( scalar @errs >= 1, 'at least one POD error finding' );
	like($errs[0]->message, qr/POD error in lib.Broken\.pm/i, 'message names the file' );