Selkie.git | t/ | 107-error-log.rakutest

---

use Test;
use lib "lib";

use Selkie::App::Internal::ErrorLogPlatform :test;

plan 3;

sub remove-tree(IO::Path:D $path --> Nil) {
	return unless $path.e;
	if $path.d {
		remove-tree($_) for $path.dir;
		$path.rmdir;
	}
	else {
		$path.unlink;
	}
}

subtest "error-log dispatch selects a safe platform API" => {
	plan 3;

	is-deeply error-log-api-spec(False), Map.new(
		api     => "posix",
		library => Str,
		dup     => "dup",
		dup2    => "dup2",
		close   => "close",
	), "POSIX resolves unprefixed symbols from the process image";

	is-deeply error-log-api-spec(True), Map.new(
		api          => "win32",
		library      => "kernel32",
		create-file  => "CreateFileW",
		close-handle => "CloseHandle",
	), "Windows avoids MoarVM's private CRT descriptor table";

	is Selkie::App::Internal::ErrorLogPlatform::WINDOWS-STD-ERROR-HANDLE,
		0xFFFF_FFF4,
		"Win32 stderr selector is the unsigned DWORD value";
};

my $scratch = $*TMPDIR.add("selkie-error-log-{$*PID}-{(^1_000_000).pick}");
$scratch.mkdir;
END remove-tree($scratch);

my $fixture = $?FILE.IO.parent.add("fixtures").add("error-log-roundtrip.raku");
my $child = Proc::Async.new($*EXECUTABLE, "-Ilib", $fixture.Str, $scratch.Str);
my Str $stdout = "";
my Str $stderr = "";
my Lock $output-lock .= new;
$child.stdout.tap(-> $chunk { $output-lock.protect: { $stdout ~= $chunk } });
$child.stderr.tap(-> $chunk { $output-lock.protect: { $stderr ~= $chunk } });
my $done = $child.start;
await Promise.anyof($done, Promise.in(20));
my Bool $timed-out = $done.status === Planned;
if $timed-out {
	try $child.kill(Signal::SIGKILL);
	await Promise.anyof($done, Promise.in(5));
}
$stdout = $output-lock.protect: { $stdout };
$stderr = $output-lock.protect: { $stderr };
my $exitcode = $done.status === Kept ?? $done.result.exitcode !! -1;
my $failure-path = $scratch.add("fixture-failure.txt");
my $fixture-failure = $failure-path.e ?? $failure-path.slurp !! "";
my $stage-path = $scratch.add("fixture-stage.txt");
my $last-stage = $stage-path.e ?? $stage-path.slurp.chomp !! "not started";

subtest "redirect and restore are isolated in a subprocess" => {
	plan 7;

	ok !$timed-out, "roundtrip probe completes within 20 seconds"
		or diag "last stage: $last-stage";
	is $exitcode, 0, "roundtrip probe exits successfully"
		or diag "stdout:\n$stdout\nstderr:\n$stderr\nlast stage: $last-stage\nfixture:\n$fixture-failure";
	is $stdout, "child-ok\n", "probe reaches the end";

	my $log-a-path = $scratch.add("nested path").add("first error.log");
	my $log-a = $log-a-path.e ?? $log-a-path.slurp !! "";
	like $log-a, /^ "=== session " /, "install creates the parent and writes a session banner";
	like $log-a, / "raku-marker-a" \n "native-marker-a" /,
		"Raku and platform-native stderr writes reach the first log";

	my $log-b-path = $scratch.add("second error.log");
	my $log-b = $log-b-path.e ?? $log-b-path.slurp !! "";
	like $log-b, / "raku-marker-b" \n "native-marker-b" /,
		"a later install redirects both stderr views to the new log";
	unlike $log-a, / "marker-b" /,
		"switching logs leaves no stale redirect to the old file";
};

subtest "disabled and failed installs leave stderr usable" => {
	plan 7;

	my $process-log-path = $scratch.add("process error.log");
	my $process-log = $process-log-path.e ?? $process-log-path.slurp !! "";
	like $process-log, / "process-redirected-marker" /,
		"the process stderr helper redirects writes";
	like $stderr, / "process-restored-marker" /,
		"the process stderr helper restores an independent handle value";
	like $stderr, / "restored-marker" \n "native-restored-marker" /,
		"uninstall restores both platform stderr views";
	like $stderr, / "blank-path-marker" /, "a blank path is a no-op";
	like $stderr, / "unopenable-path-marker" /,
		"an unopenable path fails open without breaking stderr";
	unlike $stderr, / "raku-marker-a" | "native-marker-a" /,
		"first-session writes do not leak to restored stderr";
	unlike $stderr, / "raku-marker-b" | "native-marker-b" /,
		"second-session writes do not leak to restored stderr";
};