view release on metacpan or  search on metacpan

utils/create_gold  view on Meta::CPAN

#!/usr/bin/perl

# Copyright 2002-2026, Paul Johnson (paul@pjcj.net)

# This software is free.  It is licensed under the same terms as Perl itself.

# The latest version of this software should be available from my homepage:
# https://pjcj.net

use 5.20.0;
use warnings;

# VERSION

use feature "signatures";
no warnings "experimental::signatures";

use blib;
use Config             qw( %Config );
use Devel::Cover::Test ();

sub get_tests_from_dir {
  my @tests;
  opendir my $dh, "tests" or die "Cannot opendir tests: $!";
  for my $t (sort readdir $dh) {
    next unless -f "tests/$t";
    next if $t =~ /\.(pm|pl|uncoverable|version|org|bak|swp)$/;
    next if $t =~ /~$/;
    push @tests, $t;
  }
  closedir $dh or die "Cannot closedir tests: $!";
  @tests
}

sub run_test_in_child ($test) {
  my $e    = "t/e2e";
  my $file = (grep -e, "$e/$test", "$e/a$test.t")[0] // $test;
  say "creating golden results for $test: ";
  my $pid = fork // die "Can't fork";
  if ($pid) {
    waitpid $pid, 0;
  } else {
    no warnings "redefine";
    local *Devel::Cover::Test::run_test = sub { };
    my $t = require "./$file" or die "Can't require $file: $!";
    $t->create_gold and say "";
    exit;
  }
}

sub main {
  if ($Config{useithreads}) {
    say "useithreads true, exiting";
    return;
  }

  mkdir "test_output"       unless -d "test_output";
  mkdir "test_output/cover" unless -d "test_output/cover";

  my @tests = @ARGV;
  @tests = get_tests_from_dir unless @tests;
  run_test_in_child($_) for @tests;
}

main