view release on metacpan or  search on metacpan

t/Model-Method.t  view on Meta::CPAN

	# Setter works
	$m->return_type('string');
	is($m->return_type, 'string', 'return_type set to string');

	# Overwrite works
	$m->return_type('object');
	is($m->return_type, 'object', 'return_type overwritten');

	# Set to undef
	$m->return_type(undef);
	is($m->return_type, undef, 'return_type set to undef');
};

# ==================================================================
# classification accessor -- read/write
# ==================================================================
subtest 'classification accessor' => sub {
	my $m = _method();

	is($m->classification, undef, 'classification initially undef');

	$m->classification('getter');
	is($m->classification, 'getter', 'classification set to getter');

	$m->classification('chainable');
	is($m->classification, 'chainable', 'classification overwritten');
};

# ==================================================================
# confidence accessor -- read/write
# ==================================================================
subtest 'confidence accessor' => sub {
	my $m = _method();

	is($m->confidence, undef, 'confidence initially undef');

	my $conf = { score => 42, level => 'high' };
	$m->confidence($conf);
	is_deeply($m->confidence, $conf, 'confidence set to hashref');
};

# ==================================================================
# add_evidence -- validation
# ==================================================================
subtest 'add_evidence: validation' => sub {
	my $m = _method();

	# Invalid category croaks
	throws_ok {
		$m->add_evidence(category => 'invalid', signal => 'returns_property')
	} qr/Invalid evidence category/, 'invalid category croaks';

	# Missing category croaks
	throws_ok {
		$m->add_evidence(signal => 'returns_property')
	} qr/Invalid evidence category/, 'missing category croaks';

	# Invalid signal croaks
	throws_ok {
		$m->add_evidence(category => 'return', signal => 'not_a_signal')
	} qr/Invalid evidence signal/, 'invalid signal croaks';

	# Missing signal croaks
	throws_ok {
		$m->add_evidence(category => 'return')
	} qr/Invalid evidence signal/, 'missing signal croaks';
};

# ==================================================================
# add_evidence -- valid categories and signals
# ==================================================================
subtest 'add_evidence: valid entries' => sub {
	my $m = _method();

	# All three valid categories
	lives_ok {
		$m->add_evidence(category => 'return', signal => 'returns_property')
	} 'return category accepted';

	lives_ok {
		$m->add_evidence(category => 'input', signal => 'input_validated')
	} 'input category accepted';

	lives_ok {
		$m->add_evidence(category => 'effect', signal => 'has_side_effect')
	} 'effect category accepted';

	is(scalar($m->evidence), 3, 'three evidence entries added');

	# Default weight is 1 when not specified
	my @ev = $m->evidence;
	is($ev[0]{weight}, 1, 'default weight is 1');

	# Explicit weight is stored
	my $m2 = _method();
	$m2->add_evidence(
		category => 'return',
		signal   => 'returns_self',
		weight   => 15,
	);
	my @ev2 = $m2->evidence;
	is($ev2[0]{weight}, 15, 'explicit weight stored correctly');

	# Value field is stored when provided
	my $m3 = _method();
	$m3->add_evidence(
		category => 'return',
		signal   => 'returns_property',
		value    => 'name',
		weight   => 20,
	);
	my @ev3 = $m3->evidence;
	is($ev3[0]{value}, 'name', 'value field stored correctly');
};

# ==================================================================
# evidence and evidence_ref
# ==================================================================
subtest 'evidence and evidence_ref' => sub {
	my $m = _method();