view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

	my $code = "package Foo;\nsub bar { return 1 }\n1;\n";
	my $doc1 = $e->_ppi($code);
	isa_ok($doc1, 'PPI::Document', 'a code string is parsed into a PPI::Document');

	my $doc2 = $e->_ppi($code);
	is($doc2, $doc1, 'a second call with the identical code string returns the cached document, not a fresh parse');
};

subtest 'SchemaExtractor::_ppi - returns an object that already supports find() unchanged' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';

	my $already_parsed = PPI::Document->new(\"package Foo;\n1;\n");
	my $result = $e->_ppi($already_parsed);
	is($result, $already_parsed, 'an object with a find() method is returned as-is, bypassing the cache entirely');
};

subtest 'SchemaExtractor::_extract_type_params_schema - dispatch isolation and short-circuit on first falsy step' => sub {
	my $e = bless { _document => bless({}, 'Fake::Doc') }, 'App::Test::Generator::SchemaExtractor';
	my @calls;

	my @steps = qw(_extract_function_name _find_signature_statement _extract_signature_expression _compile_signature_isolated _build_schema_from_meta);
	Test::Mockingbird::mock('App::Test::Generator::SchemaExtractor', '_extract_function_name', sub { push @calls, '_extract_function_name'; return 'foo'; });
	Test::Mockingbird::mock('App::Test::Generator::SchemaExtractor', '_find_signature_statement', sub { push @calls, '_find_signature_statement'; return undef; });
	Test::Mockingbird::mock('App::Test::Generator::SchemaExtractor', '_extract_signature_expression', sub { push @calls, '_extract_signature_expression'; return 'unused'; });
	Test::Mockingbird::mock('App::Test::Generator::SchemaExtractor', '_compile_signature_isolated', sub { push @calls, '_compile_signature_isolated'; return {}; });
	Test::Mockingbird::mock('App::Test::Generator::SchemaExtractor', '_build_schema_from_meta', sub { push @calls, '_build_schema_from_meta'; return { input => {} }; });

	my $result = $e->_extract_type_params_schema('sub foo { ... }');
	is($result, undef, 'returns undef when _find_signature_statement returns falsy');
	is_deeply(\@calls, [qw(_extract_function_name _find_signature_statement)],
		'short-circuits immediately after the first falsy step, never calling the later steps');

	@calls = ();
	Test::Mockingbird::mock('App::Test::Generator::SchemaExtractor', '_find_signature_statement', sub { push @calls, '_find_signature_statement'; return bless {}, 'Fake::Stmt'; });
	$result = $e->_extract_type_params_schema('sub foo { ... }');
	is_deeply($result, { input => {} }, 'returns the final step result when every step succeeds');
	is_deeply(\@calls, \@steps, 'calls all five steps in documented order when none are falsy');

	Test::Mockingbird::unmock('App::Test::Generator::SchemaExtractor', $_) for @steps;
};

subtest 'SchemaExtractor::_extract_type_params_schema - returns immediately when there is no _document' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';
	Test::Mockingbird::mock('App::Test::Generator::SchemaExtractor', '_extract_function_name', sub { return 'foo'; });
	is($e->_extract_type_params_schema('sub foo {}'), undef, 'no _document means no signature lookup is even attempted');
	Test::Mockingbird::unmock('App::Test::Generator::SchemaExtractor', '_extract_function_name');
};

subtest 'SchemaExtractor::_extract_function_name - extracts the sub name from the start of a method body' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';

	is($e->_extract_function_name("sub foo { return 1; }"), 'foo', 'a simple one-line sub declaration is matched');
	is($e->_extract_function_name("\n\tsub  bar_baz2 {\n\t\treturn;\n\t}"), 'bar_baz2',
		'leading whitespace and extra spaces before the name are tolerated');
	is($e->_extract_function_name("my \$x = 1; sub foo {}"), undef,
		'returns undef when "sub NAME" does not occur at the very start of the string');
	is($e->_extract_function_name(''), undef, 'returns undef for an empty string');
};

subtest 'SchemaExtractor::_map_formal_input_type - maps formal spec type fragments to canonical ATG types' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';

	is($e->_map_formal_input_type(q{type=>'scalar'}), 'string', 'scalar maps to string');
	is($e->_map_formal_input_type(q{type => "Integer"}), 'integer', 'case is folded before lookup');
	is($e->_map_formal_input_type(q{type => 'scalar | scalarref'}), 'string',
		'a union type resolves to the first recognised alternative');
	is($e->_map_formal_input_type(q{type => 'bogus'}), undef, 'an unrecognised type name returns undef');
	is($e->_map_formal_input_type(q{name => 'x'}), undef, 'a spec fragment with no type key returns undef');
};

subtest 'SchemaExtractor::_analyze_output - dispatch isolation, conditional _validate_output, and empty fallback' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';
	my @detectors = qw(_analyze_output_from_pod _analyze_output_from_code _enhance_boolean_detection _detect_list_context _detect_void_context _detect_chaining_pattern _detect_error_conventions);
	my @calls;

	for my $sub (@detectors, '_validate_output') {
		Test::Mockingbird::mock('App::Test::Generator::SchemaExtractor', $sub, sub { push @calls, $sub; return; });
	}

	my $result = $e->_analyze_output('POD', 'CODE', 'method_name');
	is_deeply($result, {}, 'returns {} when no detector populates the output hash');
	is_deeply(\@calls, \@detectors, '_validate_output is skipped entirely while %output stays empty');

	@calls = ();
	Test::Mockingbird::mock('App::Test::Generator::SchemaExtractor', '_analyze_output_from_pod',
		sub { push @calls, '_analyze_output_from_pod'; $_[1]->{type} = 'string'; return; });
	$result = $e->_analyze_output('POD', 'CODE', 'method_name');
	is_deeply($result, { type => 'string' }, 'returns the populated hashref once a detector sets a key');
	is($calls[-1], '_validate_output', '_validate_output runs last, once %output is non-empty');

	for my $sub (@detectors, '_validate_output') {
		Test::Mockingbird::unmock('App::Test::Generator::SchemaExtractor', $sub);
	}
};

subtest 'SchemaExtractor::_extract_defaults_from_pod - extracts defaults via all three documented POD patterns' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';

	is_deeply($e->_extract_defaults_from_pod(''), {}, 'an empty/falsy POD string returns an empty hashref');

	my $pod1 = "The \$user parameter.\nDefault: 'admin'\n";
	is_deeply($e->_extract_defaults_from_pod($pod1), { user => 'admin' }, 'Pattern 1: Default: <value>, param found by scanning backwards');

	my $pod2 = "The \$timeout parameter is Optional, default 30\n";
	is_deeply($e->_extract_defaults_from_pod($pod2), { timeout => '30' }, 'Pattern 2: Optional, default <value>');

	my $pod3 = "\$port - integer, default 8080\n";
	is_deeply($e->_extract_defaults_from_pod($pod3), { port => '8080' }, 'Pattern 3: inline $name - type, default value');
};

subtest 'SchemaExtractor::_analyze_advanced_types - dispatches to all four detectors in documented priority order' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';
	my @detectors = qw(_detect_datetime_type _detect_filehandle_type _detect_coderef_type _detect_enum_type);
	my @calls;

	for my $sub (@detectors) {
		Test::Mockingbird::mock('App::Test::Generator::SchemaExtractor', $sub, sub { push @calls, $sub; return; });
	}

	my %container = (x => { type => undef });
	$e->_analyze_advanced_types(\$container{x}, 'x', 'CODE');
	is_deeply(\@calls, \@detectors, 'all four detectors run, unconditionally, in datetime/filehandle/coderef/enum order');

	Test::Mockingbird::unmock('App::Test::Generator::SchemaExtractor', $_) for @detectors;
};

subtest 'SchemaExtractor::_parse_modern_signature - skips self/class and assigns sequential positions' => sub {
	my $e = bless {}, 'App::Test::Generator::SchemaExtractor';