File Coverage

File:blib/lib/App/Test/Generator/Model/Method.pm
Coverage:98.8%

linestmtbrancondsubtimecode
1package 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
9Readonly my $HIGH_CONFIDENCE_THRESHOLD   => 40;
10Readonly my $MEDIUM_CONFIDENCE_THRESHOLD => 20;
11
12Readonly my %VALID_CATEGORIES => map { $_ => 1 } qw(return input effect);
13Readonly 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
20our $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
85sub 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
203sub 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
250sub 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
298sub 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
379sub 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
430sub 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
464sub 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
516sub 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
594sub 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
643sub 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
729sub 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
7691;