view release on metacpan or  search on metacpan

t/Generator.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;

use Capture::Tiny qw(capture);
use File::Temp qw(tempfile);
use Test::Most;

# White-box function-level tests for App::Test::Generator.
# Tests each function as a standalone unit.

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

# ------------------------------------------------------------------
# Import private functions under test via symbol table manipulation
# ------------------------------------------------------------------
{
	no warnings 'once';
	*_load_schema		  = \&App::Test::Generator::_load_schema;
	*_load_schema_section  = \&App::Test::Generator::_load_schema_section;
	*_validate_config	  = \&App::Test::Generator::_validate_config;
	*_validate_input_params	= \&App::Test::Generator::_validate_input_params;
	*_validate_input_positions = \&App::Test::Generator::_validate_input_positions;
	*_validate_input_semantics = \&App::Test::Generator::_validate_input_semantics;
	*_normalize_config	 = \&App::Test::Generator::_normalize_config;
	*_valid_type		   = \&App::Test::Generator::_valid_type;
	*_has_positions		= \&App::Test::Generator::_has_positions;
	*_is_numeric_transform = \&App::Test::Generator::_is_numeric_transform;
	*_is_string_transform  = \&App::Test::Generator::_is_string_transform;
	*_same_type			= \&App::Test::Generator::_same_type;
	*_get_dominant_type	= \&App::Test::Generator::_get_dominant_type;
	*_detect_transform_properties = \&App::Test::Generator::_detect_transform_properties;
	*_render_properties	= \&App::Test::Generator::_render_properties;
	*_schema_to_lectrotest_generator = \&App::Test::Generator::_schema_to_lectrotest_generator;
	*_get_semantic_generators = \&App::Test::Generator::_get_semantic_generators;
	*_get_builtin_properties  = \&App::Test::Generator::_get_builtin_properties;
	*_is_perl_builtin = \&App::Test::Generator::_is_perl_builtin;
}

# ------------------------------------------------------------------
# perl_sq — escape a string for single-quoted Perl string context
# ------------------------------------------------------------------
subtest 'perl_sq() returns empty string for undef' => sub {
	is(App::Test::Generator::perl_sq(undef), '', 'undef produces empty string');
};

subtest 'perl_sq() escapes backslashes first' => sub {
	is(App::Test::Generator::perl_sq('a\\b'), 'a\\\\b', 'backslash doubled');
};

subtest 'perl_sq() escapes apostrophes' => sub {
	is(App::Test::Generator::perl_sq("it's"), "it\\'s", 'apostrophe escaped');
};

subtest 'perl_sq() escapes common control characters' => sub {
	is(App::Test::Generator::perl_sq("a\nb"), 'a\\nb', 'newline escaped');
	is(App::Test::Generator::perl_sq("a\rb"), 'a\\rb', 'CR escaped');
	is(App::Test::Generator::perl_sq("a\tb"), 'a\\tb', 'tab escaped');
	is(App::Test::Generator::perl_sq("a\fb"), 'a\\fb', 'formfeed escaped');
};

subtest 'perl_sq() replaces NUL bytes' => sub {
	is(App::Test::Generator::perl_sq("a\0b"), 'a\\0b', 'NUL replaced with \\0');
};

subtest 'perl_sq() leaves plain string unchanged' => sub {
	is(App::Test::Generator::perl_sq('hello'), 'hello', 'plain string unchanged');
};

# ------------------------------------------------------------------
# perl_quote — convert a Perl value to source-code fragment
# ------------------------------------------------------------------
subtest 'perl_quote() returns undef literal for undef' => sub {
	is(App::Test::Generator::perl_quote(undef), 'undef', 'undef -> "undef"');
};

subtest 'perl_quote() converts true/false string booleans' => sub {
	is(App::Test::Generator::perl_quote('true'),  '!!1', '"true" -> "!!1"');
	is(App::Test::Generator::perl_quote('false'), '!!0', '"false" -> "!!0"');
};

subtest 'perl_quote() leaves numbers unquoted' => sub {
	is(App::Test::Generator::perl_quote(42),	'42',   'integer unquoted');
	is(App::Test::Generator::perl_quote(3.14),  '3.14', 'float unquoted');
	is(App::Test::Generator::perl_quote(-1),	'-1',   'negative unquoted');
	is(App::Test::Generator::perl_quote(0),	 '0',	'zero unquoted');
};

subtest 'perl_quote() single-quotes strings' => sub {
	is(App::Test::Generator::perl_quote('hello'), "'hello'", 'plain string quoted');
	is(App::Test::Generator::perl_quote(''),	  "''",	  'empty string quoted');
};

subtest 'perl_quote() recursively quotes arrayrefs' => sub {
	my $result = App::Test::Generator::perl_quote([1, 'a', undef]);
	like($result, qr/^\[/, 'starts with [');
	like($result, qr/1/,   'contains 1');
	like($result, qr/'a'/, 'contains "a"');
	like($result, qr/undef/, 'contains undef');
};

subtest 'perl_quote() renders Regexp objects as qr{}' => sub {
	my $re = qr/foo/i;
	my $result = App::Test::Generator::perl_quote($re);
	like($result, qr/^qr\{/, 'starts with qr{');
	like($result, qr/foo/,   'contains pattern');
	like($result, qr/i/,	 'contains modifier');
};

# ------------------------------------------------------------------
# q_wrap — wrap a string in the most readable q{} form
# ------------------------------------------------------------------
subtest "q_wrap() returns '' for undef" => sub {
	is(App::Test::Generator::q_wrap(undef), "''", 'undef -> empty single-quoted string');
};

subtest 'q_wrap() uses q{} bracket form when no brackets in string' => sub {
	my $result = App::Test::Generator::q_wrap('hello world');
	like($result, qr/^q\{hello world\}$/, 'uses q{} form');
};

subtest 'q_wrap() falls back when curly braces in string' => sub {
	my $result = App::Test::Generator::q_wrap('a{b}c');
	# Should use a different delimiter
	unlike($result, qr/^q\{a\{b\}c\}$/, 'does not use q{} when string contains {}');
	ok(length($result) > 0, 'returns non-empty result');
};

subtest 'q_wrap() uses single-quote fallback when all delimiters used' => sub {
	# A string containing all bracket pairs AND all single-char delimiters
	# forces the escaped single-quote fallback
	my $str = '{}()[]<>~!%^=+:,;|/#';
	my $result = App::Test::Generator::q_wrap($str);
	ok(defined $result, 'returns defined value for pathological string');
};

subtest 'q_wrap() correctly uses != INDEX_NOT_FOUND boundary' => sub {
	# A string starting with ~ means index returns 0 (not -1)
	# If the guard were "> 0" instead of "!= -1" it would wrongly
	# choose ~ as the delimiter when ~ is at position 0
	my $result = App::Test::Generator::q_wrap('~starts with tilde');
	unlike($result, qr/^q~/, 'does not use ~ when ~ is at start of string');
};

# ------------------------------------------------------------------
# render_fallback — convert any value to a Perl source string
# ------------------------------------------------------------------
subtest 'render_fallback() returns "undef" for undef' => sub {
	is(App::Test::Generator::render_fallback(undef), 'undef', 'undef -> "undef"');
};

subtest 'render_fallback() returns compact string for scalar' => sub {
	my $result = App::Test::Generator::render_fallback('hello');
	like($result, qr/hello/, 'scalar string rendered');
	unlike($result, qr/\n$/, 'no trailing newline');
};

subtest 'render_fallback() renders hashref' => sub {
	my $result = App::Test::Generator::render_fallback({ a => 1 });
	like($result, qr/a/, 'hashref rendered with key');
	like($result, qr/1/, 'hashref rendered with value');
};

# ------------------------------------------------------------------
# render_args_hash — flat hashref to key => value argument string
# ------------------------------------------------------------------
subtest 'render_args_hash() returns empty string for undef' => sub {
	is(App::Test::Generator::render_args_hash(undef), '', 'undef -> empty string');
};

subtest 'render_args_hash() returns empty string for empty hashref' => sub {
	is(App::Test::Generator::render_args_hash({}), '', 'empty hash -> empty string');
};

subtest 'render_args_hash() renders flat hash sorted by key' => sub {
	my $result = App::Test::Generator::render_args_hash({ b => 2, a => 1 });
	like($result, qr/'a'\s*=>\s*1/, 'key a rendered');
	like($result, qr/'b'\s*=>\s*2/, 'key b rendered');
	# a must appear before b (sorted)
	ok(index($result, "'a'") < index($result, "'b'"), 'keys sorted alphabetically');
};

# ------------------------------------------------------------------
# render_arrayref_map — hashref of arrayrefs to Perl source
# ------------------------------------------------------------------
subtest 'render_arrayref_map() returns "()" for undef' => sub {
	is(App::Test::Generator::render_arrayref_map(undef), '()', 'undef -> "()"');
};

subtest 'render_arrayref_map() returns empty string for empty hashref' => sub {
	is(App::Test::Generator::render_arrayref_map({}), '', 'empty hash -> empty string');