view release on metacpan or  search on metacpan

t/SchemaExtractor.t  view on Meta::CPAN

# ==================================================================
# _analyze_pod (via extract_all integration)
# --------------------------------------------------
# Tests that POD documentation is correctly parsed
# into parameter specs by running the full extractor
# ==================================================================
subtest '_analyze_pod integration' => sub {
	my $source = <<'PM';
package PodTest;

=head1 METHODS

=head2 greet($name, $age)

Say hello.

=head3 Parameters

$name - string (3-50 chars), the person's name
$age - integer (0-150), the person's age

=cut

sub greet {
	my ($self, $name, $age) = @_;
	return "Hello $name";
}

1;
PM

	my $e = _extractor($source);
	my $schemas = $e->extract_all(no_write => 1);

	ok(exists $schemas->{greet}, 'greet schema extracted');
	my $input = $schemas->{greet}{input};

	# Name parameter should have type and constraints from POD
	ok(exists $input->{name},          'name param extracted from POD');
	is($input->{name}{type}, 'string', 'name type is string');
	is($input->{name}{min},  3,        'name min extracted from POD');
	is($input->{name}{max},  50,       'name max extracted from POD');

	# Age parameter should have integer type from POD
	ok(exists $input->{age},            'age param extracted from POD');
	is($input->{age}{type}, 'integer',  'age type is integer');

	done_testing();
};

# ==================================================================
# _analyze_code (via extract_all integration)
# --------------------------------------------------
# Tests that code patterns are analysed correctly
# ==================================================================
subtest '_analyze_code integration' => sub {
	my $source = <<'PM';
package CodeTest;

use Scalar::Util qw(looks_like_number);

sub add {
	my ($x, $y) = @_;
	die 'not numeric' unless looks_like_number($x);
	return $x + ($y // 0);
}

sub get_name {
	my ($self) = @_;
	return $self->{name};
}

1;
PM

	my $e = _extractor($source, include_private => 0);
	my $schemas = $e->extract_all(no_write => 1);

	# add() schema should be extracted
	ok(exists $schemas->{add}, 'add schema extracted');

	# get_name() should be extracted
	ok(exists $schemas->{get_name}, 'get_name schema extracted');

	# get_name() should ideally be detected as a getter accessor
	if(exists $schemas->{get_name}{accessor}) {
		is($schemas->{get_name}{accessor}{type}, 'getter',
			'get_name detected as getter');
	}

	done_testing();
};

# ==================================================================
# _extract_package_name (via extract_all integration)
# --------------------------------------------------
# Tests that the package name is correctly extracted
# and propagated into all method schemas
# ==================================================================
subtest '_extract_package_name integration' => sub {
	my $source = "package My::Test::Module;\nsub run { return 1; }\n1;\n";
	my $e = _extractor($source);
	my $schemas = $e->extract_all(no_write => 1);

	# The module key in each schema must be the correct package name
	for my $method (keys %{$schemas}) {
		is($schemas->{$method}{module}, 'My::Test::Module',
			"$method schema has correct module name");
	}

	done_testing();
};

# ==================================================================
# extract_all
# --------------------------------------------------
# Integration tests for the main public entry point
# ==================================================================
subtest 'extract_all' => sub {
	my $source = <<'PM';
package ExtractTest;

sub new {
	my ($class, %args) = @_;

t/SchemaExtractor.t  view on Meta::CPAN

	# is_valid should be detected as returning boolean
	if(exists $schemas->{is_valid}) {
		is($schemas->{is_valid}{output}{type}, 'boolean',
			'is_valid output detected as boolean');
	}

	# clone should be detected as returning object
	if(exists $schemas->{clone}) {
		is($schemas->{clone}{output}{type}, 'object',
			'clone output detected as object');
	}

	done_testing();
};

# ==================================================================
# _detect_enum_type (via extract_all integration)
# ==================================================================
subtest '_detect_enum_type integration' => sub {
	my $source = <<'PM';
package EnumTest;

sub set_status {
	my ($self, $status) = @_;
	die "bad status" unless $status =~ /^(active|inactive|pending)$/;
	$self->{status} = $status;
}

1;
PM

	my $e = _extractor($source, include_private => 0);
	my $schemas = $e->extract_all(no_write => 1);

	# set_status should have enum values from the regex alternation
	if(exists $schemas->{set_status} &&
	   exists $schemas->{set_status}{input}{status}) {
		my $status_spec = $schemas->{set_status}{input}{status};
		if(exists $status_spec->{enum}) {
			my %enum_vals = map { $_ => 1 } @{$status_spec->{enum}};
			ok($enum_vals{active},   'active in enum');
			ok($enum_vals{inactive}, 'inactive in enum');
			ok($enum_vals{pending},  'pending in enum');
		}
	}

	done_testing();
};

# ==================================================================
# _yamltest_hints integration
# --------------------------------------------------
# Tests that numeric boundary hints are added for
# methods with numeric intent
# ==================================================================
subtest '_yamltest_hints integration' => sub {
	my $source = <<'PM';
package HintsTest;

use Scalar::Util qw(looks_like_number);

sub scale {
	my ($self, $factor) = @_;
	die 'not numeric' unless looks_like_number($factor);
	die 'negative'    if $factor < 0;
	return $self->{value} * $factor;
}

1;
PM

	my $e = _extractor($source);
	my $schemas = $e->extract_all(no_write => 1);

	# scale() should have boundary values in its _yamltest_hints
	if(exists $schemas->{scale}) {
		my $hints = $schemas->{scale}{_yamltest_hints} // {};
		if(exists $hints->{boundary_values}) {
			ok(scalar @{$hints->{boundary_values}} > 0,
				'boundary values present for numeric method');
		}
	}

	done_testing();
};

done_testing();