File Coverage

File:blib/lib/App/Test/Generator/TestStrategy.pm
Coverage:87.5%

linestmtbrancondsubtimecode
1package App::Test::Generator::TestStrategy;
2
3
6
6
6
6
65115
5
73
use strict;
4
6
6
6
6
12
5
92
use warnings;
5
6
6
6
6
229
1621
2090
use Readonly;
6
7# --------------------------------------------------
8# Accessor type strings from the schema
9# --------------------------------------------------
10Readonly my $ACCESSOR_GETTER   => 'getter';
11Readonly my $ACCESSOR_SETTER   => 'setter';
12Readonly my $ACCESSOR_GETSET   => 'getset';
13
14# --------------------------------------------------
15# Output type strings from the schema
16# --------------------------------------------------
17Readonly my $TYPE_BOOLEAN => 'boolean';
18Readonly my $TYPE_OBJECT  => 'object';
19Readonly my $TYPE_VOID    => 'void';
20
21# --------------------------------------------------
22# Default confidence threshold for plan generation
23# --------------------------------------------------
24Readonly my $DEFAULT_CONFIDENCE => 'medium';
25
26# --------------------------------------------------
27# Test plan flag keys written to the method plan
28# --------------------------------------------------
29Readonly my $TEST_CONTEXT         => 'context_tests';
30Readonly my $TEST_PREDICATE       => 'predicate_test';
31Readonly my $TEST_GETTER          => 'getter_test';
32Readonly my $TEST_SETTER          => 'setter_test';
33Readonly my $TEST_GETSET          => 'getset_test';
34Readonly my $TEST_OBJECT_INJECT   => 'object_injection_test';
35Readonly my $TEST_BOOLEAN_SET     => 'boolean_set_test';
36Readonly my $TEST_VOID            => 'void_context_test';
37Readonly my $TEST_ERROR_HANDLING  => 'error_handling_test';
38Readonly my $TEST_BOUNDARY        => 'boundary_tests';
39Readonly my $TEST_CHAINING        => 'chaining_test';
40Readonly my $TEST_BASIC           => 'basic_test';
41
42our $VERSION = '0.36';
43
44 - 99
=head1 VERSION

Version 0.36

=head1 DESCRIPTION

Generates a test strategy plan for all methods in a schema, determining
which test types should be produced for each method based on its
accessor classification, output type, side effects, and other metadata.

=head2 new

Construct a new TestStrategy.

    my $strategy = App::Test::Generator::TestStrategy->new(
        schema     => \%schemas,
        thresholds => { confidence => 'high' },
    );

=head3 Arguments

=over 4

=item * C<schema>

A hashref of method name to schema hashref. Optional — defaults to
an empty hashref.

=item * C<thresholds>

A hashref of threshold configuration. Optional — defaults to
C<< { confidence => 'medium' } >>.

=back

=head3 Returns

A blessed hashref.

=head3 API specification

=head4 input

    {
        schema     => { type => HASHREF, optional => 1 },
        thresholds => { type => HASHREF, optional => 1 },
    }

=head4 output

    {
        type => OBJECT,
        isa  => 'App::Test::Generator::TestStrategy',
    }

=cut
100
101sub new {
102
15
15
95698
        my ($class, %args) = @_;
103        return bless {
104                schema     => $args{schema}     || {},
105
15
50
100
47
                thresholds => $args{thresholds} || { confidence => $DEFAULT_CONFIDENCE },
106                plans      => {},
107        }, $class;
108}
109
110 - 150
=head2 generate_plan

Generate a test plan for all methods in the schema and return it as
a hashref mapping method names to plan hashrefs.

    my $strategy = App::Test::Generator::TestStrategy->new(
        schema => \%schemas,
    );
    my $plan = $strategy->generate_plan;

    for my $method (keys %{$plan}) {
        print "$method: ", join(', ', keys %{ $plan->{$method} }), "\n";
    }

=head3 Arguments

None beyond C<$self>.

=head3 Returns

A hashref mapping method names to test plan hashrefs, each containing
boolean flags for the test types that should be generated.

=head3 API specification

=head4 input

    {
        self => { type => OBJECT, isa => 'App::Test::Generator::TestStrategy' },
    }

=head4 output

    {
        type => HASHREF,
        keys => {
            '*' => { type => HASHREF },
        },
    }

=cut
151
152sub generate_plan {
153
14
14
227
        my $self = $_[0];
154
155
14
14
11
17
        for my $method (keys %{ $self->{schema} }) {
156
13
12
                my $schema = $self->{schema}{$method};
157
158                # Extract analysis metadata from the schema — note that
159                # $schema is already the per-method hashref so we access
160                # _analysis directly, not via the method name key again
161
13
50
16
                my $analysis = $schema->{_analysis}          || {};
162
13
50
16
                my $effects  = $analysis->{side_effects}     || {};
163
13
50
14
                my $deps     = $analysis->{dependencies}     || {};
164
165                # Generate and store the plan for this method
166
13
15
                $self->{plans}{$method} = $self->_plan_for_method($schema);
167        }
168
169
14
14
        return $self->{plans};
170}
171
172# --------------------------------------------------
173# _plan_for_method
174#
175# Determine which test types should be
176#     generated for a single method based on
177#     its schema metadata.
178#
179# Entry:      $schema - the per-method schema hashref
180#
181# Exit:       Returns a hashref of test type flags.
182#             Always contains at least basic_test => 1.
183#
184# Side effects: None.
185#
186# Notes:      All string comparisons use // '' guards
187#             to avoid uninitialized value warnings
188#             when schema fields are absent.
189# --------------------------------------------------
190sub _plan_for_method {
191
13
13
25
        my ($self, $schema) = @_;
192
193
13
7
        my %plan;
194
195        # --------------------------------------------------
196        # Context-aware returns need both scalar and list
197        # context tests to verify correct behaviour in each
198        # --------------------------------------------------
199
13
100
15
        if($schema->{output}{_context_aware}) {
200
1
1
                $plan{$TEST_CONTEXT} = 1;
201        }
202
203        # --------------------------------------------------
204        # Accessor detection — choose test types based on
205        # whether the method is a getter, setter, or both
206        # --------------------------------------------------
207
13
5
50
100
14
8
        if($schema->{accessor} && scalar keys %{ $schema->{accessor} }) {
208
5
50
5
                my $acc_type = $schema->{accessor}{type} // '';
209
210
5
100
100
50
6
                if($acc_type eq $ACCESSOR_GETTER) {
211                        # Boolean getters are predicates and need
212                        # truthy/falsy tests in addition to getter tests
213
2
100
100
6
                        if(($schema->{output}{type} // '') eq $TYPE_BOOLEAN) {
214
1
3
                                $plan{$TEST_PREDICATE} = 1;
215                        }
216
2
5
                        $plan{$TEST_GETTER} = 1;
217
218                } elsif($acc_type eq $ACCESSOR_SETTER) {
219
1
4
                        $plan{$TEST_SETTER} = 1;
220
221                } elsif($acc_type eq $ACCESSOR_GETSET) {
222                        # For getset accessors, check the input parameter
223                        # type to determine if object injection or boolean
224                        # set tests are more appropriate
225
2
2
2
50
16
4
4
                        my ($param) = grep { !/^_/ } keys %{ $schema->{input} || {} };
226
2
33
5
                        my $param_type = ($param && $schema->{input}{$param}{type}) // '';
227
228
2
100
50
2
                        if($param_type eq $TYPE_OBJECT) {
229
1
2
                                $plan{$TEST_OBJECT_INJECT} = 1;
230                        } elsif($param_type eq $TYPE_BOOLEAN) {
231
0
0
                                $plan{$TEST_BOOLEAN_SET} = 1;
232                        }
233
2
7
                        $plan{$TEST_GETSET} = 1;
234                }
235        }
236
237        # --------------------------------------------------
238        # Void return type — verify the method returns nothing
239        # and does not accidentally return a useful value
240        # --------------------------------------------------
241
13
100
100
33
        if(($schema->{output}{type} // '') eq $TYPE_VOID) {
242
1
10
                $plan{$TEST_VOID} = 1;
243        }
244
245        # --------------------------------------------------
246        # Error handling — verify error return conventions
247        # are tested explicitly
248        # --------------------------------------------------
249
13
100
100
42
        if($schema->{output}{_error_return}
250        || $schema->{output}{success_failure_pattern}) {
251
2
2
                $plan{$TEST_ERROR_HANDLING} = 1;
252        }
253
254        # --------------------------------------------------
255        # Boundary hints from YAML test configuration —
256        # generate boundary/equivalence class tests
257        # --------------------------------------------------
258
13
1
50
67
17
2
        if($schema->{_yamltest_hints} && keys %{ $schema->{_yamltest_hints} }) {
259
1
1
                $plan{$TEST_BOUNDARY} = 1;
260        }
261
262        # --------------------------------------------------
263        # Method chaining — verify that $self is returned
264        # and that calls can be chained
265        # --------------------------------------------------
266
13
100
14
        if($schema->{output}{_returns_self}) {
267
1
1
                $plan{$TEST_CHAINING} = 1;
268        }
269
270        # --------------------------------------------------
271        # Boolean output — needs predicate tests regardless
272        # of whether an accessor was detected
273        # --------------------------------------------------
274
13
100
100
20
        if(($schema->{output}{type} // '') eq $TYPE_BOOLEAN) {
275
2
4
                $plan{$TEST_PREDICATE} = 1;
276        }
277
278        # --------------------------------------------------
279        # Always generate at least a basic call test even
280        # if no other test types were identified
281        # --------------------------------------------------
282
13
100
30
        $plan{$TEST_BASIC} = 1 unless %plan;
283
284
13
19
        return \%plan;
285}
286
2871;