view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

	my @warnings;
	local $SIG{__WARN__} = sub { push @warnings, @_ };

	my $result;
	lives_ok { $result = App::makefilepl2cpanfile::parse_prereqs($circular) }
		'circular reference does not cause infinite recursion or crash';

	isa_ok $result, 'HASH', 'circular ref input returns a hashref';
	is scalar keys %{$result}, 0, 'result is empty for circular reference input';
	is scalar @warnings, 0, 'no warnings for circular reference input';
};

subtest 'parse_prereqs: invalid UTF-8 bytes in content string — no crash, no warnings' => sub {
	# When the caller passes a byte string containing invalid UTF-8 sequences,
	# the regex engine must operate on the raw bytes without crashing or warning.
	# Byte strings (no UTF-8 flag) are valid Perl scalars; [^{}] matches any byte.
	my $content = "PREREQ_PM => { \x27Carp\x27 => 0 };\xFF\xFEjunk";

	my @warnings;
	local $SIG{__WARN__} = sub { push @warnings, @_ };

	my $result;
	lives_ok { $result = App::makefilepl2cpanfile::parse_prereqs($content) }
		'invalid UTF-8 bytes in string content do not crash parse_prereqs';

	isa_ok $result, 'HASH', 'returns a hashref for content with invalid UTF-8 bytes';
	is scalar @warnings, 0, 'no warnings emitted for byte-string content';

	diag "Found phases: " . join(', ', keys %{$result}) if $ENV{TEST_VERBOSE};
};

subtest 'generate: Makefile.PL with trailing invalid UTF-8 bytes — warns, finds valid deps' => sub {
	# Path::Tiny slurp_utf8 emits Carp warnings for each ill-formed byte but
	# does NOT die — it returns the (possibly substituted) content and continues.
	# Strategy: write a file whose valid prefix contains a PREREQ_PM block and
	# whose suffix contains \xFF\xFE; verify generate() survives and finds Carp.
	my $g     = empty_home();
	my $dir   = tempdir(CLEANUP => 1);
	my $mf    = path($dir)->child('Makefile.PL');
	$mf->spew_raw("WriteMakefile(PREREQ_PM => { \x27Carp\x27 => 0 });\xFF\xFE\n");

	my @warnings;
	local $SIG{__WARN__} = sub { push @warnings, @_ };

	my $out;
	lives_ok {
		$out = App::makefilepl2cpanfile::generate(
			makefile     => "$mf",
			with_develop => 0,
		)
	} 'invalid UTF-8 bytes in Makefile.PL do not crash generate()';

	like $out, qr/Carp/, 'valid dep before invalid bytes is captured correctly';
	ok scalar @warnings > 0,
		'invalid UTF-8 bytes trigger warnings from slurp_utf8 (not silent corruption)';

	diag "Warning count: " . scalar(@warnings) if $ENV{TEST_VERBOSE};
};

subtest 'parse_prereqs: extreme numerical version strings — _has_version contract' => sub {
	# Verify that unusual-but-valid number strings (Inf, NaN, very large ints)
	# are handled consistently by the looks_like_number + != 0 logic.
	# These are "real constraints" (non-zero) even if nonsensical in practice.
	Readonly my @EXTREME_NONZERO_VERS => (
		[ 'Inf',                    1, 'Inf is looks_like_number and != 0'           ],
		[ '-Inf',                   1, '-Inf is looks_like_number and != 0'          ],
		[ 'NaN',                    1, 'NaN is looks_like_number and != 0 (IEEE 754)'],
		[ '99999999999999999999',   1, '20-digit int overflows to ~1e20, != 0'       ],
		[ '0.000000001',            1, 'tiny positive fraction is non-zero'          ],
		[ '1e300',                  1, 'very large float is non-zero'                ],
	);
	Readonly my @EXTREME_ZERO_VERS => (
		[ '0.000',                  0, 'leading zeros — numerically zero'            ],
		[ '+0',                     0, 'explicit positive zero is still zero'        ],
	);

	for my $case (@EXTREME_NONZERO_VERS) {
		my ($ver, $expected, $label) = @{$case};
		is !!App::makefilepl2cpanfile::_has_version($ver), !!$expected, $label;
	}
	for my $case (@EXTREME_ZERO_VERS) {
		my ($ver, $expected, $label) = @{$case};
		is !!App::makefilepl2cpanfile::_has_version($ver), !!$expected, $label;
	}
};

subtest 'parse_prereqs: 1 MB of noise with embedded PREREQ_PM — completes without crashing' => sub {
	# Defensive performance test: a megabyte of random-ish content must not
	# cause catastrophic regex backtracking.  [^{}] and \{...\} are mutually
	# exclusive at each position, so no backtracking occurs.
	# Strategy: embed a valid PREREQ_PM block inside 500 KB of ASCII noise on
	# either side and verify parse_prereqs finds the module.
	Readonly my $HALF_MB => 'abcdefg ' x 70_000;    # ~560 KB, no braces
	my $content = $HALF_MB
		. "PREREQ_PM => { \x27Carp\x27 => 0 },"
		. $HALF_MB;

	my $result;
	lives_ok { $result = App::makefilepl2cpanfile::parse_prereqs($content) }
		'1 MB of content does not crash parse_prereqs';

	ok exists $result->{runtime}{requires}{'Carp'},
		'Carp found inside 1 MB content — regex scans without hanging';
};

subtest 'parse_prereqs: 100-level brace nesting completes within time limit' => sub {
	# Verify no catastrophic backtracking when brace nesting far exceeds the
	# 4-level regex limit.  Uses alarm() to enforce a hard wall-clock ceiling.
	SKIP: {
		skip 'alarm() is unreliable on this platform', 3 if $^O eq 'MSWin32';

		Readonly my $ALARM_SECS => 5;
		my $timed_out = 0;

		local $SIG{ALRM} = sub { $timed_out = 1; die "TIMEOUT\n" };
		alarm($ALARM_SECS);

		my $content = 'PREREQ_PM => '
			. ('{' x 100)
			. "\x27Module\x27 => 0"    # 'Module' => 0 as raw bytes
			. ('}' x 100);

		my $result;
		lives_ok { $result = App::makefilepl2cpanfile::parse_prereqs($content) }
			'100-level brace nesting does not crash or time out';

		alarm(0);

		ok !$timed_out, "completed within ${ALARM_SECS}s (no catastrophic backtracking)";
		isa_ok $result, 'HASH', 'returns a hashref even for extreme brace nesting';
	}
};

subtest 'parse_prereqs: version as unevaluated Perl expression — security invariant' => sub {
	# A module version written as a Perl expression (e.g. 9**9**9) in the
	# source of Makefile.PL must NEVER be evaluated.  The regex captures only
	# the leading digit sequence; 9**9**9 becomes version '9', not Inf or error.
	my $content = "PREREQ_PM => { \x27Module\x27 => 9**9**9 },";

	my $result;
	lives_ok { $result = App::makefilepl2cpanfile::parse_prereqs($content) }
		'Perl expression as version does not crash or eval';

	my $ver = $result->{runtime}{requires}{'Module'}{version} // 'undef';
	ok defined $ver, 'version field is defined (regex captured leading digits)';
	unlike "$ver", qr/Inf|NaN/i, 'captured version is not Inf/NaN (no eval occurred)';
	ok $ver =~ /^\d/, 'captured version starts with a digit — just the literal text';

	diag "Captured version for 9**9**9: $ver" if $ENV{TEST_VERBOSE};
};

subtest 'generate: reference as existing arg — no crash, no spurious develop merge' => sub {
	# A reference passed as existing stringifies silently to e.g. "ARRAY(0x...)"
	# which the develop-block regex cannot match.  No warnings are emitted and
	# no develop block should appear in the output.
	my $g  = empty_home();
	my $mf = make_mf($MF_SIMPLE);

	my @warnings;
	local $SIG{__WARN__} = sub { push @warnings, @_ };

	my $out;
	lives_ok {
		$out = App::makefilepl2cpanfile::generate(
			makefile     => "$mf",
			existing     => [],    # array ref, not a string
			with_develop => 0,
		)
	} 'array ref as existing does not crash';

	is scalar @warnings, 0, 'no warnings for reference existing arg';
	unlike $out, qr/on 'develop' => sub/,
		'no spurious develop block from reference existing';
	like $out, qr/Carp/, 'normal dep output produced';
};

# -----------------------------------------------------------------------
# SECTION 6: Filesystem Hostility
# -----------------------------------------------------------------------

subtest 'generate: unreadable Makefile.PL (mode 000) must croak' => sub {
	# Strategy: create a file, remove all permissions, then verify the
	# -r guard fires.  Root bypasses permissions, so skip under euid 0.
	SKIP: {
		skip 'running as root — filesystem permissions are not enforced', 1
			if $> == 0;

		my $g   = empty_home();
		my $dir = tempdir(CLEANUP => 1);
		my $mf  = path($dir)->child('Makefile.PL');
		$mf->spew_utf8($MF_SIMPLE);
		chmod 0000, "$mf";

		throws_ok {
			App::makefilepl2cpanfile::generate(makefile => "$mf")
		} qr/Cannot read/, 'mode-000 Makefile.PL causes croak';

		chmod 0644, "$mf";    # restore so temp-cleanup can remove it
	}
};

subtest 'generate: dangling symlink must croak' => sub {
	# A symlink whose target does not exist: -f returns false (target absent),
	# so the Cannot-read guard must fire.
	my $g      = empty_home();
	my $dir    = tempdir(CLEANUP => 1);