view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

		qr/requires a relative path/,
		'has_file(undef) croaks with documented error';
};

subtest 'Context::abs_path -- undef rel_path croaks' => sub {
	throws_ok { _ctx()->abs_path(undef) }
		qr/requires a relative path/,
		'abs_path(undef) croaks';
};

subtest 'Context::slurp -- undef rel_path croaks' => sub {
	throws_ok { _ctx()->slurp(undef) }
		qr/requires a relative path/,
		'slurp(undef) croaks';
};

subtest 'Context::slurp -- missing file croaks with documented error' => sub {
	throws_ok { _ctx()->slurp('no_such_file.pm') }
		qr/File not found/,
		'slurp of absent file croaks "File not found"';
};

# abs_path must reject paths with ".." components to prevent
# reading/checking files outside the distribution root.
subtest 'Context -- path traversal via abs_path is blocked' => sub {
	my $ctx = _ctx();
	throws_ok { $ctx->abs_path('../outside.txt') }
		qr/path traversal/i,
		'abs_path with leading ".." rejected';
	throws_ok { $ctx->abs_path('lib/../../outside.txt') }
		qr/path traversal/i,
		'abs_path with embedded ".." rejected';
};

subtest 'Context -- path traversal via has_file is blocked' => sub {
	my $ctx = _ctx();
	throws_ok { $ctx->has_file('../sibling') }
		qr/path traversal/i,
		'has_file with ".." component rejected';
};

subtest 'Context -- path traversal via slurp is blocked' => sub {
	my $ctx = _ctx();
	throws_ok { $ctx->slurp('../secret.txt') }
		qr/path traversal/i,
		'slurp with ".." component rejected';
};

subtest 'Context::perl_files -- non-existent dirs skipped silently' => sub {
	# An empty root with no lib/ or t/ must return an empty arrayref, not die.
	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';
};

# ===========================================================================
# Report -- hostile add_findings inputs and empty-state rendering
# ===========================================================================

subtest 'Report::add_findings -- undef finding croaks' => sub {
	throws_ok { $Report->new->add_findings(undef) }
		qr/Expected an App::Project::Doctor::Finding/,
		'undef rejected by add_findings';
};

subtest 'Report::add_findings -- plain string croaks' => sub {
	throws_ok { $Report->new->add_findings('not a finding') }
		qr/Expected an App::Project::Doctor::Finding/,
		'string rejected by add_findings';
};

subtest 'Report::add_findings -- wrong blessed class croaks' => sub {
	# A blessed hashref that is not an ::Finding must be rejected.
	my $impostor = bless { severity => $SEV_ERROR, message => 'fake' }, 'FakeClass';
	throws_ok { $Report->new->add_findings($impostor) }
		qr/Expected an App::Project::Doctor::Finding/,
		'wrong-class object rejected';
};

subtest 'Report::add_findings -- no-arg call is a harmless no-op' => sub {
	my $r = $Report->new;
	lives_ok { $r->add_findings() } 'no-arg add_findings does not die';
	is( scalar($r->all_findings), 0, 'report stays empty' );
};

subtest 'Report::render_text -- empty report produces "No errors or warnings"' => sub {
	my $out;
	lives_ok { $out = $Report->new->render_text } 'render_text on empty report lives';
	like( $out, qr/No errors or warnings/i, 'empty report text is correct' );
};

subtest 'Report::render_tap -- empty report produces "1..0" plan' => sub {
	like( $Report->new->render_tap, qr/^1\.\.0/, '1..0 plan for empty report' );
};

subtest 'Report::has_errors / has_warnings -- return exact 0 and 1' => sub {
	my $r = $Report->new;
	is( $r->has_errors,   0, 'empty report: has_errors == 0' );
	is( $r->has_warnings, 0, 'empty report: has_warnings == 0' );

	$r->add_findings(_f(severity => $SEV_ERROR));
	is( $r->has_errors,   1, 'has_errors == 1 after adding an error'   );
	is( $r->has_warnings, 0, 'has_warnings == 0 with only an error'    );