view release on metacpan or  search on metacpan

t/Generator.t  view on Meta::CPAN

	require File::Temp;
	my $schema = File::Temp->new(SUFFIX => '.yml', UNLINK => 1);
	print $schema "module: builtin\nfunction: my_func\ninput:\n  type: string\noutput:\n  type: string\n";
	$schema->flush();

	my $outfile = File::Temp->new(SUFFIX => '.t', UNLINK => 1);
	my $outpath  = $outfile->filename();
	$outfile->close();

	my (undef, $stderr) = capture(sub {
		App::Test::Generator->generate(
			schema_file => $schema->filename(),
			output_file => $outpath,
		)
	});

	ok(-f $outpath && -s $outpath, 'output file created and non-empty');
};

subtest 'generate() croaks when called with no arguments' => sub {
	throws_ok(
		sub { App::Test::Generator->generate() },
		qr/Usage/,
		'no-arg generate() croaks with Usage',
	);
};

# ==================================================================
# _is_perl_builtin
# ==================================================================

subtest '_is_perl_builtin() returns 1 for known builtins' => sub {
	for my $builtin (qw(abs chomp length push pop shift unshift
						print printf die warn open close)) {
		is(_is_perl_builtin($builtin), 1, "'$builtin' recognised as builtin");
	}
};

subtest '_is_perl_builtin() returns 0 for module names' => sub {
	for my $mod (qw(Scalar::Util List::Util File::Spec POSIX Carp)) {
		is(_is_perl_builtin($mod), 0, "'$mod' not a builtin");
	}
};

subtest '_is_perl_builtin() is case-insensitive' => sub {
	is(_is_perl_builtin('ABS'), 1, 'ABS -> 1');
	is(_is_perl_builtin('Abs'), 1, 'Abs -> 1');
	is(_is_perl_builtin('abs'), 1, 'abs -> 1');
};

subtest '_is_perl_builtin() returns 0 for undef' => sub {
	is(_is_perl_builtin(undef), 0, 'undef -> 0');
};

subtest '_is_perl_builtin() returns 0 for empty string' => sub {
	is(_is_perl_builtin(''), 0, 'empty string -> 0');
};

subtest 'Generator: generate() sort handles undef values correctly' => sub {
	# The comparator at lines 1752-1761 handles undef $a and $b
	# Test by generating output from two schemas and verifying order is stable
	my ($fh1, $p1) = tempfile(SUFFIX => '.yml', UNLINK => 1);
	print $fh1 "module: builtin\nfunction: beta\ninput:\n  type: string\noutput:\n  type: string\n";
	close $fh1;
	my ($fh2, $p2) = tempfile(SUFFIX => '.yml', UNLINK => 1);
	print $fh2 "module: builtin\nfunction: alpha\ninput:\n  type: string\noutput:\n  type: string\n";
	close $fh2;
	my ($out1) = capture(sub { App::Test::Generator->generate($p1) });
	my ($out2) = capture(sub { App::Test::Generator->generate($p2) });
	isnt($out1, $out2, 'different function names produce different output');
};

subtest 'Generator: generate() with exactly one arg (class only) croaks' => sub {
	throws_ok(
		sub { App::Test::Generator->generate() },
		qr/Usage/,
		'zero args after class croaks'
	);
};

subtest 'Generator: generate() with two args (class + schema) lives' => sub {
	my ($fh, $schema) = tempfile(SUFFIX => '.yml', UNLINK => 1);
	print $fh "module: builtin\nfunction: abs\ninput:\n  type: number\noutput:\n  type: number\n";
	close $fh;
	my ($out) = capture(sub {
		eval { App::Test::Generator->generate($schema) };
	});
	is($@, '', 'two args (class + schema) lives');
	like($out, qr/use strict/, 'output contains use strict');
};

# ==================================================================
# output type: array — list-context capture and validation (v0.39)
# ==================================================================

subtest 'generate() with output type array uses list-context capture' => sub {
	my ($fh, $schema) = tempfile(SUFFIX => '.yml', UNLINK => 1);
	print $fh <<'YAML';
module: My::Module
function: get_items
new: ~
input: {}
output:
  type: array
YAML
	close $fh;

	my ($out) = capture(sub {
		eval { App::Test::Generator->generate($schema) };
	});

	is($@, '', 'generate() does not croak for output type array');
	like($out, qr/my \@_r\s*=/, 'list-context capture @_r present in generated code');
	like($out, qr/\$result\s*=\s*\\\@_r/, 'result assigned as arrayref from @_r');
	unlike($out, qr/\$result\s*=\s*\$obj->get_items/, 'scalar-context capture not used');
};

subtest 'generate() with output type arrayref uses scalar-context capture' => sub {
	my ($fh, $schema) = tempfile(SUFFIX => '.yml', UNLINK => 1);
	print $fh <<'YAML';
module: My::Module