| File: | blib/lib/App/Test/Generator/Model/Method.pm |
| Coverage: | 98.8% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package App::Test::Generator::Model::Method; | |||||
| 2 | ||||||
| 3 | 39 39 39 | 313420 36 411 | use strict; | |||
| 4 | 39 39 39 | 62 38 797 | use warnings; | |||
| 5 | ||||||
| 6 | 39 39 39 | 68 56 844 | use Carp qw(confess croak); | |||
| 7 | 39 39 39 | 6000 44961 20680 | use Readonly; | |||
| 8 | ||||||
| 9 | Readonly my $HIGH_CONFIDENCE_THRESHOLD => 40; | |||||
| 10 | Readonly my $MEDIUM_CONFIDENCE_THRESHOLD => 20; | |||||
| 11 | ||||||
| 12 | Readonly my %VALID_CATEGORIES => map { $_ => 1 } qw(return input effect); | |||||
| 13 | Readonly my %VALID_SIGNALS => map { $_ => 1 } qw( | |||||
| 14 | returns_property returns_constant returns_self | |||||
| 15 | legacy_type context_aware error_pattern | |||||
| 16 | input_validated input_typed input_optional | |||||
| 17 | has_side_effect no_side_effect | |||||
| 18 | ); | |||||
| 19 | ||||||
| 20 | our $VERSION = '0.46'; | |||||
| 21 | ||||||
| 22 - 83 | =head1 NAME
App::Test::Generator::Model::Method - Evidence-based model of a single method under test
=head1 VERSION
Version 0.46
=head1 DESCRIPTION
Accumulates weighted evidence about a single method's return behaviour,
gathered independently by several analysers
(L<App::Test::Generator::Analyzer::Return> and friends), then resolves
that evidence into a best-guess return type, test classification, and
confidence level. This lets multiple independent heuristics contribute
to one final judgement instead of the first heuristic to run winning
outright.
=head2 new
Construct a new Method model.
my $method = App::Test::Generator::Model::Method->new(
name => 'get_name',
source => 'sub get_name { return $_[0]->{name}; }',
);
=head3 Arguments
=over 4
=item * C<name>
The method's name. Required.
=item * C<source>
The method's raw Perl source text. Required.
=back
=head3 Returns
A blessed hashref with C<evidence> initialised to an empty arrayref
and C<return_type>, C<classification>, and C<confidence> initialised
to C<undef>. Croaks with C<"name required"> or C<"source required">
if either argument is missing.
=head3 API specification
=head4 input
{
name => { type => SCALAR },
source => { type => SCALAR },
}
=head4 output
{ type => OBJECT, isa => 'App::Test::Generator::Model::Method' }
=cut | |||||
| 84 | ||||||
| 85 | sub new { | |||||
| 86 | 536 | 543251 | my ($class, %args) = @_; | |||
| 87 | 536 | 871 | croak 'name required' unless defined $args{name}; | |||
| 88 | 531 | 712 | croak 'source required' unless defined $args{source}; | |||
| 89 | ||||||
| 90 | my $self = { | |||||
| 91 | name => $args{name}, | |||||
| 92 | source => $args{source}, | |||||
| 93 | # parameters => [], | |||||
| 94 | 526 | 1653 | evidence => [], | |||
| 95 | return_type => undef, | |||||
| 96 | classification => undef, | |||||
| 97 | confidence => undef, | |||||
| 98 | }; | |||||
| 99 | ||||||
| 100 | 526 | 960 | return bless $self, $class; | |||
| 101 | } | |||||
| 102 | ||||||
| 103 - 128 | =head2 name
Return the method's name.
my $name = $method->name;
=head3 Arguments
None beyond C<$self>.
=head3 Returns
The name string supplied to C<new>. Read-only â there is no setter;
C<name> ignores any extra arguments passed to it.
=head3 API specification
=head4 input
{ self => { type => OBJECT, isa => 'App::Test::Generator::Model::Method' } }
=head4 output
{ type => SCALAR }
=cut | |||||
| 129 | ||||||
| 130 | 9 | 437 | sub name { $_[0]->{name} } | |||
| 131 | ||||||
| 132 - 157 | =head2 source
Return the method's raw source text.
my $source = $method->source;
=head3 Arguments
None beyond C<$self>.
=head3 Returns
The source string supplied to C<new>. Read-only â there is no setter;
C<source> ignores any extra arguments passed to it.
=head3 API specification
=head4 input
{ self => { type => OBJECT, isa => 'App::Test::Generator::Model::Method' } }
=head4 output
{ type => SCALAR }
=cut | |||||
| 158 | ||||||
| 159 | 350 | 549 | sub source { $_[0]->{source} } | |||
| 160 | ||||||
| 161 - 201 | =head2 return_type
Read/write accessor for the resolved return type.
$method->return_type('object');
my $type = $method->return_type;
=head3 Arguments
=over 4
=item * C<$val>
Optional. If supplied (including C<undef>), stores it as the new
return type.
=back
=head3 Returns
The current return type string, or C<undef> if not yet resolved (or
explicitly set back to C<undef>).
=head3 Side effects
Overwrites the stored return type when called with an argument.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::Model::Method' },
val => { type => SCALAR, optional => 1 },
}
=head4 output
{ type => SCALAR, optional => 1 }
=cut | |||||
| 202 | ||||||
| 203 | sub return_type { | |||||
| 204 | 28 | 59 | my ($self, $val) = @_; | |||
| 205 | 28 | 43 | $self->{return_type} = $val if @_ > 1; | |||
| 206 | 28 | 58 | return $self->{return_type}; | |||
| 207 | } | |||||
| 208 | ||||||
| 209 - 248 | =head2 classification
Read/write accessor for the resolved test classification.
$method->classification('getter');
my $class = $method->classification;
=head3 Arguments
=over 4
=item * C<$val>
Optional. If supplied (including C<undef>), stores it as the new
classification.
=back
=head3 Returns
The current classification string, or C<undef> if not yet resolved.
=head3 Side effects
Overwrites the stored classification when called with an argument.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::Model::Method' },
val => { type => SCALAR, optional => 1 },
}
=head4 output
{ type => SCALAR, optional => 1 }
=cut | |||||
| 249 | ||||||
| 250 | sub classification { | |||||
| 251 | 343 | 405 | my ($self, $val) = @_; | |||
| 252 | 343 | 503 | $self->{classification} = $val if @_ > 1; | |||
| 253 | 343 | 688 | return $self->{classification}; | |||
| 254 | } | |||||
| 255 | ||||||
| 256 - 296 | =head2 confidence
Read/write accessor for the resolved confidence hashref.
$method->confidence({ score => 45, level => 'medium' });
my $conf = $method->confidence;
=head3 Arguments
=over 4
=item * C<$val>
Optional. If supplied (including C<undef>), stores it as the new
confidence value.
=back
=head3 Returns
The current confidence hashref (with C<score> and C<level> keys), or
C<undef> if not yet resolved.
=head3 Side effects
Overwrites the stored confidence value when called with an argument.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::Model::Method' },
val => { type => HASHREF, optional => 1 },
}
=head4 output
{ type => HASHREF, optional => 1 }
=cut | |||||
| 297 | ||||||
| 298 | sub confidence { | |||||
| 299 | 343 | 407 | my ($self, $val) = @_; | |||
| 300 | 343 | 440 | $self->{confidence} = $val if @_ > 1; | |||
| 301 | 343 | 776 | return $self->{confidence}; | |||
| 302 | } | |||||
| 303 | ||||||
| 304 - 377 | =head2 add_evidence
Record one piece of weighted evidence about the method's behaviour.
$method->add_evidence(
category => 'return',
signal => 'returns_property',
value => 'name',
weight => 20,
);
=head3 Arguments
=over 4
=item * C<category>
One of C<return>, C<input>, or C<effect>. Required. Croaks
C<"Invalid evidence category '...'"> for any other value, including a
missing category.
=item * C<signal>
A recognised signal name (see L</Notes>). Required. Croaks
C<"Invalid evidence signal '...'"> for any other value, including a
missing signal.
=item * C<value>
Optional. An arbitrary value associated with the signal (e.g. the
property name for C<returns_property>).
=item * C<weight>
Optional. A numeric weight. Defaults to 1.
=back
=head3 Returns
Nothing (undef).
=head3 Side effects
Appends an evidence hashref (with keys C<category>, C<signal>,
C<value>, C<weight>) to the object's internal evidence list.
=head3 Notes
Recognised signals are C<returns_property>, C<returns_constant>,
C<returns_self>, C<legacy_type>, C<context_aware>, C<error_pattern>
(intended for category C<return>); C<input_validated>, C<input_typed>,
C<input_optional> (category C<input>); and C<has_side_effect>,
C<no_side_effect> (category C<effect>). Signal validity is checked
against the full set regardless of category â passing a return-only
signal with C<category =E<gt> 'input'> does not croak.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::Model::Method' },
category => { type => SCALAR },
signal => { type => SCALAR },
value => { type => SCALAR, optional => 1 },
weight => { type => SCALAR, optional => 1 },
}
=head4 output
{ type => UNDEF }
=cut | |||||
| 378 | ||||||
| 379 | sub add_evidence { | |||||
| 380 | 750 | 8044 | my ($self, %args) = @_; | |||
| 381 | ||||||
| 382 | 750 | 1647 | my $cat = $args{category} // ''; | |||
| 383 | 750 | 1793 | croak "Invalid evidence category '$cat'" unless $VALID_CATEGORIES{$cat}; | |||
| 384 | ||||||
| 385 | 741 | 3076 | my $sig = $args{signal} // ''; | |||
| 386 | 741 | 958 | croak "Invalid evidence signal '$sig'" unless $VALID_SIGNALS{$sig}; | |||
| 387 | ||||||
| 388 | 733 | 1937 | push @{ $self->{evidence} }, { | |||
| 389 | category => $args{category}, | |||||
| 390 | signal => $args{signal}, | |||||
| 391 | value => $args{value}, | |||||
| 392 | 733 | 2379 | weight => defined $args{weight} ? $args{weight} : 1, | |||
| 393 | }; | |||||
| 394 | ||||||
| 395 | 733 | 1100 | return; | |||
| 396 | } | |||||
| 397 | ||||||
| 398 - 428 | =head2 evidence
Return all recorded evidence entries.
my @evidence = $method->evidence;
for my $entry (@evidence) {
print "$entry->{category}/$entry->{signal}: $entry->{weight}\n";
}
=head3 Arguments
None beyond C<$self>.
=head3 Returns
A list of evidence hashrefs (each with keys C<category>, C<signal>,
C<value>, C<weight>), in the order they were added via
C<add_evidence>. Empty list if no evidence has been recorded. Called
in scalar context, returns the count of evidence entries.
=head3 API specification
=head4 input
{ self => { type => OBJECT, isa => 'App::Test::Generator::Model::Method' } }
=head4 output
{ type => ARRAYREF, items => { type => HASHREF } }
=cut | |||||
| 429 | ||||||
| 430 | sub evidence { | |||||
| 431 | 58 | 1090 | my $self = $_[0]; | |||
| 432 | 58 58 | 43 112 | return @{ $self->{evidence} }; | |||
| 433 | } | |||||
| 434 | ||||||
| 435 - 462 | =head2 evidence_ref
Return all recorded evidence entries as an arrayref.
my $ref = $method->evidence_ref;
print "count: ", scalar(@$ref), "\n";
=head3 Arguments
None beyond C<$self>.
=head3 Returns
An arrayref of the same evidence hashrefs returned by C<evidence>.
This is the live internal arrayref, not a copy â modifying it
modifies the object's evidence list.
=head3 API specification
=head4 input
{ self => { type => OBJECT, isa => 'App::Test::Generator::Model::Method' } }
=head4 output
{ type => ARRAYREF, items => { type => HASHREF } }
=cut | |||||
| 463 | ||||||
| 464 | sub evidence_ref { | |||||
| 465 | 17 | 1595 | my $self = $_[0]; | |||
| 466 | 17 | 35 | return $self->{evidence}; | |||
| 467 | } | |||||
| 468 | ||||||
| 469 - 514 | =head2 resolve_return_type
Derive a return type from the accumulated C<return>-category evidence
and store it.
$method->add_evidence(category => 'return', signal => 'returns_self', weight => 20);
my $type = $method->resolve_return_type; # 'object'
=head3 Arguments
None beyond C<$self>.
=head3 Returns
One of C<object>, C<property>, or C<constant>, chosen by summing the
weight of all C<return>-category evidence into three buckets
(C<returns_self> -> object; C<returns_property>, C<context_aware>,
C<error_pattern> -> property; C<returns_constant> -> constant;
C<legacy_type> -> object or property depending on its C<value>) and
picking the highest-scoring bucket. Ties are broken alphabetically
among the tied bucket names (C<constant> E<lt> C<object> E<lt>
C<property>). With no C<return>-category evidence at all, all three
buckets score 0 and C<constant> wins the alphabetical tie-break.
=head3 Side effects
Sets C<return_type> to the resolved value.
=head3 Notes
Evidence outside the C<return> category is ignored. Evidence with an
unrecognised signal name is also ignored (this can only happen if a
caller other than C<add_evidence> populated the evidence list
directly, since C<add_evidence> itself rejects unrecognised signals).
=head3 API specification
=head4 input
{ self => { type => OBJECT, isa => 'App::Test::Generator::Model::Method' } }
=head4 output
{ type => SCALAR }
=cut | |||||
| 515 | ||||||
| 516 | sub resolve_return_type { | |||||
| 517 | 390 | 668 | my $self = $_[0]; | |||
| 518 | 390 | 862 | my %score = (property => 0, constant => 0, object => 0); | |||
| 519 | ||||||
| 520 | 390 390 | 383 542 | for my $ev (@{ $self->{evidence} }) { | |||
| 521 | 623 | 747 | next unless $ev->{category} eq 'return'; | |||
| 522 | 616 | 1360 | if($ev->{signal} eq 'returns_property') { | |||
| 523 | 52 | 73 | $score{property} += $ev->{weight}; | |||
| 524 | } elsif($ev->{signal} eq 'returns_constant') { | |||||
| 525 | 185 | 222 | $score{constant} += $ev->{weight}; | |||
| 526 | } elsif($ev->{signal} eq 'returns_self') { | |||||
| 527 | 30 | 42 | $score{object} += $ev->{weight}; | |||
| 528 | } elsif($ev->{signal} eq 'legacy_type') { | |||||
| 529 | # Legacy type hint â map to nearest score bucket if recognisable | |||||
| 530 | 320 | 521 | my $t = $ev->{value} // ''; | |||
| 531 | 320 36 | 535 64 | if($t eq 'object') { $score{object} += $ev->{weight} } | |||
| 532 | 3 | 7 | elsif($t eq 'self') { $score{object} += $ev->{weight} } | |||
| 533 | 281 | 376 | else { $score{property} += $ev->{weight} } | |||
| 534 | } elsif($ev->{signal} eq 'context_aware') { | |||||
| 535 | # Context-aware return suggests getter behaviour | |||||
| 536 | 9 | 15 | $score{property} += $ev->{weight}; | |||
| 537 | } elsif($ev->{signal} eq 'error_pattern') { | |||||
| 538 | # Error pattern return doesn't strongly imply a type â | |||||
| 539 | # give a small nudge toward property (scalar return) | |||||
| 540 | 20 | 29 | $score{property} += $ev->{weight}; | |||
| 541 | } | |||||
| 542 | # Unknown signals are ignored â they may be used by external consumers | |||||
| 543 | } | |||||
| 544 | ||||||
| 545 | # Tie-break alphabetically â deterministic but arbitrary. | |||||
| 546 | # %score is always initialised with all three keys, so the || 0 guard is dead. | |||||
| 547 | 390 1023 | 1015 1578 | my ($winner) = sort { $score{$b} <=> $score{$a} || $a cmp $b } keys %score; | |||
| 548 | ||||||
| 549 | 390 | 677 | return $self->{return_type} = $winner; | |||
| 550 | } | |||||
| 551 | ||||||
| 552 - 592 | =head2 resolve_confidence
Derive a confidence level from the total weight of all accumulated
evidence (every category, not just C<return>) and store it.
$method->add_evidence(category => 'return', signal => 'returns_self', weight => 50);
my $conf = $method->resolve_confidence; # { score => 50, level => 'high' }
=head3 Arguments
None beyond C<$self>.
=head3 Returns
A hashref with keys C<score> (the sum of every evidence entry's
C<weight>) and C<level>, which is C<low> if C<score> is below
C<$MEDIUM_CONFIDENCE_THRESHOLD> (20), C<medium> if at least 20 but
below C<$HIGH_CONFIDENCE_THRESHOLD> (40), or C<high> if 40 or above.
With no evidence at all, C<score> is 0 and C<level> is C<low>.
=head3 Side effects
Sets C<confidence> to the resolved hashref.
=head3 API specification
=head4 input
{ self => { type => OBJECT, isa => 'App::Test::Generator::Model::Method' } }
=head4 output
{
type => HASHREF,
keys => {
score => { type => SCALAR },
level => { type => SCALAR },
},
}
=cut | |||||
| 593 | ||||||
| 594 | sub resolve_confidence { | |||||
| 595 | 369 | 1090 | my $self = $_[0]; | |||
| 596 | ||||||
| 597 | 369 | 359 | my $total = 0; | |||
| 598 | 369 369 | 345 673 | $total += $_->{weight} for @{ $self->{evidence} }; | |||
| 599 | ||||||
| 600 | 369 | 644 | my $level = $total >= $HIGH_CONFIDENCE_THRESHOLD ? 'high' : $total >= $MEDIUM_CONFIDENCE_THRESHOLD ? 'medium' : 'low'; | |||
| 601 | ||||||
| 602 | 369 | 1937 | $self->{confidence} = { score => $total, level => $level }; | |||
| 603 | ||||||
| 604 | 369 | 418 | return $self->{confidence}; | |||
| 605 | } | |||||
| 606 | ||||||
| 607 - 641 | =head2 resolve_classification
Derive a test classification from the resolved return type and store
it.
$method->add_evidence(category => 'return', signal => 'returns_self', weight => 20);
my $class = $method->resolve_classification; # 'chainable'
=head3 Arguments
None beyond C<$self>.
=head3 Returns
C<chainable> if C<return_type> is C<object>, C<getter> if
C<property>, C<constant> if C<constant>, or C<unknown> for any other
value.
=head3 Side effects
Calls C<resolve_return_type> first (and so also sets C<return_type>)
if C<return_type> has not already been resolved. Sets
C<classification> to the resolved value.
=head3 API specification
=head4 input
{ self => { type => OBJECT, isa => 'App::Test::Generator::Model::Method' } }
=head4 output
{ type => SCALAR }
=cut | |||||
| 642 | ||||||
| 643 | sub resolve_classification { | |||||
| 644 | 348 | 908 | my $self = $_[0]; | |||
| 645 | ||||||
| 646 | # Return_type must be resolved before classification can be determined | |||||
| 647 | 348 | 477 | $self->resolve_return_type() unless defined $self->{return_type}; | |||
| 648 | ||||||
| 649 | 348 | 689 | if($self->{return_type} eq 'object') { | |||
| 650 | 39 | 61 | $self->{classification} = 'chainable'; | |||
| 651 | } elsif ($self->{return_type} eq 'property') { | |||||
| 652 | 280 | 350 | $self->{classification} = 'getter'; | |||
| 653 | } elsif ($self->{return_type} eq 'constant') { | |||||
| 654 | 25 | 29 | $self->{classification} = 'constant'; | |||
| 655 | } else { | |||||
| 656 | # Unreachable: resolve_return_type always returns object/property/constant | |||||
| 657 | 4 | 46 | confess "invariant violation: unexpected return_type '$self->{return_type}'"; | |||
| 658 | } | |||||
| 659 | ||||||
| 660 | 344 | 359 | return $self->{classification}; | |||
| 661 | } | |||||
| 662 | ||||||
| 663 - 727 | =head2 absorb_legacy_output
Convert a legacy schema output hashref (the pre-evidence-model output
descriptor format) into one or more C<return>-category evidence
entries.
$method->absorb_legacy_output({
type => 'object',
_returns_self => 1,
});
=head3 Arguments
=over 4
=item * C<$output>
A hashref of legacy output hints, or C<undef>.
=back
=head3 Returns
Nothing (undef).
=head3 Side effects
For each recognised key present and true in C<$output>, calls
C<add_evidence> once:
=over 4
=item * C<type> -> C<legacy_type> evidence, C<value> set to
C<$output-E<gt>{type}>, weight 20.
=item * C<_returns_self> -> C<returns_self> evidence, weight 25.
=item * C<_context_aware> -> C<context_aware> evidence, weight 15.
=item * C<_error_return> -> C<error_pattern> evidence, C<value> set to
C<$output-E<gt>{_error_return}>, weight 15.
=back
=head3 Notes
C<$output> being C<undef> or any non-hashref value is silently
ignored â no evidence is added and no exception is raised. A hashref
with none of the four recognised keys set to a true value also adds
no evidence.
=head3 API specification
=head4 input
{
self => { type => OBJECT, isa => 'App::Test::Generator::Model::Method' },
output => { type => HASHREF, optional => 1 },
}
=head4 output
{ type => UNDEF }
=cut | |||||
| 728 | ||||||
| 729 | sub absorb_legacy_output { | |||||
| 730 | 348 | 537 | my ($self, $output) = @_; | |||
| 731 | ||||||
| 732 | 348 | 887 | return unless $output && ref $output eq 'HASH'; | |||
| 733 | ||||||
| 734 | 344 | 529 | if ($output->{type}) { | |||
| 735 | $self->add_evidence( | |||||
| 736 | category => 'return', | |||||
| 737 | signal => 'legacy_type', | |||||
| 738 | value => $output->{type}, | |||||
| 739 | 314 | 633 | weight => 20, | |||
| 740 | ); | |||||
| 741 | } | |||||
| 742 | ||||||
| 743 | 344 | 451 | if ($output->{_returns_self}) { | |||
| 744 | 10 | 15 | $self->add_evidence( | |||
| 745 | category => 'return', | |||||
| 746 | signal => 'returns_self', | |||||
| 747 | weight => 25, | |||||
| 748 | ); | |||||
| 749 | } | |||||
| 750 | ||||||
| 751 | 344 | 438 | if ($output->{_context_aware}) { | |||
| 752 | 10 | 14 | $self->add_evidence( | |||
| 753 | category => 'return', | |||||
| 754 | signal => 'context_aware', | |||||
| 755 | weight => 15, | |||||
| 756 | ); | |||||
| 757 | } | |||||
| 758 | ||||||
| 759 | 344 | 537 | if ($output->{_error_return}) { | |||
| 760 | $self->add_evidence( | |||||
| 761 | category => 'return', | |||||
| 762 | signal => 'error_pattern', | |||||
| 763 | value => $output->{_error_return}, | |||||
| 764 | 21 | 41 | weight => 15, | |||
| 765 | ); | |||||
| 766 | } | |||||
| 767 | } | |||||
| 768 | ||||||
| 769 | 1; | |||||