view release on metacpan or  search on metacpan

t/app.t  view on Meta::CPAN

#!/usr/bin/env perl
use strict;
use warnings;

# Self-test: run every ATG .pm file through SchemaExtractor (strict_pod=fatal),
# generate a fuzz harness for each extracted schema, and prove it.
# Temp dirs are kept on failure for diagnosis.

use Test::DescribeMe qw(extended);
use Test::Most;
use Capture::Tiny qw(capture);
use File::Find;
use File::Path qw(rmtree);
use File::Spec;
use File::Temp ();
use FindBin qw($Bin);
use YAML::XS qw(LoadFile DumpFile);

use constant PROVE_TIMEOUT => 0;	# seconds per module before killing prove

my $VERBOSE = $ENV{TEST_VERBOSE} // 0;

BEGIN {
	use_ok('App::Test::Generator::SchemaExtractor');
	use_ok('App::Test::Generator');
}

# Collect all .pm files under lib/.
# no_chdir avoids File::Find calling chdir() with tainted directory names,
# which would die under prove -t (taint mode).
my $lib_dir = File::Spec->catdir($Bin, '..', 'lib');
my @pm_files;
find(
	{ wanted => sub { push @pm_files, $File::Find::name if /\.pm$/ },
	  no_chdir => 1 },
	$lib_dir
);

diag(scalar(@pm_files) . ' .pm files to self-test') if $VERBOSE;

for my $pm_file (sort @pm_files) {
	subtest "self-test: $pm_file" => sub {

		# Never auto-clean: we keep the dir if anything fails so the user
		# can inspect the intermediate schema YAML and generated .t files.
		my $tmpdir = File::Temp::tempdir(CLEANUP => 0);
		my $failed = 0;

		# ── Step 1: extract schemas ──────────────────────────────────────
		diag("step 1: extracting schemas from $pm_file") if $VERBOSE;
		my $t0 = time;

		my $extractor = App::Test::Generator::SchemaExtractor->new(
			input_file => $pm_file,
			output_dir => $tmpdir,
			strict_pod => 'fatal',
			verbose    => 0,
		);

		my $schemas;
		eval { $schemas = $extractor->extract_all() };
		if ($@) {
			fail("SchemaExtractor died for $pm_file");
			diag($@);
			diag("Diagnostics kept in: $tmpdir");
			done_testing();
			return;
		}

		if (!$schemas || !keys %$schemas) {
			pass("no methods extracted from $pm_file");
			rmtree($tmpdir);
			done_testing();
			return;
		}

		my $n_schemas = scalar keys %$schemas;
		diag(sprintf('step 1 done in %ds: %d schemas extracted (%s)',
			time - $t0, $n_schemas, join(', ', sort keys %$schemas))) if $VERBOSE;

		pass('SchemaExtractor completed without error');

		# ── Step 2: generate a fuzz harness for each schema ──────────────
		diag("step 2: generating fuzz harnesses") if $VERBOSE;
		$t0 = time;

		# Functions that require real file-system inputs can't be meaningfully
		# fuzz-tested: the harness would supply random strings as file paths and
		# every call would die with "file not found". Syntax-check these files
		# (step 3a) but skip them in the prove run (step 3b).