From 6b90cec14aa90cb9e840aa0ca659078a0c2615a5 Mon Sep 17 00:00:00 2001 From: _ov4 Date: Fri, 16 Oct 2026 17:47:05 +0000 Subject: test(harness): port check_generators to Perl Co-Authored-By: Claude Fable 5.1 --- tests/check_generators.pl | 87 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) create mode 100644 tests/check_generators.pl (limited to 'tests/check_generators.pl') diff --git a/tests/check_generators.pl b/tests/check_generators.pl new file mode 100644 index 0000000..731215b --- /dev/null +++ b/tests/check_generators.pl @@ -0,0 +1,87 @@ +#!/usr/bin/env perl +# Require identical generated input bytes across platforms and Perl versions. +use strict; +use warnings; +use Digest::SHA qw(sha256_hex); +use File::Spec; +use File::Temp (); +use FindBin; +use JSON::PP (); + +die "usage: $0 \n" unless @ARGV == 1; +my ($perl) = @ARGV; + +my $dir = File::Spec->catdir($FindBin::Bin, 'ii'); +my $vectors_path = File::Spec->catfile($dir, 'generator-vectors.json'); +open my $fh, '<:raw', $vectors_path or die "cannot read $vectors_path: $!\n"; +my $vectors_text = do { local $/; <$fh> }; +close $fh; +my $vectors = JSON::PP->new->decode($vectors_text); + +for my $name (sort keys %{$vectors}) { + my $digest = $vectors->{$name}; + my $generate = File::Spec->catfile($dir, $name, 'generate.pl'); + my @outputs; + for my $seed (('0' x 40, '0' x 40, '1' x 40)) { + my ($exit, $out, $err) = run_capture($perl, $generate, $seed, '100'); + die "$name: generator exited with $exit\n" if $exit != 0; + if (length $err) { + die "$name: unexpected stderr " . display($err) . "\n"; + } + push @outputs, $out; + } + if ($outputs[0] ne $outputs[1] || $outputs[0] eq $outputs[2]) { + die "$name: seed reproducibility failed\n"; + } + if (sha256_hex($outputs[0]) ne $digest) { + die "$name: generated input differs from the portable test vector\n"; + } + print "PASS $name: repeatable, seed-sensitive, portable bytes\n"; +} + +sub run_capture { + my (@command) = @_; + my $out_fh = File::Temp->new(UNLINK => 1); + my $err_fh = File::Temp->new(UNLINK => 1); + my $out_path = $out_fh->filename; + my $err_path = $err_fh->filename; + close $out_fh; + close $err_fh; + my $pid = fork(); + die "cannot fork: $!\n" unless defined $pid; + if ($pid == 0) { + open STDOUT, '>', $out_path or exit 127; + open STDERR, '>', $err_path or exit 127; + binmode STDOUT; + binmode STDERR; + exec { $command[0] } @command; + exit 127; + } + my $timed_out = 0; + local $SIG{ALRM} = sub { $timed_out = 1; kill 'KILL', $pid; }; + alarm 10; + waitpid($pid, 0); + alarm 0; + if ($timed_out) { + waitpid($pid, 0); + die "generator timed out after 10s: @command\n"; + } + my $status = $?; + open my $out_in, '<:raw', $out_path or die "cannot read $out_path: $!\n"; + my $out = do { local $/; <$out_in> }; + close $out_in; + open my $err_in, '<:raw', $err_path or die "cannot read $err_path: $!\n"; + my $err = do { local $/; <$err_in> }; + close $err_in; + $out = '' unless defined $out; + $err = '' unless defined $err; + my $exit = ($status >> 8); + return ($exit, $out, $err); +} + +sub display { + my ($bytes) = @_; + $bytes =~ s/([^ -~\n])/sprintf('\\x{%02x}', ord($1))/ge; + $bytes =~ s/\n/\\n/g; + return "'$bytes'"; +} -- cgit v1.3.1-4-g156e