test(harness): port case runner to Perl

Co-Authored-By: Claude Fable 5.1 <noreply@anthropic.com>

3 files changed, 510 insertions, 253 deletions

diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt
index 1cb2eff..9f755a6 100644
--- a/tests/CMakeLists.txt
+++ b/tests/CMakeLists.txt
@@ -19,8 +19,8 @@ foreach(suite i ii iii)
             target_compile_features(${reference_target} PRIVATE cxx_std_17)
             list(APPEND reference_args --reference "$<TARGET_FILE:${reference_target}>")
         endif()
-        add_test(NAME "${suite}/${case_name}" COMMAND "${Python3_EXECUTABLE}"
-            "${CMAKE_CURRENT_SOURCE_DIR}/run.py"
+        add_test(NAME "${suite}/${case_name}" COMMAND "${PERL_EXECUTABLE}"
+            "${CMAKE_CURRENT_SOURCE_DIR}/run.pl"
             --case "${manifest}" --cpsc "$<TARGET_FILE:cpsc>"
             --run-mode "${CPSC_RUN_MODE}" --perl "${PERL_EXECUTABLE}"
             --seed "${CPSC_TEST_SEED}" --count "${CPSC_TEST_COUNT}"
diff --git a/tests/run.pl b/tests/run.pl
new file mode 100644
index 0000000..41437de
--- /dev/null
+++ b/tests/run.pl
@@ -0,0 +1,508 @@
+#!/usr/bin/env perl
+# Run one compiler fixture. Only CRLF is normalized; failures are never waived.
+use strict;
+use warnings;
+use Cwd qw(abs_path);
+use File::Copy ();
+use File::Find ();
+use File::Path qw(make_path remove_tree);
+use File::Spec;
+use FindBin;
+use Getopt::Long qw(GetOptions);
+use JSON::PP ();
+
+$| = 1;
+
+my $ROOT = abs_path(File::Spec->catdir($FindBin::Bin, File::Spec->updir()));
+my $IS_WINDOWS = ($^O =~ /^(?:MSWin32|msys|cygwin)$/i) ? 1 : 0;
+
+sub normalized {
+    my ($data) = @_;
+    $data = '' unless defined $data;
+    my $copy = $data;
+    $copy =~ s/\r\n/\n/g;
+    return $copy;
+}
+
+# Single-quoted escaping: keeps trailing spaces, missing newlines and
+# non-UTF-8 bytes visible without any non-core module.
+sub show_bytes {
+    my ($data) = @_;
+    $data = '' unless defined $data;
+    $data =~ s/\\/\\\\/g;
+    $data =~ s/\n/\\n/g;
+    $data =~ s/\r/\\r/g;
+    $data =~ s/\t/\\t/g;
+    $data =~ s/([^ -~])/sprintf('\\x{%02x}', ord($1))/ge;
+    return "'$data'";
+}
+
+sub split_keeplines {
+    my ($data) = @_;
+    return () if !defined($data) || $data eq '';
+    return ($data =~ /(?:[^\n]*\n|[^\n]+\z)/g);
+}
+
+# Like Python's bytes.splitlines(): exactly one trailing empty is dropped.
+sub split_records {
+    my ($data) = @_;
+    return () if !defined($data) || $data eq '';
+    my @records = split(/\n/, $data, -1);
+    pop(@records) if $data =~ /\n\z/;
+    return @records;
+}
+
+sub compare {
+    my ($expected, $actual, $label) = @_;
+    my $want = normalized($expected);
+    my $got = normalized($actual);
+    return if $want eq $got;
+    my @left = split_keeplines($want);
+    my @right = split_keeplines($got);
+    my $count = @left < @right ? @left : @right;
+    my $index = $count;
+    for my $i (0 .. $count - 1) {
+        if ($left[$i] ne $right[$i]) {
+            $index = $i;
+            last;
+        }
+    }
+    my $line = $index + 1;
+    my $want_show = $index < @left ? show_bytes($left[$index]) : '<missing>';
+    my $got_show = $index < @right ? show_bytes($right[$index]) : '<missing>';
+    die "$label differs at line $line: expected $want_show, actual $got_show\n";
+}
+
+sub check_result {
+    my ($result, $expected, $exit_code) = @_;
+    $exit_code = 0 unless defined $exit_code;
+    my @errors;
+    if ($result->{returncode} != $exit_code) {
+        push @errors, "exit code: expected $exit_code, got $result->{returncode}";
+    }
+    if (length($result->{stderr})) {
+        my $shown = show_bytes(substr($result->{stderr}, 0, 2000));
+        push @errors, "unexpected stderr: $shown";
+    }
+    my $ok = eval { compare($expected, $result->{stdout}, 'stdout'); 1; };
+    if (!$ok) {
+        my $err = $@;
+        chomp($err);
+        push @errors, $err;
+    }
+    if (@errors) {
+        die join("\n", @errors) . "\n";
+    }
+}
+
+sub check_diagnostics {
+    my ($result, $expectations) = @_;
+    my @errors;
+    if ($result->{returncode} != 1) {
+        push @errors, "compiler exit code: expected 1, got $result->{returncode}";
+    }
+    if (length($result->{stdout})) {
+        push @errors, 'unexpected stdout: ' . show_bytes(substr($result->{stdout}, 0, 1000));
+    }
+    # ASCII markers (error:, line N) are matched on raw bytes; the compiler
+    # emits UTF-8 and ASCII patterns are unaffected by decoding.
+    my @lines = split_records(normalized($result->{stderr}));
+    for my $expectation (@{$expectations}) {
+        my $reason = $expectation->{reason};
+        my $line_no = $expectation->{line};
+        my @matching = grep { /error:/ && /$reason/ } @lines;
+        my $found = 0;
+        for my $line (@matching) {
+            if ($line =~ /\bline $line_no\b/) {
+                $found = 1;
+                last;
+            }
+        }
+        if (!$found) {
+            push @errors, 'missing error /' . $reason . '/ at line ' . $line_no
+                . '; matching diagnostics: [' . join(', ', map { show_bytes($_) } @matching) . ']';
+        }
+    }
+    my $terminated = grep { $_ eq 'compilation terminated.' } @lines;
+    if ($terminated != 1) {
+        push @errors, "expected exactly one 'compilation terminated.' line";
+    }
+    if (@errors) {
+        die join("\n", @errors) . "\n";
+    }
+}
+
+sub read_file {
+    my ($path) = @_;
+    open my $fh, '<:raw', $path or die "cannot read $path: $!\n";
+    my $data = do { local $/; <$fh> };
+    close $fh;
+    return defined($data) ? $data : '';
+}
+
+sub write_file {
+    my ($path, $data) = @_;
+    $data = '' unless defined $data;
+    open my $fh, '>:raw', $path or die "cannot write $path: $!\n";
+    print {$fh} $data;
+    close $fh;
+}
+
+sub commands_new {
+    my ($directory) = @_;
+    return {dir => $directory, index => 0};
+}
+
+sub write_metadata {
+    my ($stem, $metadata) = @_;
+    my $json = JSON::PP->new->canonical(1)->pretty(1)->encode($metadata);
+    write_file($stem . '.json', $json);
+}
+
+# Run one command without a shell, retaining argv, cwd, input, status and
+# output under the case result directory. Dies on timeout or launch failure.
+sub run_command {
+    my ($state, $command, $cwd, $data, $timeout) = @_;
+    $data = '' unless defined $data;
+    $timeout = 30 unless defined $timeout;
+    $state->{index}++;
+    my $stem = File::Spec->catfile($state->{dir}, sprintf('%02d', $state->{index}));
+    my %metadata = (command => [@{$command}], cwd => "$cwd", timeout => $timeout + 0);
+    write_file($stem . '.stdin', $data);
+    my $pid = fork();
+    if (!defined($pid)) {
+        $metadata{launch_error} = "fork failed: $!";
+        write_metadata($stem, \%metadata);
+        die "cannot launch @{$command}: fork failed: $!\n";
+    }
+    if ($pid == 0) {
+        open STDIN, '<:raw', $stem . '.stdin' or exit 126;
+        open STDOUT, '>:raw', $stem . '.stdout' or exit 126;
+        open STDERR, '>:raw', $stem . '.stderr' or exit 126;
+        if (!chdir($cwd)) {
+            print STDERR "CPSC_LAUNCH_ERROR: cannot chdir to $cwd: $!";
+            exit 126;
+        }
+        { exec {$command->[0]} @{$command}; }
+        print STDERR "CPSC_LAUNCH_ERROR: cannot exec @{$command}: $!";
+        exit 126;
+    }
+    my $alarm_secs = int($timeout);
+    $alarm_secs = 1 if $alarm_secs < 1;
+    my $timed_out = 0;
+    local $SIG{ALRM} = sub { $timed_out = 1; kill('KILL', $pid); };
+    alarm($alarm_secs);
+    waitpid($pid, 0);
+    alarm(0);
+    my $status = $?;
+    if ($timed_out) {
+        waitpid($pid, 0);
+        for my $suffix ('.stdout', '.stderr') {
+            if (!-f ($stem . $suffix)) {
+                write_file($stem . $suffix, '');
+            }
+        }
+        $metadata{timeout_expired} = JSON::PP::true;
+        write_metadata($stem, \%metadata);
+        die "command timed out after ${timeout}s: @{$command}\n";
+    }
+    my $exit_code = $status >> 8;
+    my $out = -f ($stem . '.stdout') ? read_file($stem . '.stdout') : '';
+    my $err = -f ($stem . '.stderr') ? read_file($stem . '.stderr') : '';
+    if ($exit_code == 126 && $err =~ s/^CPSC_LAUNCH_ERROR: //) {
+        chomp($err);
+        $metadata{launch_error} = $err;
+        write_metadata($stem, \%metadata);
+        write_file($stem . '.stdout', $out);
+        write_file($stem . '.stderr', $err);
+        die "cannot launch @{$command}: $err\n";
+    }
+    $metadata{exit_code} = $exit_code + 0;
+    write_metadata($stem, \%metadata);
+    write_file($stem . '.stdout', $out);
+    write_file($stem . '.stderr', $err);
+    return {returncode => $exit_code + 0, stdout => $out, stderr => $err};
+}
+
+sub copy_tree {
+    my ($src, $dst) = @_;
+    opendir(my $dh, $src) or die "cannot read $src: $!\n";
+    my @entries = sort grep { $_ ne '.' && $_ ne '..' } readdir($dh);
+    closedir($dh);
+    for my $entry (@entries) {
+        my $from = File::Spec->catfile($src, $entry);
+        my $to = File::Spec->catfile($dst, $entry);
+        if (-d $from && !-l $from) {
+            make_path($to);
+            copy_tree($from, $to);
+        }
+        elsif (-f $from || -l $from) {
+            File::Copy::copy($from, $to) or die "cannot copy $from: $!\n";
+        }
+    }
+}
+
+sub workspace {
+    my ($case_dir, $directory, $name) = @_;
+    my $work = File::Spec->catdir($directory, $name);
+    make_path($work);
+    my $files = File::Spec->catdir($case_dir, 'files');
+    if (-d $files) {
+        copy_tree($files, $work);
+    }
+    return $work;
+}
+
+sub check_files {
+    my ($case_dir, $work) = @_;
+    my $expected_dir = File::Spec->catdir($case_dir, 'expected-files');
+    return unless -d $expected_dir;
+    my @found;
+    File::Find::find(
+        {wanted => sub { push(@found, $File::Find::name) if -f $_; }, no_chdir => 1},
+        $expected_dir,
+    );
+    for my $expected (sort @found) {
+        my $relative = File::Spec->abs2rel($expected, $expected_dir);
+        my $actual = File::Spec->catfile($work, File::Spec->splitdir($relative));
+        if (!-f $actual) {
+            die "missing output file: $relative\n";
+        }
+        compare(read_file($expected), read_file($actual), $relative);
+    }
+}
+
+sub main {
+    my @args = @_;
+    local @ARGV = @args;
+    my ($opt_case, $opt_cpsc, $opt_run_mode, $opt_reference, $opt_perl, $opt_seed,
+        $opt_count, $opt_results);
+    $opt_perl = 'perl';
+    $opt_seed = '';
+    $opt_count = 10000;
+    $opt_results = File::Spec->catdir($ROOT, 'build', 'test-results');
+    my $parsed = GetOptions(
+        'case=s'      => \$opt_case,
+        'cpsc=s'      => \$opt_cpsc,
+        'run-mode=s'  => \$opt_run_mode,
+        'reference=s' => \$opt_reference,
+        'perl=s'      => \$opt_perl,
+        'seed=s'      => \$opt_seed,
+        'count=i'     => \$opt_count,
+        'results=s'   => \$opt_results,
+    );
+    if (!$parsed || !defined($opt_case) || !defined($opt_cpsc) || !defined($opt_run_mode)) {
+        warn "usage: $0 --case MANIFEST --cpsc CPSC --run-mode MODE [options]\n";
+        return 2;
+    }
+    if ($opt_run_mode !~ /^(?:EMBEDDED|PATH|NONE)$/) {
+        warn "invalid --run-mode: $opt_run_mode\n";
+        return 2;
+    }
+    if ($opt_count < 1) {
+        warn "--count must be positive\n";
+        return 2;
+    }
+    my $case_abs = abs_path($opt_case);
+    my $cpsc_abs = abs_path($opt_cpsc);
+    my $reference_abs = defined($opt_reference) ? abs_path($opt_reference) : undef;
+    my $case_dir = File::Spec->catdir((File::Spec->splitpath($case_abs))[0, 1]);
+    $case_dir =~ s{[\\/]$}{};
+    my @parts = File::Spec->splitdir($case_dir);
+    my $suite = $parts[-2];
+    my $name = $parts[-1];
+    open my $cfg_fh, '<:raw', $case_abs or die "cannot read $case_abs: $!\n";
+    my $config_text = do { local $/; <$cfg_fh> };
+    close $cfg_fh;
+    my $config = JSON::PP->new->decode($config_text);
+    open my $git_fh, '-|', 'git', '-C', $ROOT, 'rev-parse', 'HEAD'
+        or die "cannot run git: $!\n";
+    my $commit = <$git_fh>;
+    close $git_fh;
+    if ($? != 0 || !defined($commit)) {
+        die "cannot determine HEAD commit\n";
+    }
+    chomp($commit);
+    my $seed = length($opt_seed) ? $opt_seed : $commit;
+    my $directory = File::Spec->catdir(abs_path($opt_results), $suite, $name);
+    if (-e $directory) {
+        remove_tree($directory);
+    }
+    make_path($directory);
+    my $commands = commands_new($directory);
+    my $report = {
+        case         => "$suite/$name",
+        commit       => $commit,
+        seed         => $seed,
+        random_count => $opt_count + 0,
+        platform    => "$^O",
+        run_mode     => $opt_run_mode,
+        failures     => [],
+    };
+    my $source = File::Spec->catfile($case_dir, 'program.cps');
+
+    my $attempt = sub {
+        my ($label, $code) = @_;
+        my $ok = eval { $code->(); 1; };
+        if (!$ok) {
+            my $err = "$@";
+            chomp($err);
+            push(@{$report->{failures}}, {stage => $label, message => $err});
+            print "FAIL $suite/$name [$label]: $err\n";
+        }
+        else {
+            print "PASS $suite/$name [$label]\n";
+        }
+    };
+
+    my $diagnostics = sub {
+        for my $output_format ('native', 'ir') {
+            my $work = workspace($case_dir, $directory, $output_format);
+            my $target = File::Spec->catfile($work,
+                $IS_WINDOWS ? 'program.exe' : 'program.bin');
+            my @flags = $output_format eq 'ir' ? ('-S') : ();
+            for my $existing (0, 1) {
+                my $sentinel = 'existing output must survive' . "\n";
+                if ($existing) {
+                    write_file($target, $sentinel);
+                }
+                my $result = run_command($commands,
+                    [$cpsc_abs, $source, @flags, '-o', $target], $work, '', 120);
+                my $preservation_error;
+                if ($existing && (!-f $target || read_file($target) ne $sentinel)) {
+                    $preservation_error = 'compilation failure overwrote existing output';
+                }
+                if (!$existing && -f $target) {
+                    $preservation_error = 'compilation failure created output';
+                    unlink($target);
+                }
+                my $captured_result = $result;
+                my $captured_error = $preservation_error;
+                $attempt->(
+                    "$output_format/" . ($existing ? 'existing' : 'absent'),
+                    sub {
+                        if (defined($captured_error)) {
+                            die "$captured_error\n";
+                        }
+                        check_diagnostics($captured_result, $config->{errors});
+                    },
+                );
+            }
+        }
+    };
+
+    my $setup_ok = eval {
+        if ($suite eq 'iii') {
+            $diagnostics->();
+        }
+        else {
+            my $input_path = File::Spec->catfile($case_dir, 'input.txt');
+            my $data = -f $input_path ? read_file($input_path) : '';
+            my @records;
+            my $expected;
+            if ($suite eq 'ii') {
+                if (!defined($reference_abs)) {
+                    die "differential tests require --reference\n";
+                }
+                my $generated = run_command($commands,
+                    [$opt_perl, File::Spec->catfile($case_dir, 'generate.pl'), $seed, "$opt_count"],
+                    $directory, '', 30);
+                if ($generated->{returncode} != 0 || length($generated->{stderr})) {
+                    die 'generator failed: ' . show_bytes($generated->{stderr}) . "\n";
+                }
+                $data = $generated->{stdout};
+                @records = split_records(normalized($data));
+                if (!@records || $records[0] !~ /^\d+$/ || $records[0] + 0 != @records - 1) {
+                    die "generator must emit record count followed by one record per line\n";
+                }
+                my $work = workspace($case_dir, $directory, 'reference');
+                my $exec_timeout = exists($config->{timeout}) ? $config->{timeout} + 0 : 30;
+                my $reference = run_command($commands, [$reference_abs], $work, $data,
+                    $exec_timeout);
+                if ($reference->{returncode} != 0 || length($reference->{stderr})) {
+                    die "reference failed ($reference->{returncode}): "
+                        . show_bytes($reference->{stderr}) . "\n";
+                }
+                $expected = $reference->{stdout};
+                my @expected_lines = split_records(normalized($expected));
+                if (@expected_lines != @records - 1) {
+                    die "reference must emit exactly one output line per input record\n";
+                }
+            }
+            else {
+                $expected = read_file(File::Spec->catfile($case_dir, 'expected.txt'));
+            }
+            write_file(File::Spec->catfile($directory, 'input.txt'), $data);
+            write_file(File::Spec->catfile($directory, 'expected.txt'), $expected);
+
+            my $execute = sub {
+                my ($mode) = @_;
+                my $work = workspace($case_dir, $directory, $mode);
+                my $command;
+                if ($mode eq 'native') {
+                    my $target = File::Spec->catfile($work,
+                        $IS_WINDOWS ? 'program.exe' : 'program.bin');
+                    my $compiled = run_command($commands,
+                        [$cpsc_abs, $source, '-o', $target], $work, '', 120);
+                    check_result($compiled, '');
+                    $command = [$target];
+                }
+                else {
+                    $command = [$cpsc_abs, $source, '-r'];
+                }
+                my $exec_timeout = exists($config->{timeout}) ? $config->{timeout} + 0 : 30;
+                my $result = run_command($commands, $command, $work, $data, $exec_timeout);
+                if ($suite eq 'ii' && normalized($result->{stdout}) ne normalized($expected)) {
+                    my @wanted = split_keeplines(normalized($expected));
+                    my @got = split_keeplines(normalized($result->{stdout}));
+                    my $count = @wanted < @got ? @wanted : @got;
+                    my $index = $count;
+                    for my $i (0 .. $count - 1) {
+                        if ($wanted[$i] ne $got[$i]) {
+                            $index = $i;
+                            last;
+                        }
+                    }
+                    my $record = ($index + 1 < @records) ? $records[$index + 1] : '<extra output>';
+                    print 'First differing record ' . ($index + 1) . ': ' . show_bytes($record) . "\n";
+                    my $difference = {
+                        record   => $index + 1,
+                        input    => $record,
+                        expected => $index < @wanted ? show_bytes($wanted[$index]) : '<missing>',
+                        actual   => $index < @got ? show_bytes($got[$index]) : '<missing>',
+                    };
+                    my $diff_json = JSON::PP->new->canonical(1)->pretty(1)->encode($difference);
+                    write_file(File::Spec->catfile($directory, "$mode-first-difference.json"),
+                        $diff_json);
+                }
+                my $exit_code = exists($config->{exit_code}) ? $config->{exit_code} + 0 : 0;
+                check_result($result, $expected, $exit_code);
+                check_files($case_dir, $work);
+            };
+            my @modes = ('native');
+            if ($opt_run_mode ne 'NONE') {
+                push(@modes, 'runner');
+            }
+            for my $mode (@modes) {
+                my $captured = $mode;
+                $attempt->($captured, sub { $execute->($captured); });
+            }
+        }
+        1;
+    };
+    if (!$setup_ok) {
+        my $err = "$@";
+        chomp($err);
+        push(@{$report->{failures}}, {stage => 'setup', message => $err});
+        print "FAIL $suite/$name [setup]: $err\n";
+    }
+    $report->{passed} = @{$report->{failures}} ? JSON::PP::false : JSON::PP::true;
+    my $report_json = JSON::PP->new->canonical(1)->pretty(1)->encode($report);
+    write_file(File::Spec->catfile($directory, 'result.json'), $report_json);
+    print "Seed: $seed; results: $directory\n";
+    return $report->{passed} ? 0 : 1;
+}
+
+exit(main(@ARGV)) unless caller;
+
+1;
diff --git a/tests/run.py b/tests/run.py
deleted file mode 100644
index 0d57728..0000000
--- a/tests/run.py
+++ /dev/null
@@ -1,251 +0,0 @@
-#!/usr/bin/env python3
-"""Run one compiler fixture. Only CRLF is normalized; failures are never waived."""
-
-import argparse
-import difflib
-import json
-import os
-from pathlib import Path
-import platform
-import re
-import shutil
-import subprocess
-import sys
-
-
-ROOT = Path(__file__).resolve().parent.parent
-
-
-class Failure(Exception):
-    pass
-
-
-def normalized(data):
-    return data.replace(b"\r\n", b"\n")
-
-
-def compare(expected, actual, label):
-    expected, actual = normalized(expected), normalized(actual)
-    if expected == actual:
-        return
-    # repr keeps trailing spaces, missing newlines and non-UTF-8 bytes visible.
-    left = [repr(line) + "\n" for line in expected.splitlines(keepends=True)]
-    right = [repr(line) + "\n" for line in actual.splitlines(keepends=True)]
-    diff = "".join(difflib.unified_diff(left, right, "expected", "actual", n=2))
-    raise Failure(f"{label} differs:\n{diff[:5000]}")
-
-
-def check_result(result, expected, exit_code=0):
-    errors = []
-    if result.returncode != exit_code:
-        errors.append(f"exit code: expected {exit_code}, got {result.returncode}")
-    if result.stderr:
-        errors.append(f"unexpected stderr: {result.stderr[:2000]!r}")
-    try:
-        compare(expected, result.stdout, "stdout")
-    except Failure as error:
-        errors.append(str(error))
-    if errors:
-        raise Failure("\n".join(errors))
-
-
-def check_diagnostics(result, expectations):
-    errors = []
-    if result.returncode != 1:
-        errors.append(f"compiler exit code: expected 1, got {result.returncode}")
-    if result.stdout:
-        errors.append(f"unexpected stdout: {result.stdout[:1000]!r}")
-    lines = normalized(result.stderr).decode("utf-8", errors="replace").splitlines()
-    for expectation in expectations:
-        matching = [line for line in lines if "error:" in line
-                    and re.search(expectation["reason"], line)]
-        location = rf"\bline {expectation['line']}\b"
-        if not any(re.search(location, line) for line in matching):
-            errors.append(f"missing error /{expectation['reason']}/ at line "
-                          f"{expectation['line']}; matching diagnostics: {matching}")
-    if lines.count("compilation terminated.") != 1:
-        errors.append("expected exactly one 'compilation terminated.' line")
-    if errors:
-        raise Failure("\n".join(errors))
-
-
-class Commands:
-    def __init__(self, directory):
-        self.directory = directory
-        self.index = 0
-
-    def run(self, command, cwd, data=b"", timeout=30):
-        self.index += 1
-        stem = self.directory / f"{self.index:02d}"
-        metadata = {"command": [str(arg) for arg in command], "cwd": str(cwd),
-                    "timeout": timeout}
-        stem.with_suffix(".stdin").write_bytes(data)
-        try:
-            result = subprocess.run(metadata["command"], cwd=cwd, input=data,
-                                    stdout=subprocess.PIPE, stderr=subprocess.PIPE,
-                                    timeout=timeout)
-            metadata["exit_code"] = result.returncode
-        except subprocess.TimeoutExpired as error:
-            metadata["timeout_expired"] = True
-            stem.with_suffix(".stdout").write_bytes(error.stdout or b"")
-            stem.with_suffix(".stderr").write_bytes(error.stderr or b"")
-            raise Failure(f"command timed out after {timeout}s: {command}") from error
-        except OSError as error:
-            metadata["launch_error"] = str(error)
-            raise Failure(f"cannot launch {command}: {error}") from error
-        finally:
-            stem.with_suffix(".json").write_text(json.dumps(metadata, indent=2) + "\n",
-                                                 encoding="utf-8")
-        stem.with_suffix(".stdout").write_bytes(result.stdout)
-        stem.with_suffix(".stderr").write_bytes(result.stderr)
-        return result
-
-
-def workspace(case_dir, directory, name):
-    work = directory / name
-    work.mkdir()
-    if (case_dir / "files").is_dir():
-        shutil.copytree(case_dir / "files", work, dirs_exist_ok=True)
-    return work
-
-
-def check_files(case_dir, work):
-    for expected in sorted((case_dir / "expected-files").glob("**/*")):
-        if expected.is_file():
-            relative = expected.relative_to(case_dir / "expected-files")
-            actual = work / relative
-            if not actual.is_file():
-                raise Failure(f"missing output file: {relative}")
-            compare(expected.read_bytes(), actual.read_bytes(), str(relative))
-
-
-def main(argv=None):
-    parser = argparse.ArgumentParser(description=__doc__)
-    parser.add_argument("--case", required=True, type=Path)
-    parser.add_argument("--cpsc", required=True, type=Path)
-    parser.add_argument("--run-mode", choices=["EMBEDDED", "PATH", "NONE"], required=True)
-    parser.add_argument("--reference", type=Path)
-    parser.add_argument("--perl", default="perl")
-    parser.add_argument("--seed", default="")
-    parser.add_argument("--count", type=int, default=10000)
-    parser.add_argument("--results", type=Path, default=ROOT / "build/test-results")
-    args = parser.parse_args(argv)
-    if args.count < 1:
-        parser.error("--count must be positive")
-    args.case = args.case.resolve()
-    args.cpsc = args.cpsc.resolve()
-    if args.reference:
-        args.reference = args.reference.resolve()
-    case_dir = args.case.parent
-    suite, name = case_dir.parent.name, case_dir.name
-    config = json.loads(args.case.read_text(encoding="utf-8"))
-    commit = subprocess.check_output(["git", "rev-parse", "HEAD"], cwd=ROOT,
-                                     text=True, timeout=10).strip()
-    seed = args.seed or commit
-    directory = args.results.resolve() / suite / name
-    if directory.exists():
-        shutil.rmtree(directory)
-    directory.mkdir(parents=True)
-    commands = Commands(directory)
-    report = {"case": f"{suite}/{name}", "commit": commit, "seed": seed,
-              "random_count": args.count, "platform": platform.platform(),
-              "run_mode": args.run_mode, "failures": []}
-    source = case_dir / "program.cps"
-
-    def attempt(label, action):
-        try:
-            action()
-            print(f"PASS {suite}/{name} [{label}]", flush=True)
-        except (Failure, OSError, ValueError) as error:
-            report["failures"].append({"stage": label, "message": str(error)})
-            print(f"FAIL {suite}/{name} [{label}]: {error}", flush=True)
-
-    def diagnostics():
-        for output_format in ["native", "ir"]:
-            work = workspace(case_dir, directory, output_format)
-            target = work / ("program.exe" if os.name == "nt" else "program.bin")
-            flags = ["-S"] if output_format == "ir" else []
-            for existing in [False, True]:
-                sentinel = b"existing output must survive\n"
-                if existing:
-                    target.write_bytes(sentinel)
-                result = commands.run([args.cpsc, source, *flags, "-o", target], work,
-                                      timeout=120)
-                # Check output preservation even when the diagnostics are wrong.
-                preservation_error = None
-                if existing and (not target.exists() or target.read_bytes() != sentinel):
-                    preservation_error = "compilation failure overwrote existing output"
-                if not existing and target.exists():
-                    preservation_error = "compilation failure created output"
-                    target.unlink()
-                def validate():
-                    if preservation_error:
-                        raise Failure(preservation_error)
-                    check_diagnostics(result, config["errors"])
-                attempt(f"{output_format}/{'existing' if existing else 'absent'}", validate)
-
-    try:
-        if suite == "iii":
-            diagnostics()
-        else:
-            data = (case_dir / "input.txt").read_bytes() if (case_dir / "input.txt").exists() else b""
-            if suite == "ii":
-                if not args.reference:
-                    raise Failure("differential tests require --reference")
-                generated = commands.run([args.perl, case_dir / "generate.pl", seed,
-                                          str(args.count)], directory)
-                if generated.returncode != 0 or generated.stderr:
-                    raise Failure(f"generator failed: {generated.stderr!r}")
-                data = generated.stdout
-                records = normalized(data).splitlines()
-                if not records or int(records[0]) != len(records) - 1:
-                    raise Failure("generator must emit record count followed by one record per line")
-                work = workspace(case_dir, directory, "reference")
-                reference = commands.run([args.reference], work, data,
-                                         timeout=config.get("timeout", 30))
-                if reference.returncode != 0 or reference.stderr:
-                    raise Failure(f"reference failed ({reference.returncode}): {reference.stderr!r}")
-                expected = reference.stdout
-                if len(normalized(expected).splitlines()) != len(records) - 1:
-                    raise Failure("reference must emit exactly one output line per input record")
-            else:
-                expected = (case_dir / "expected.txt").read_bytes()
-            (directory / "input.txt").write_bytes(data)
-            (directory / "expected.txt").write_bytes(expected)
-
-            def execute(mode):
-                work = workspace(case_dir, directory, mode)
-                if mode == "native":
-                    target = work / ("program.exe" if os.name == "nt" else "program.bin")
-                    compiled = commands.run([args.cpsc, source, "-o", target], work, timeout=120)
-                    check_result(compiled, b"")
-                    command = [target]
-                else:
-                    command = [args.cpsc, source, "-r"]
-                result = commands.run(command, work, data, timeout=config.get("timeout", 30))
-                if suite == "ii" and normalized(result.stdout) != normalized(expected):
-                    wanted, got = normalized(expected).splitlines(), normalized(result.stdout).splitlines()
-                    index = next((i for i in range(min(len(wanted), len(got)))
-                                  if wanted[i] != got[i]), min(len(wanted), len(got)))
-                    record = records[index + 1] if index + 1 < len(records) else b"<extra output>"
-                    print(f"First differing record {index + 1}: {record!r}", flush=True)
-                    (directory / f"{mode}-first-difference.json").write_text(json.dumps({
-                        "record": index + 1, "input": record.decode("ascii"),
-                        "expected": repr(wanted[index]) if index < len(wanted) else "<missing>",
-                        "actual": repr(got[index]) if index < len(got) else "<missing>"}, indent=2) + "\n",
-                        encoding="utf-8")
-                check_result(result, expected, config.get("exit_code", 0))
-                check_files(case_dir, work)
-            for mode in ["native"] + (["runner"] if args.run_mode != "NONE" else []):
-                attempt(mode, lambda mode=mode: execute(mode))
-    except (Failure, OSError, ValueError) as error:
-        report["failures"].append({"stage": "setup", "message": str(error)})
-        print(f"FAIL {suite}/{name} [setup]: {error}", flush=True)
-    report["passed"] = not report["failures"]
-    (directory / "result.json").write_text(json.dumps(report, indent=2) + "\n", encoding="utf-8")
-    print(f"Seed: {seed}; results: {directory}", flush=True)
-    return 0 if report["passed"] else 1
-
-
-if __name__ == "__main__":
-    sys.exit(main())