view release on metacpan or  search on metacpan

t/SchemaExtractor_function.t  view on Meta::CPAN

subtest '_detect_coderef_type() detects coderef from ref() check' => sub {
	my $e = _extractor();
	my %p;
	$e->_detect_coderef_type(\%p, 'cb', 'sub foo { die unless ref($cb) eq "CODE"; }');
	is($p{type},     'coderef',  'coderef type set');
	is($p{semantic}, 'callback', 'callback semantic set');
};

subtest '_detect_coderef_type() detects coderef from parameter name' => sub {
	my $e = _extractor();
	my %p;
	$e->_detect_coderef_type(\%p, 'callback', 'sub foo { }');
	is($p{type}, 'coderef', 'coderef from name "callback"');
};

subtest '_detect_coderef_type() detects coderef from on_ prefix' => sub {
	my $e = _extractor();
	my %p;
	$e->_detect_coderef_type(\%p, 'on_complete', 'sub foo { }');
	is($p{type}, 'coderef', 'coderef from on_ prefix');
};

# ==================================================================
# _detect_enum_type
# ==================================================================

subtest '_detect_enum_type() detects enum from regex alternation' => sub {
	my $e = _extractor();
	my %p;
	$e->_detect_enum_type(\%p, 'status',
		'sub foo { die unless $status =~ /^(active|inactive|pending)/; }');
	is($p{semantic}, 'enum', 'enum semantic set');
	is_deeply([sort @{$p{enum}}], [sort qw(active inactive pending)], 'enum values extracted');
};

subtest '_detect_enum_type() detects enum from hash lookup' => sub {
	my $e = _extractor();
	my %p;
	my $code = q{
		my %valid = map { $_ => 1 } qw(red green blue);
		die unless $valid{$color};
	};
	$e->_detect_enum_type(\%p, 'color', $code);
	is($p{semantic}, 'enum', 'enum from hash lookup');
};

subtest '_detect_enum_type() detects enum from multiple if/elsif' => sub {
	my $e = _extractor();
	my %p;
	my $code = q{
		if($mode eq 'read') { } elsif($mode eq 'write') { } elsif($mode eq 'append') { }
	};
	$e->_detect_enum_type(\%p, 'mode', $code);
	is($p{semantic}, 'enum', 'enum from if/elsif chain');
};

# ==================================================================
# _detect_datetime_type
# ==================================================================

subtest '_detect_datetime_type() detects DateTime from isa check' => sub {
	my $e = _extractor();
	my %p;
	$e->_detect_datetime_type(\%p, 'dt', 'sub foo { $dt->isa("DateTime"); }');
	is($p{type},     'object',          'object type set');
	is($p{isa},      'DateTime',        'DateTime isa set');
	is($p{semantic}, 'datetime_object', 'datetime_object semantic');
};

subtest '_detect_datetime_type() detects UNIX timestamp from numeric range' => sub {
	my $e = _extractor();
	my %p;
	$e->_detect_datetime_type(\%p, 'ts', 'sub foo { die if $ts > 9999999999; }');
	is($p{type},     'integer',        'integer type for timestamp');
	is($p{semantic}, 'unix_timestamp', 'unix_timestamp semantic');
};

# ==================================================================
# _detect_filehandle_type
# ==================================================================

subtest '_detect_filehandle_type() detects filehandle from print()' => sub {
	my $e = _extractor();
	my %p;
	$e->_detect_filehandle_type(\%p, 'fh', 'sub foo { print($fh, "hello"); }');
	is($p{type},     'object',     'object type set');
	is($p{semantic}, 'filehandle', 'filehandle semantic');
};

subtest '_detect_filehandle_type() detects filepath from file test operator' => sub {
	my $e = _extractor();
	my %p;
	$e->_detect_filehandle_type(\%p, 'path', 'sub foo { die unless -f $path; }');
	is($p{type},     'string',   'string type for filepath');
	is($p{semantic}, 'filepath', 'filepath semantic');
};

# ==================================================================
# _analyze_parameter_constraints
# ==================================================================

subtest '_analyze_parameter_constraints() detects length min from length check' => sub {
	my $e = _extractor();
	my $p = {};
	$e->_analyze_parameter_constraints(\$p, 'name', 'sub foo { die if length($name) < 3; }');
	# length < 3 means max = 2 ... but this is a guard so guarded=1
	# Actually the guard logic... let me check - if die is present with if, it's guarded
	# The constraint should not be set in this case since it's inside a die guard
	# Based on the code: guarded = 1 if die/croak/confess if $param
	# So numeric range checks with guarded won't be set
	# But length checks ARE set regardless of guard
	is($p->{max}, 2, 'max set from length < 3');
};

subtest '_analyze_parameter_constraints() detects length max from length check' => sub {
	my $e = _extractor();
	my $p = {};
	$e->_analyze_parameter_constraints(\$p, 'name', 'sub foo { die if length($name) > 50; }');
	is($p->{min}, 51, 'min set from length > 50');
};

subtest '_analyze_parameter_constraints() detects regex pattern' => sub {
	my $e = _extractor();
	my $p = {};
	$e->_analyze_parameter_constraints(\$p, 'email', 'sub foo { $email =~ qr/\@/; }');
	ok(defined $p->{matches}, 'matches constraint set');