view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;

use Test::Most;
use File::Temp qw(tempdir tempfile);
use File::Spec;
use Readonly;
use Scalar::Util qw(looks_like_number);

# Allow access to private helpers via the package namespace
BEGIN {
	use_ok('App::Test::Generator');
	use_ok('App::Test::Generator::Mutator');
	use_ok('App::Test::Generator::Mutant');
}

# --------------------------------------------------
# Constants used across multiple subtests to avoid
# magic literals and make intent clear
# --------------------------------------------------
Readonly my $EMPTY_STRING  => '';
Readonly my $UNDEF_LITERAL => 'undef';

# ==================================================================
# perl_sq
# --------------------------------------------------
# White-box tests for the low-level single-quote
# string escaper used by perl_quote and q_wrap
# ==================================================================
subtest 'perl_sq' => sub {
	# Access the private function directly via the package namespace
	my $fn = \&App::Test::Generator::perl_sq;

	# Undef input returns empty string, not 'undef'
	is($fn->(undef), $EMPTY_STRING, 'undef returns empty string');

	# Plain ASCII string passes through unchanged
	is($fn->('hello'), 'hello', 'plain ASCII unchanged');

	# Apostrophe must be escaped so it does not break the surrounding
	# single-quoted string literal in the generated test
	is($fn->("it's"), "it\\'s", 'apostrophe escaped');

	# Backslash must be escaped first so later substitutions
	# do not double-escape already-escaped sequences
	is($fn->('a\\b'), 'a\\\\b', 'backslash escaped');

	# Control characters are converted to their two-char sequences
	is($fn->("a\nb"), 'a\\nb', 'newline escaped');
	is($fn->("a\rb"), 'a\\rb', 'carriage return escaped');
	is($fn->("a\tb"), 'a\\tb', 'tab escaped');
	is($fn->("a\fb"), 'a\\fb', 'form feed escaped');

	# NUL byte is converted to \0 for double-quoted context
	is($fn->("a\0b"), 'a\\0b', 'NUL byte escaped');

	# Both apostrophe and backslash in the same string
	is($fn->("a\\'b"), "a\\\\\\'b", 'backslash and apostrophe together');

	done_testing();
};

# ==================================================================
# perl_quote
# --------------------------------------------------
# Tests for the top-level value quoter that produces
# Perl source-code literals for any scalar type
# ==================================================================
subtest 'perl_quote' => sub {
	my $fn = \&App::Test::Generator::perl_quote;

	# Undef always produces the bare word 'undef'
	is($fn->(undef), $UNDEF_LITERAL, 'undef produces undef literal');

	# YAML boolean strings must round-trip to Perl boolean constants
	is($fn->('true'),  '!!1', 'true produces !!1');
	is($fn->('false'), '!!0', 'false produces !!0');

	# Integers are emitted unquoted for numeric comparison
	is($fn->(0),   '0',   'zero unquoted');
	is($fn->(42),  '42',  'positive integer unquoted');
	is($fn->(-1),  '-1',  'negative integer unquoted');

	# Floats are emitted unquoted
	is($fn->(3.14), '3.14', 'float unquoted');

	# Plain strings are single-quoted
	is($fn->('hello'), "'hello'", 'string single-quoted');

	# Strings containing apostrophes have them escaped
	is($fn->("it's"), "'it\\'s'", 'apostrophe in string escaped');

	# Arrayrefs are recursively quoted with brackets
	is($fn->([1, 2, 3]), '[ 1, 2, 3 ]', 'arrayref recursively quoted');

	# Nested arrayrefs recurse correctly
	is($fn->([1, [2, 3]]), '[ 1, [ 2, 3 ] ]', 'nested arrayref quoted');

	# Arrayref containing undef produces undef literal in the output
	is($fn->([undef, 1]), "[ $UNDEF_LITERAL, 1 ]", 'arrayref with undef element');

	# Regexp objects are rendered as qr{} with modifiers
	my $re = qr/foo/i;
	like($fn->($re), qr/qr\{foo\}i/, 'Regexp rendered as qr{}');

	# Regexp without modifiers has no trailing flags
	my $re2 = qr/bar/;
	like($fn->($re2), qr/qr\{bar\}/, 'Regexp without modifiers');

	done_testing();
};

# ==================================================================
# q_wrap
# --------------------------------------------------
# Tests for the string wrapper that chooses the most
# readable q{} delimiter form
# ==================================================================
subtest 'q_wrap' => sub {
	my $fn = \&App::Test::Generator::q_wrap;

	# Undef returns empty single-quoted string — q_wrap is a
	# string quoter, not a value serialiser, so undef means
	# no string value rather than the Perl literal 'undef'
	is($fn->(undef), "''", 'undef returns empty single-quoted string');

	# Plain string uses the preferred q{} bracket form
	is($fn->('hello'), 'q{hello}', 'plain string uses q{}');

	# String containing { forces a different bracket pair
	my $with_brace = 'a{b';
	unlike($fn->($with_brace), qr/^q\{/, 'string with { avoids q{}');

	# String containing all bracket pairs falls back to single chars
	my $all_brackets = '{([<>])}';
	my $result = $fn->($all_brackets);
	like($result, qr/^q./, 'all-bracket string still uses q form');

	# Empty string produces empty q form
	is($fn->($EMPTY_STRING), 'q{}', 'empty string produces q{}');

	# String with apostrophe — q_wrap avoids needing to escape it
	# by choosing a delimiter that is not an apostrophe
	my $apos = "it's";
	my $wrapped = $fn->($apos);
	unlike($wrapped, qr/\\'/, 'apostrophe not escaped in q_wrap output');

	done_testing();
};

# ==================================================================
# render_fallback
# --------------------------------------------------
# Tests for the Data::Dumper-based catch-all renderer
# ==================================================================
subtest 'render_fallback' => sub {
	my $fn = \&App::Test::Generator::render_fallback;

	# Undef produces the literal string 'undef'
	is($fn->(undef), $UNDEF_LITERAL, 'undef produces undef literal');

	# Integer scalars pass through Dumper in terse mode
	my $scalar_result = $fn->(42);
	is($scalar_result, '42', 'integer scalar');

	# Hashrefs are rendered as Perl hash literals with braces
	my $hash_result = $fn->({ a => 1 });
	like($hash_result, qr/\{/, 'hashref renders with braces');
	like($hash_result, qr/'a'/, 'hashref key present');

	# No trailing newline — Dumper adds one and we strip it
	unlike($fn->({ a => 1 }), qr/\n$/, 'no trailing newline');

	# Arrayrefs render with square brackets
	my $arr_result = $fn->([1, 2]);
	like($arr_result, qr/\[/, 'arrayref renders with brackets');

	done_testing();
};

# ==================================================================
# render_args_hash
# --------------------------------------------------
# Tests for the flat hashref renderer used for output
# specs and constructor argument lists
# ==================================================================
subtest 'render_args_hash' => sub {
	my $fn = \&App::Test::Generator::render_args_hash;

	# Undef input returns empty string
	is($fn->(undef), $EMPTY_STRING, 'undef returns empty string');

	# Non-hash input returns empty string
	is($fn->([1, 2]), $EMPTY_STRING, 'arrayref returns empty string');

	# Empty hash returns empty string
	is($fn->({}), $EMPTY_STRING, 'empty hash returns empty string');

	# Single key-value pair is rendered correctly
	my $result = $fn->({ type => 'string' });
	like($result, qr/'type'\s*=>\s*'string'/, 'single key rendered');

	# Multiple keys are sorted alphabetically for deterministic output
	my $multi = $fn->({ b => 2, a => 1 });
	my $a_pos = index($multi, "'a'");
	my $b_pos = index($multi, "'b'");