view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

	is($params{y}{position}, 1, 'y is given position 1, immediately after the skipped self');
};

subtest 'SchemaExtractor::_parse_modern_signature - respects nested brackets when splitting on commas' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';
	my %params;

	$e->_parse_modern_signature(\%params, '$self, $opts = { a => 1, b => 2 }');
	is(scalar(keys %params), 1, 'the internal comma inside the bracketed default value does not split the parameter list');
	ok(exists $params{opts}, 'opts is recognised as a single parameter despite its hashref default');
};

subtest 'SchemaExtractor::_detect_dependencies - detects a dependency only when both message and code patterns match' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';

	my $rels = $e->_detect_dependencies(q{ croak "ssl requires key" if $ssl && !$key; }, ['ssl', 'key']);
	is(scalar(@$rels), 1, 'exactly one dependency relationship is detected');
	is($rels->[0]{type}, 'dependency', '...');
	is($rels->[0]{param}, 'ssl', '...');
	is($rels->[0]{requires}, 'key', '...');

	my $no_code_match = $e->_detect_dependencies(q{ croak "ssl requires key" if $ssl; }, ['ssl', 'key']);
	is_deeply($no_code_match, [], 'no relationship is recorded when the code-condition pattern is absent, even though the message matches');
};

subtest 'SchemaExtractor::_detect_dependencies - return value shape' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';
	my $rels = $e->_detect_dependencies(q{ croak "ssl requires key" if $ssl && !$key; }, ['ssl', 'key']);
	returns_ok($rels, { type => 'arrayref' }, '_detect_dependencies() returns an arrayref');
	memory_cycle_ok($rels, '_detect_dependencies() result is free of circular references');
};

subtest 'SchemaExtractor::_write_schema - croaks when output_dir was not provided to new()' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';

	throws_ok { $e->_write_schema('foo', {}) }
		qr{^App::Test::Generator::SchemaExtractor: output_dir must be provided to new\(\) when writing schema files at },
		'croaks with the exact documented message';
};

subtest 'SchemaExtractor::_write_schema - writes a YAML schema file under output_dir' => sub {
	my $tmpdir = tempdir(CLEANUP => 1);
	my $e = bless { output_dir => $tmpdir }, 'App::Test::Generator::SchemaExtractor';

	$e->_write_schema('greet', {
		input  => { name => { type => 'string', position => 0 } },
		output => { type => 'string' },
	});

	my $file = File::Spec->catfile($tmpdir, 'greet.yml');
	ok(-e $file, 'the schema file is created at output_dir/<method_name>.yml');

	open my $fh, '<', $file or die "Cannot read $file: $!";
	my $contents = do { local $/; <$fh> };
	close $fh;

	like($contents, qr/function: greet/, 'the written YAML includes the function name');
	like($contents, qr/name:/, 'the written YAML includes the input parameter name');
};

subtest 'SchemaExtractor::_check_inheritance_for_constructor - detects use parent and SUPER:: usage' => sub {
	my $src = "package Child;\nuse parent 'Parent';\nsub greet { my \$self = shift; return \$self->SUPER::greet(); }\n1;\n";
	my $e = bless { _document => PPI::Document->new(\$src) }, 'App::Test::Generator::SchemaExtractor';

	my $info = $e->_check_inheritance_for_constructor('Child', 'sub greet { my $self = shift; return $self->SUPER::greet(); }');
	ok($info, 'returns inheritance info when a parent class is declared');
	is_deeply($info->{parent_statements}, ['Parent'], 'the declared parent class is captured');
	ok($info->{uses_super}, 'SUPER:: usage in the method body is detected');
	ok(!$info->{has_own_constructor}, 'Child has no own new() method');
	ok($info->{use_parent_constructor}, 'falls back to the parent constructor since Child has none of its own');
	is($info->{parent_class}, 'Parent', 'the first declared parent is selected as the constructor source');

	returns_ok($info, { type => 'hashref' }, '_check_inheritance_for_constructor() returns a hashref');
	memory_cycle_ok($info, '_check_inheritance_for_constructor() result is free of circular references');
};

subtest 'SchemaExtractor::_check_inheritance_for_constructor - returns undef when there is no _document' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';
	is($e->_check_inheritance_for_constructor('Foo', ''), undef, '...');
};

subtest 'SchemaExtractor::_detect_constructor_requirements - returns a minimal hashref for an external target package' => sub {
	my $e = bless { _document => PPI::Document->new(\"package Foo;\n1;\n") }, 'App::Test::Generator::SchemaExtractor';

	is_deeply(
		$e->_detect_constructor_requirements('Foo', 'Bar::External'),
		{
			external_class => 1,
			package => 'Bar::External',
			note => "Constructor for external class Bar::External - parameters unknown",
		},
		'a target package different from the current one is treated as external, with no source to analyse'
	);
};

subtest 'SchemaExtractor::_detect_constructor_requirements - extracts parameters, required flags, and defaults from new()' => sub {
	my $src = "package Foo;\nsub new {\n\tmy (\$class, \$host, \$port) = \@_;\n\tcroak \"host required\" unless defined \$host;\n\t\$port = \$port || 8080;\n\treturn bless { host => \$host, port => \$port }, \$class;\n}\n1;\n";
	my $e = bless { _document => PPI::Document->new(\$src) }, 'App::Test::Generator::SchemaExtractor';

	my $req = $e->_detect_constructor_requirements('Foo', 'Foo');
	is_deeply($req->{parameters}, ['host', 'port'], 'positional parameters are extracted from the my (...) = @_ pattern');
	is($req->{parameter_count}, 2, 'parameter_count matches the number of extracted parameters');
	is_deeply($req->{required_parameters}, ['host'], 'the croak-guarded parameter is flagged as required');
	is_deeply($req->{optional_parameters}, ['port'], 'the parameter with a default assignment is flagged optional');
	is($req->{default_values}{port}, 8080, 'the default value is captured via _extract_default_value');
};

subtest 'SchemaExtractor::_detect_constructor_requirements - returns undef when there is no new() method' => sub {
	my $e = bless { _document => PPI::Document->new(\"package Foo;\nsub bar { return 1 }\n1;\n") }, 'App::Test::Generator::SchemaExtractor';
	is($e->_detect_constructor_requirements('Foo', 'Foo'), undef, '...');
};

subtest 'SchemaExtractor::_detect_external_object_dependency - detects ->new()/->create() calls on other classes' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';

	my $info = $e->_detect_external_object_dependency(q{ my $obj = Foo::Bar->new(); return $obj; });
	is_deeply($info->{creates_objects}, ['Foo::Bar'], 'the instantiated class is recorded');
	is($info->{package}, 'Foo::Bar', 'the first created class becomes the primary dependency package');
};

subtest 'SchemaExtractor::_detect_external_object_dependency - detects method calls on a typed object variable' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';

	my $info = $e->_detect_external_object_dependency(q{ my $ua = LWP::UserAgent->new; $ua->get($url); });
	is_deeply($info->{uses_objects}, ['LWP::UserAgent'], 'the class of the object variable is inferred from its assignment');
};

subtest 'SchemaExtractor::_detect_external_object_dependency - returns undef for an undef or dependency-free body' => sub {