view release on metacpan or  search on metacpan

t/40-more.t  view on Meta::CPAN

# Test config boolean value processing
subtest 'config boolean processing' => sub {
	my $bool_conf = File::Spec->catfile($dir, 'bool_config.yml');
	my $bool_t = File::Spec->catfile($dir, 'bool_config.t');

	write_yaml($bool_conf, {
		module => 'Test::Most',
		function => 'test',
		input => { test => { type => 'string' } },
		output => { type => 'string' },
		config => {
			test_nuls => 'off',
			test_undef => 'no',
			test_empty => 'false',
			dedup => 'on'
		}
	});

	App::Test::Generator->generate($bool_conf, $bool_t);

	# Verify the generated test has correct boolean values
	my $content = slurp($bool_t);
	like($content, qr/'test_nuls' => 0/, 'should convert "off" to 0');
	like($content, qr/'test_undef' => 0/, 'should convert "no" to 0');
	like($content, qr/'test_empty' => 0/, 'should convert "false" to 0');
	like($content, qr/'dedup' => 1/, 'should convert "on" to 1');

	unlink $bool_conf, $bool_t;
};

# Test module name guessing from filename
subtest 'module name guessing' => sub {
	my $guess_conf = File::Spec->catfile($dir, 'My-Test-Module.yml');

	write_yaml($guess_conf, {
		function => 'test',
		input => { test => { type => 'string' } },
		output => { type => 'string' }
		# No module specified - should guess from filename
	});

	pass('TODO When Legacy Files Removed');
	# App::Test::Generator->generate($guess_conf, 't/guess_test.t');

	# my $content = slurp('t/guess_test.t');
	# like($content, qr/My::Test::Module/, 'should guess module name from filename');

	# unlink $guess_conf, 't/guess_test.t';
	unlink $guess_conf;
};

# Test YAML corpus validation
subtest 'YAML corpus validation' => sub {
	my $corpus_conf = File::Spec->catfile($dir, 'corpus_test.yml');
	my $corpus_t = File::Spec->catfile($dir, 'corpus_test.t');
	my $bad_corpus = File::Spec->catfile($dir, 'bad_corpus.yml');

	# Create invalid YAML corpus (non-array values)
	write_yaml($bad_corpus, {
		'expected1' => 'not_an_array',  # Invalid - should be array
		'expected2' => { hash => 'value' }  # Invalid - should be array
	});

	write_yaml($corpus_conf, {
		module => 'Test::Most',
		function => 'test',
		input => { test => { type => 'string' } },
		output => { type => 'string' },
		yaml_cases => $bad_corpus
	});

	# Capture warnings about invalid corpus
	my @warnings;
	local $SIG{__WARN__} = sub { push @warnings, @_ };

	App::Test::Generator->generate($corpus_conf, $corpus_t);

	like($warnings[0], qr/does not point to an array ref/,
		'should warn about invalid YAML corpus entries');

	unlink $corpus_conf, $bad_corpus, $corpus_t;
};

# Test case merging between YAML and Perl cases
subtest 'case merging' => sub {
	my $merge_conf = File::Spec->catfile($dir, 'merge_test.yml');
	my $merge_t = File::Spec->catfile($dir, 'merge_test.t');
	my $yaml_corpus = File::Spec->catfile($dir, 'merge_corpus.yml');

	# Create YAML corpus
	write_yaml($yaml_corpus, {
		'yaml_only' => ['yaml_input'],
		'shared_key' => ['yaml_value']
	});

	write_yaml($merge_conf, {
		module => 'Test::Most',
		function => 'test',
		input => { test => { type => 'string' } },
		output => { type => 'string' },
		yaml_cases => $yaml_corpus,
		cases => {
			'perl_only' => ['perl_input'],
			'shared_key' => ['perl_value']
		}
	});

	App::Test::Generator->generate($merge_conf, $merge_t);

	my $content = slurp($merge_t);
	# Should contain both YAML and Perl cases
	like($content, qr/yaml_only/, 'should include YAML-only cases');
	like($content, qr/perl_only/, 'should include Perl-only cases');
	like($content, qr/shared_key/, 'should handle shared keys');

	unlink $merge_conf, $yaml_corpus, $merge_t;
};

# Test empty new configuration
subtest 'empty new configuration' => sub {