view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

	my $f;
	lives_ok { $f = $Finding->new(message => '0', check_name => 'T') }
		'"0" passes the non-empty guard';
	is( $f->message, '0', 'message stored verbatim' );
};

subtest 'Finding::new -- whitespace-only message is accepted' => sub {
	# The spec says non-empty (length > 0), not non-whitespace.
	lives_ok { $Finding->new(message => $WHITESPACE, check_name => 'T') }
		'whitespace-only message accepted';
};

subtest 'Finding::new -- million-character message does not crash' => sub {
	my $f;
	lives_ok { $f = $Finding->new(message => $HUGE, check_name => 'T') }
		'huge message accepted';
	is( length($f->message), 1_000_000, 'full length preserved' );
};

subtest 'Finding::new -- invalid severity croaks with documented message' => sub {
	throws_ok { $Finding->new(message => $VALID_MSG, severity => 'critical') }
		qr/Invalid severity 'critical'/,
		'unknown severity rejected with documented error';
	throws_ok { $Finding->new(message => $VALID_MSG, severity => $EMPTY) }
		qr/Invalid severity/,
		'empty severity rejected';
};

subtest 'Finding::new -- line => 0 croaks (minimum is 1)' => sub {
	throws_ok { $Finding->new(message => $VALID_MSG, line => 0) }
		qr//,
		'line => 0 rejected by schema (min 1)';
};

subtest 'Finding::new -- line => -1 croaks (minimum is 1)' => sub {
	throws_ok { $Finding->new(message => $VALID_MSG, line => -1) }
		qr//,
		'negative line number rejected';
};

subtest 'Finding::new -- unknown constructor key rejected by strict schema' => sub {
	throws_ok { $Finding->new(message => $VALID_MSG, frob => 1) }
		qr//,
		'undocumented key "frob" rejected by Params::Validate::Strict';
};

subtest 'Finding::new -- arrayref as message rejected by PVS type check' => sub {
	# A ref is defined, and may pass length(); PVS type=>'scalar' must reject it.
	throws_ok { $Finding->new(message => [], check_name => 'T') }
		qr//,
		'arrayref rejected as message';
};

subtest 'Finding::new -- hashref as fix (not a coderef) rejected' => sub {
	throws_ok { $Finding->new(message => $VALID_MSG, fix => {}) }
		qr//,
		'hashref for fix rejected (type must be coderef)';
};

subtest 'Finding::new -- string as fix (not a coderef) rejected' => sub {
	throws_ok { $Finding->new(message => $VALID_MSG, fix => 'not_a_sub') }
		qr//,
		'plain string for fix rejected';
};

subtest 'Finding::is_fixable -- returns exact integers 1 and 0, not truthy refs' => sub {
	my $unfixable = _f();
	my $fixable   = _f(fix => sub { 1 });

	is( $unfixable->is_fixable, 0, 'unfixable returns 0'   );
	is( $fixable->is_fixable,   1, 'fixable returns 1'     );
	ok( !ref($unfixable->is_fixable), 'is_fixable is a plain scalar, not ref' );
	ok(  defined $unfixable->is_fixable, 'is_fixable never returns undef' );
};

subtest 'Finding::to_hash -- fix coderef excluded from serialisation' => sub {
	my $called = 0;
	my $f = _f(fix => sub { $called++ });
	my $h = $f->to_hash;
	ok( !exists $h->{fix}, 'fix key absent from to_hash' );
	is( $called, 0, 'fix coderef not invoked during to_hash' );
};

subtest 'Finding::to_hash -- line key absent when not set' => sub {
	my $h = _f()->to_hash;
	ok( !exists $h->{line}, 'line key absent when not set in constructor' );
};

subtest 'Finding::to_hash -- line key present and correct when set' => sub {
	my $h = _f(line => 99)->to_hash;
	is( $h->{line}, 99, 'line key present with correct value' );
};

subtest 'Finding::icon -- returns bracketed string for all four valid severities' => sub {
	Readonly::Hash my %EXPECT => (
		$SEV_ERROR   => '[X]',
		$SEV_WARNING => '[!]',
		$SEV_PASS    => '[v]',
		$SEV_INFO    => '[i]',
	);
	for my $sev (keys %EXPECT) {
		my $f = _f(severity => $sev);
		is( $f->icon, $EXPECT{$sev}, "icon for $sev is $EXPECT{$sev}" );
	}
};

# ===========================================================================
# Context -- hostile inputs and path traversal
# ===========================================================================

subtest 'Context::new -- non-existent root croaks' => sub {
	throws_ok { $Context->new(root => '/no/such/path/xyz987abc') }
		qr/is not a directory/,
		'non-existent root rejected';
};

subtest 'Context::new -- plain file path as root croaks' => sub {
	# A file exists but is not a directory.
	my $tmp = File::Temp->new(UNLINK => 1);
	throws_ok { $Context->new(root => $tmp->filename) }
		qr/is not a directory/,

t/edge_cases.t  view on Meta::CPAN

	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'    );

	$r->add_findings(_f(severity => $SEV_WARNING));
	is( $r->has_warnings, 1, 'has_warnings == 1 after adding a warning' );
};

subtest 'Report -- error accumulation and exit_code' => sub {
	my $r = $Report->new;
	$r->add_findings(_f(severity => $SEV_ERROR))   for 1 .. 4;
	$r->add_findings(_f(severity => $SEV_WARNING)) for 1 .. 2;
	is( scalar($r->errors),   4, '4 errors accumulated'           );
	is( scalar($r->warnings), 2, '2 warnings accumulated'         );
	is( $r->exit_code, 1,        'exit_code is 1 when errors exist' );
};

subtest 'Report -- exit_code is 0 when only warnings present' => sub {
	my $r = $Report->new;
	$r->add_findings(_f(severity => $SEV_WARNING));
	is( $r->exit_code, 0, 'exit_code is 0 for warnings-only report' );
};

# ===========================================================================
# Fixer -- hostile constructor, STDIN attack surface, index boundary
# ===========================================================================

subtest 'Fixer::new -- missing report argument croaks' => sub {
	throws_ok { $Fixer->new(context => _ctx()) }
		qr//,
		'new without report croaks';
};

subtest 'Fixer::new -- missing context argument croaks' => sub {
	throws_ok { $Fixer->new(report => $Report->new) }
		qr//,
		'new without context croaks';
};

subtest 'Fixer::new -- wrong object types rejected' => sub {
	# report/context must be proper blessed objects of the right class.
	throws_ok { $Fixer->new(report => {}, context => {}) }
		qr//,
		'plain hashrefs rejected for report and context';
};

subtest 'Fixer::new -- wrong Report subclass rejected' => sub {
	my $not_report = bless {}, 'NotAReport';
	throws_ok { $Fixer->new(report => $not_report, context => _ctx()) }
		qr/report must be an App::Project::Doctor::Report/,
		'wrong report class rejected with documented message';
};

subtest 'Fixer::new -- wrong Context subclass rejected' => sub {
	my $r          = $Report->new;
	my $not_context = bless {}, 'NotAContext';
	throws_ok { $Fixer->new(report => $r, context => $not_context) }
		qr/context must be an App::Project::Doctor::Context/,
		'wrong context class rejected with documented message';
};

subtest 'Fixer::run -- zero fixable findings returns 0 without touching STDIN' => sub {
	# A report with only pass findings must short-circuit immediately.
	my $r = _report_with(_f(severity => $SEV_PASS));
	my $fixer = $Fixer->new(report => $r, context => _ctx(), non_interactive => 1);
	my $out;
	open(local *STDOUT, '>', \$out) or die;
	is( $fixer->run, 0, 'run returns 0 for unfixable report' );
};

subtest 'Fixer -- STDIN immediately closed (undef) returns 0' => sub {
	# <STDIN> returning undef simulates a closed pipe; must not crash.
	my $r   = _report_with(_f(fix => sub { 1 }));
	my $out = $EMPTY;
	my @w;
	my $count = _run_fixer_interactive($r, $EMPTY, \$out, \@w);
	is( $count, 0, 'returns 0 when STDIN is immediately closed' );
};

subtest 'Fixer -- STDIN input "n" applies no fixes' => sub {
	my $applied = 0;
	my $r       = _report_with(_f(fix => sub { $applied++ }));
	my $out     = $EMPTY;
	my @w;
	my $count = _run_fixer_interactive($r, "n\n", \$out, \@w);
	is( $count,   0, '"n" applies zero fixes'           );
	is( $applied, 0, 'fix coderef was not called'        );
	like( $out, qr/No fixes applied/i, 'STDOUT confirms no fixes' );
};

subtest 'Fixer -- STDIN injection attempt treated as unrecognised input' => sub {
	# Hostile STDIN: code-like string must not be executed.
	# The ^[\d,\s]+$ guard must reject anything with non-digit non-comma chars.
	my $applied = 0;
	my $r       = _report_with(_f(fix => sub { $applied++ }));
	my $out     = $EMPTY;
	my @w;
	my $count = _run_fixer_interactive($r, "1; system('true')\n", \$out, \@w);
	is( $count,   0, 'injection-like input applies 0 fixes' );
	is( $applied, 0, 'fix coderef not invoked'              );
	like( $out, qr/Unrecognised input/i, 'user informed of unrecognised input' );
};

subtest 'Fixer -- STDIN index 0 is filtered (indices are 1-based)' => sub {
	my $applied = 0;
	my $r       = _report_with(_f(fix => sub { $applied++ }));
	my $out     = $EMPTY;
	my @w;
	_run_fixer_interactive($r, "0\n", \$out, \@w);
	is( $applied, 0, 'index 0 not applied (must be >= 1)' );
};

subtest 'Fixer -- STDIN out-of-range index applies no fixes' => sub {
	my $applied = 0;
	my $r       = _report_with(_f(fix => sub { $applied++ }));
	my $out     = $EMPTY;
	my @w;