view release on metacpan or  search on metacpan

t/SchemaExtractor_function.t  view on Meta::CPAN

	$e->_extract_parameters_from_signature(\%params,
		'sub foo { my $self = shift; my $name = shift; }');
	ok(exists $params{name}, '$name extracted from shift');
	ok(!exists $params{self}, '$self excluded from shift');
};

subtest '_extract_parameters_from_signature() handles modern signature' => sub {
	my $e = _extractor();
	my %params;
	$e->_extract_parameters_from_signature(\%params,
		'sub foo($self, $x, $y = 5) { }');
	ok(exists $params{x}, '$x extracted from modern sig');
	ok(exists $params{y}, '$y extracted from modern sig');
};

# ==================================================================
# _parse_signature_parameter
# ==================================================================

subtest '_parse_signature_parameter() parses plain $name' => sub {
	my $e = _extractor();
	my $info = $e->_parse_signature_parameter('$name', 0);
	is($info->{name},     'name', 'name extracted');
	is($info->{position}, 0,      'position set');
	is($info->{optional}, 0,      'required by default');
};

subtest '_parse_signature_parameter() parses $name = default' => sub {
	my $e = _extractor();
	my $info = $e->_parse_signature_parameter('$count = 10', 1);
	is($info->{name},     'count', 'name extracted');
	is($info->{optional}, 1,       'optional when default present');
	is($info->{_default}, 10,      'default value stored');
};

subtest '_parse_signature_parameter() parses $name :Int type constraint' => sub {
	my $e = _extractor();
	my $info = $e->_parse_signature_parameter('$n :Int', 0);
	is($info->{name}, 'n',       'name extracted');
	is($info->{type}, 'integer', 'Int -> integer');
};

subtest '_parse_signature_parameter() parses @name as slurpy array' => sub {
	my $e = _extractor();
	my $info = $e->_parse_signature_parameter('@opts', 2);
	is($info->{name},  'opts', 'name extracted');
	is($info->{type},  'array', 'array type set');
	ok($info->{slurpy}, 'slurpy flag set');
};

subtest '_parse_signature_parameter() parses %name as slurpy hash' => sub {
	my $e = _extractor();
	my $info = $e->_parse_signature_parameter('%opts', 2);
	is($info->{name}, 'opts', 'name extracted');
	is($info->{type}, 'hash', 'hash type set');
	ok($info->{slurpy}, 'slurpy flag set');
};

subtest '_parse_signature_parameter() returns undef for unrecognised pattern' => sub {
	my $e = _extractor();
	my $info = $e->_parse_signature_parameter('not_a_param', 0);
	ok(!defined $info, 'undef returned for unrecognised pattern');
};

# ==================================================================
# _extract_subroutine_attributes
# ==================================================================

subtest '_extract_subroutine_attributes() detects :lvalue attribute' => sub {
	my $e = _extractor();
	my $result = $e->_extract_subroutine_attributes('sub foo :lvalue { }');
	ok($result->{lvalue}, ':lvalue detected');
};

subtest '_extract_subroutine_attributes() detects :Returns(Int) attribute' => sub {
	my $e = _extractor();
	my $result = $e->_extract_subroutine_attributes('sub foo :Returns(Int) { }');
	is($result->{Returns}, 'Int', ':Returns(Int) detected');
};

subtest '_extract_subroutine_attributes() returns empty hashref when no attributes' => sub {
	my $e = _extractor();
	my $result = $e->_extract_subroutine_attributes('sub foo { return 1; }');
	is_deeply($result, {}, 'no attributes -> empty hashref');
};

# ==================================================================
# _analyze_postfix_dereferencing
# ==================================================================

subtest '_analyze_postfix_dereferencing() detects ->@*' => sub {
	my $e = _extractor();
	my $result = $e->_analyze_postfix_dereferencing('my @a = $ref->@*;');
	ok($result->{array_deref}, '->@* detected');
};

subtest '_analyze_postfix_dereferencing() detects ->%*' => sub {
	my $e = _extractor();
	my $result = $e->_analyze_postfix_dereferencing('my %h = $ref->%*;');
	ok($result->{hash_deref}, '->%* detected');
};

subtest '_analyze_postfix_dereferencing() returns empty hashref when no derefs' => sub {
	my $e = _extractor();
	my $result = $e->_analyze_postfix_dereferencing('my $x = 1;');
	is_deeply($result, {}, 'no derefs -> empty hashref');
};

# ==================================================================
# _extract_field_declarations
# ==================================================================

subtest '_extract_field_declarations() detects :param fields' => sub {
	my $e = _extractor();
	my $code = "field \$host :param = 'localhost';\n";
	my $result = $e->_extract_field_declarations($code);
	ok(exists $result->{host}, 'host field found');
	ok($result->{host}{is_param}, ':param flag set');
};

subtest '_extract_field_declarations() detects :isa type constraint' => sub {