view release on metacpan or  search on metacpan

t/SchemaExtractor.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;

# use Test::DescribeMe qw(extended);
use Test::Most;
use File::Temp qw(tempdir tempfile);
use File::Spec;
use Readonly;

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

# --------------------------------------------------
# Constants used across subtests to avoid magic
# literals and to make boundary intent explicit
# --------------------------------------------------
Readonly my $EMPTY_STRING => '';
Readonly my $NONEXISTENT  => '/no/such/file.pm';

# --------------------------------------------------
# Helper: create a temporary .pm file containing
# the given Perl source and return its path.
# Opens with UTF-8 encoding to avoid wide-character
# warnings when the source contains Unicode.
# --------------------------------------------------
sub _write_pm {
	my ($source) = @_;
	my ($fh, $path) = tempfile(SUFFIX => '.pm', UNLINK => 1);
	# Use UTF-8 encoding so Unicode in source strings does not warn
	binmode $fh, ':encoding(UTF-8)';
	print $fh $source;
	close $fh;
	return $path;
}

# --------------------------------------------------
# Helper: construct a minimal SchemaExtractor
# pointing at a real (possibly empty) temp file.
# Accepts additional constructor options via %opts.
# --------------------------------------------------
sub _extractor {
	my ($source, %opts) = @_;
	my $path = _write_pm($source // "package Tmp;\n1;\n");
	return App::Test::Generator::SchemaExtractor->new(
		input_file => $path,
		%opts,
	);
}

# ==================================================================
# new
# --------------------------------------------------
# Tests for the constructor -- input validation and
# blessed object structure
# ==================================================================
subtest 'new' => sub {
	# Missing input_file must croak -- the actual message comes from
	# Params::Get which validates the required key first
	throws_ok {
		App::Test::Generator::SchemaExtractor->new()
	} qr/input_file/, 'missing input_file croaks';

	# Non-existent file must croak with a clear message
	throws_ok {
		App::Test::Generator::SchemaExtractor->new(input_file => $NONEXISTENT)
	} qr/does not exist/, 'non-existent file croaks';

	# Valid file returns a blessed object of the correct class
	my $e = _extractor("package Foo;\n1;\n");
	ok(defined $e, 'valid file returns object');
	isa_ok($e, 'App::Test::Generator::SchemaExtractor');

	# Default values are set correctly on the constructed object
	is($e->{verbose},         0, 'verbose defaults to 0');
	is($e->{include_private}, 0, 'include_private defaults to 0');
	ok($e->{confidence_threshold} > 0, 'confidence_threshold has a positive default');
	ok($e->{max_parameters}  > 0,      'max_parameters has a positive default');

	# strict_pod defaults to 0 (off)
	is($e->{strict_pod}, 0, 'strict_pod defaults to 0');

	# strict_pod accepts the string 'warn' and normalises to 1
	my $e2 = _extractor("package Foo;\n1;\n", strict_pod => 'warn');
	is($e2->{strict_pod}, 1, "strict_pod 'warn' normalised to 1");

	# strict_pod accepts the string 'fatal' and normalises to 2
	my $e3 = _extractor("package Foo;\n1;\n", strict_pod => 'fatal');
	is($e3->{strict_pod}, 2, "strict_pod 'fatal' normalised to 2");

	done_testing();