App-Test-Generator
view release on metacpan or search on metacpan
output:
type: string
min: 0 # Auto-detects: defined, min_length >= 0
max: 10000
properties: # Additional custom checks:
- name: no_scripts
code: $result !~ /<script/i
- name: no_iframes
code: $result !~ /<iframe/i
## GENERATED OUTPUT
The generated test:
- Seeds RND (if configured) for reproducible fuzz runs
- Uses edge cases (per-field and per-type) with configurable probability
- Runs `$iterations` fuzz cases plus appended edge-case runs
- Validates inputs with Params::Get / Params::Validate::Strict
- Validates outputs with [Return::Set](https://metacpan.org/pod/Return%3A%3ASet)
- Runs static `is(... )` corpus tests from Perl and/or YAML corpus
- Runs [Test::LectroTest](https://metacpan.org/pod/Test%3A%3ALectroTest) tests
bin/test-generator-index view on Meta::CPAN
cp ../App-Test-Generator/scripts/test-generator-index scripts/
It is invoked automatically by C<scripts/generate_test_dashboard> on
each CI push via C<.github/workflows/dashboard.yml>.
=head1 SYNOPSIS
https://$github_user.github.io/$github_repo/coverage/
=head1 INPUTS
cover_html/cover.json - Devel::Cover JSON report (statement/branch/condition)
mutation.json - Mutation testing results from test-generator-mutate
cover_html/lcsaj_hits.json - LCSAJ path hit data from the LCSAJ runtime debugger
cover_html/mutation_html/lib/ - Per-file LCSAJ path definitions (.lcsaj.json)
coverage_history/*.json - Historical coverage snapshots for the trend chart
=head1 OUTPUTS
cover_html/index.html - Main dashboard (coverage table, trend chart,
CPAN Testers failures, mutation report)
cover_html/mutation_html/ - Per-file mutation heatmap pages
=head1 OPTIONS
--generate_mutant_tests=DIR
Generate a timestamped test stub file in DIR (typically 'xt/') for
surviving mutants. The file is named mutant_YYYYMMDD_HHMMSS.t and
bin/test-generator-index view on Meta::CPAN
TEST
}
# ---------------------------------------------------------
# Boolean mutation
# ---------------------------------------------------------
if($type && $type =~ /BOOL|NEGATION/) {
return <<"TEST";
# Boolean branch test suggestion
ok( !func(INPUT), 'Verify boolean branch behaviour' );
TEST
}
# ---------------------------------------------------------
# Return value mutation
# ---------------------------------------------------------
if($type && $type =~ /RETURN/) {
return <<"TEST";
# Return value assertion
is( func(INPUT), EXPECTED, 'Verify correct return value' );
TEST
}
return;
}
# --------------------------------------------------
# _survivor_class
#
# Purpose: Map a survivor count to the appropriate
doc/SchemaExtractor.pm view on Meta::CPAN
## How It Works
### 1. POD Analysis
The extractor looks for parameter documentation in POD:
```perl
=head2 validate_email($email)
=head3 INPUT
$email - string (5-254 chars), email address
Returns: 1 if valid
=cut
```
Extracts:
- Type: `string`
- Min: `5`
lib/App/Test/Generator.pm view on Meta::CPAN
output:
type: string
min: 0 # Auto-detects: defined, min_length >= 0
max: 10000
properties: # Additional custom checks:
- name: no_scripts
code: $result !~ /<script/i
- name: no_iframes
code: $result !~ /<iframe/i
=head2 GENERATED OUTPUT
The generated test:
=over 4
=item * Seeds RND (if configured) for reproducible fuzz runs
=item * Uses edge cases (per-field and per-type) with configurable probability
=item * Runs C<$iterations> fuzz cases plus appended edge-case runs
lib/App/Test/Generator/Planner.pm view on Meta::CPAN
use App::Test::Generator::Planner::Grouping;
our $VERSION = '0.39';
# Accessor type strings used in plan_all() strategy mapping
Readonly my $ACCESSOR_GET => 'get';
Readonly my $ACCESSOR_GETSET => 'getset';
Readonly my $ACCESSOR_INJECTOR => 'injector';
# Output type string for boolean detection
Readonly my $OUTPUT_BOOLEAN => 'boolean';
=head1 VERSION
Version 0.39
=head2 new
Construct a new Planner instance.
my $planner = App::Test::Generator::Planner->new(
lib/App/Test/Generator/Planner.pm view on Meta::CPAN
$plan{getter_test} = 1;
} elsif($type eq $ACCESSOR_GETSET) {
$plan{getset_test} = 1;
} elsif($type eq $ACCESSOR_INJECTOR) {
# Object injection requires a mock object in the test
$plan{object_injection_test} = 1;
}
}
# Boolean output type requires a predicate test
if($schema->{output}->{type} && $schema->{output}->{type} eq $OUTPUT_BOOLEAN) {
$plan{boolean_test} = 1;
}
$method_plan{$method} = \%plan;
}
return \%method_plan;
}
# --------------------------------------------------
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
# Getter
# -------------------------------
my $property = $1;
# Don't flag mutators like
# sub foo {
# my $self = shift;
# $self->{bar} = shift;
# return $self->{bar};
# }
# Only exclude if the property is being set FROM EXTERNAL INPUT
if($code !~ /\$self\s*->\s*\{\s*['"]?\Q$property\E['"]?\s*\}\s*=\s*(?:shift|\$\w+\s*=\s*shift|\@_|\$_\[\d+\])/) {
my @returns = $code =~ /return\b/g;
my @self_returns = $code =~ /return\s+\$self\s*->\s*\{\s*['"]?\Q$property\E['"]?\s*\}/g;
# it's a getter
if (scalar(@returns) == scalar(@self_returns)) {
# all returns are returning $self->{$property}, so it's a getter
$schema->{accessor} = {
type => 'getter',
property => $property,
};
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
# Side effects: Logs detections to stdout when
# verbose is set.
#
# Notes: Two patterns are tried: (1) a
# 'Returns:' section of up to 3 lines,
# and (2) an inline 'returns X' phrase.
# The section pattern takes precedence.
# --------------------------------------------------
sub _analyze_output_from_pod {
my ($self, $output, $pod) = @_;
my %VALID_OUTPUT_TYPES = map { $_ => 1 }
qw(string integer number float boolean arrayref hashref object coderef void undef);
if ($pod) {
# Pattern 0: =head4 Output formal spec (highest priority — explicit over heuristic)
# The outer container shape determines the return type:
# (...) — list/array of items
# [...] — arrayref (bare [] = empty/void, skip)
# {...} — hashref spec; look for type => inside, or isa => for object
if($pod =~ /=head4\s+Output\b(.*?)(?==head|\z)/si) {
my $block = $1;
$block =~ s/^\s+//;
if($block =~ /^\(/) {
$output->{type} = 'array';
$self->_log(" OUTPUT: type 'array' from =head4 Output list notation");
} elsif($block =~ /^\[/) {
unless($block =~ /^\[\s*\]/) {
$output->{type} = 'arrayref';
$self->_log(" OUTPUT: type 'arrayref' from =head4 Output arrayref notation");
}
} elsif($block =~ /^\{/) {
if($block =~ /type\s*=>\s*['"]?(\w[\w:]*?)['"]?\s*[,}]/i) {
my $type = lc($1);
$type = 'hashref' if $type eq 'hash';
$type = 'arrayref' if $type eq 'array';
if($VALID_OUTPUT_TYPES{$type}) {
$output->{type} = $type;
$self->_log(" OUTPUT: type '$type' from =head4 Output formal spec");
} elsif($block =~ /\bisa\s*=>/) {
$output->{type} = 'object';
$self->_log(" OUTPUT: type 'object' from =head4 Output isa spec");
}
} elsif($block =~ /\bisa\s*=>/) {
$output->{type} = 'object';
$self->_log(" OUTPUT: type 'object' from =head4 Output isa spec");
}
}
}
# Pattern 1: Returns: section
# Up to 3 lines
if ($pod =~ /Returns?:\s+([^\n]+(?:\n[^\n]+){0,2})/si) {
my $returns_desc = $1;
$returns_desc =~ s/^\s+|\s+$//g;
$self->_log(" OUTPUT: Found Returns section: $returns_desc");
# Try to infer type from description (skip if Pattern 0 already set type)
if (!$output->{type} && $returns_desc =~ /\b(string|text)\b/i) {
$output->{type} = 'string';
} elsif (!$output->{type} && $returns_desc =~ /\b(integer|int|count)\b/i) {
$output->{type} = 'integer';
} elsif (!$output->{type} && $returns_desc =~ /\b(float|decimal|number)\b/i) {
$output->{type} = 'number';
} elsif (!$output->{type} && $returns_desc =~ /\b(boolean|true|false)\b/i) {
$output->{type} = 'boolean';
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
}
# Look for specific values
if ($returns_desc =~ /\b1\s+(?:on\s+success|if\s+successful)\b/i) {
$output->{value} = 1;
if(defined($output->{'type'}) && ($output->{type} eq 'scalar')) {
$output->{type} = 'boolean';
} else {
$output->{type} ||= 'boolean';
}
$self->_log(" OUTPUT: Returns 1 on success");
} elsif ($returns_desc =~ /\b0\s+(?:on\s+failure|if\s+fail)\b/i) {
$output->{alt_value} = 0;
} elsif ($returns_desc =~ /dies\s+on\s+(?:error|failure)/i) {
$output->{_STATUS} = 'LIVES';
$self->_log(' OUTPUT: Should not die on success');
}
if ($returns_desc =~ /\b(true|false)\b/i) {
$output->{type} ||= 'boolean';
}
if ($returns_desc =~ /\bundef\b/i) {
$output->{optional} = 1;
}
}
# Pattern 2: Inline "returns X"
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
} else {
$type = 'integer';
}
} else {
$type = 'integer';
}
}
$type = 'arrayref' if !$type && $pod =~ /returns?\s+.+\slist\b/i;
# $output->{type} = $type if $type && $type !~ /^\d+$/;
if ($VALID_OUTPUT_TYPES{$type}) {
$output->{type} = $type;
$self->_log(" OUTPUT: Inferred type from POD: $type");
} else {
$self->_log(" OUTPUT: POD return type '$type' is not a valid type, ignoring");
}
}
}
}
# --------------------------------------------------
# _extract_defaults_from_pod
#
# Purpose: Extract default values for parameters
# from POD documentation using multiple
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
foreach my $ret (@all_returns) {
$ret =~ s/^\s+|\s+$//g;
# Match 0 or 1, even with conditions
$boolean_count++ if ($ret =~ /^(?:0|1)(?:\s|$)/);
}
# If most returns are 0 or 1, strongly suggest boolean
if ($boolean_count >= 2 && $boolean_count >= $total_count * 0.8) {
unless ($output->{type}) {
$output->{type} = 'boolean';
$self->_log(" OUTPUT: Early detection - $boolean_count/$total_count returns are 0/1, setting boolean");
}
}
}
my @return_statements;
if ($code =~ /return\s+bless\s*\{[^}]*\}\s*,\s*['"]?(\w+)['"]?/s) {
# Detect blessed refs
$output->{type} = 'object';
if($method_name eq 'new') {
# If we found the new() method, the object we're returning should be a sensible one
if($self->{_document} && (my $package_stmt = $self->{_document}->find_first('PPI::Statement::Package'))) {
$output->{isa} = $package_stmt->namespace();
$self->{_package_name} //= $output->{isa};
}
} else {
$output->{isa} = $1;
}
$self->_log(" OUTPUT: Bless found, inferring type from code is $output->{isa}");
} elsif ($code =~ /return\s+bless/s) {
$output->{type} = 'object';
if($method_name eq 'new') {
$output->{isa} = $self->_extract_package_name();
$self->_log(" OUTPUT: Bless found, inferring type from code is $output->{isa}");
} else {
$self->_log(' OUTPUT: Bless found, inferring type from code is object');
}
} elsif ($code =~ /return\s*\(\s*[^)]+\s*,\s*[^)]+\s*\)\s*;/) {
# Detect array context returns - must end with semicolon to be actual return
$output->{type} = 'array'; # Not arrayref - actual array
$self->_log(' OUTPUT: Found array contect return');
} elsif ($code =~ /return\s+bless[^,]+,\s*__PACKAGE__/) {
# Detect: bless {}, __PACKAGE__
$output->{type} = 'object';
# Get package name from the extractor's stored document
if ($self->{_document}) {
my $pkg = $self->{_document}->find_first('PPI::Statement::Package');
$output->{isa} = $pkg ? $pkg->namespace : 'UNKNOWN';
$self->_log(' OUTPUT: Object blessed into __PACKAGE__: ' . ($output->{isa} || 'UNKNOWN'));
$self->{_package_name} //= $output->{isa};
}
} elsif ($code =~ /return\s*\(([^)]+)\)/) {
my $content = $1;
if ($content =~ /,/) { # Has comma = multiple values
$output->{type} = 'array';
}
} elsif ($code =~ /return\s+\$self\s*;/ && $code =~ /\$self\s*->\s*\{[^}]+\}\s*=/) {
# Returns $self for chaining
$output->{type} = 'object';
if ($self->{_document}) {
my $pkg = $self->{_document}->find_first('PPI::Statement::Package');
$output->{isa} = $pkg ? $pkg->namespace : 'UNKNOWN';
$self->_log(' OUTPUT: Object chained into __PACKAGE__: ' . ($output->{isa} || 'UNKNOWN'));
$self->{_package_name} //= $output->{isa};
}
}
# Find all return statements
while ($code =~ /return\s+([^;]+);/g) {
my $return_expr = $1;
push @return_statements, $return_expr;
}
if (@return_statements) {
$self->_log(' OUTPUT: Found ' . scalar(@return_statements) . ' return statement(s)');
# Analyze return patterns
my %return_types;
if($output->{'type'}) {
$return_types{$output->{'type'}} += 3; # Add weighting to what's already been found
}
my $min;
foreach my $ret (@return_statements) {
$ret =~ s/^\s+|\s+$//g;
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
# Don't match ->
(?:
\+ | -\b | \* | / | %
| \+\+ | --
)
}x) {
$return_types{number} += 2;
} elsif ($ret =~ /\|\|\s*\d+\b/) {
# Logical-or fallback with numeric literal (e.g. $x || 200)
$return_types{integer} += 2;
$self->_log(" OUTPUT: Numeric fallback expression detected");
} elsif($ret =~ /^length[\s\(]/) {
$return_types{integer}++;
$min = 0;
} elsif($ret =~ /^pos[\s\(]/) {
$return_types{integer}++;
$min = 0;
} elsif($ret =~ /^index[\s\(]/) {
$return_types{integer}++;
$min = -1;
} elsif($ret =~ /^rindex[\s\(]/) {
$return_types{integer}++;
$min = -1;
} elsif($ret =~ /^ord[\s\(]/) {
$return_types{integer}++;
} elsif ($ret =~ /=/ && $ret =~ /\$\w+/) {
# Assignment returning a value (e.g. $self->{status} = $status)
# If assignment involves a numeric literal or variable, assume numeric intent
if ($ret =~ /\b\d+\b/) {
$return_types{integer} += 2;
$self->_log(" OUTPUT: Assignment with numeric value detected");
} else {
$return_types{scalar}++;
}
}
# Variables/expressions
elsif ($ret =~ /\$\w+/) {
if ($ret =~ /\\\@/) {
$return_types{arrayref}++;
} elsif ($ret =~ /\\\%/) {
$return_types{hashref}++;
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
}
}
# Determine most common return type
if (keys %return_types) {
my ($most_common) = sort { $return_types{$b} <=> $return_types{$a} } keys %return_types;
# Prefer integer over scalar if numeric returns dominate
if ($return_types{integer} && (!$return_types{string})) {
if (!$output->{type} || $output->{type} eq 'scalar') {
$output->{type} = 'integer';
$self->_log(" OUTPUT: Numeric returns dominate, forcing integer");
$output->{_type_confidence} ||= 'low';
if(defined($min)) {
$output->{min} = $min;
}
}
}
unless ($output->{type}) {
$output->{type} = $most_common;
# Assign confidence for inferred numeric expressions
if ($most_common eq 'number') {
$output->{_type_confidence} ||= 'medium';
if(defined($min)) {
$output->{min} = $min;
}
}
$self->_log(" OUTPUT: Inferred type from code: $most_common");
}
}
# Check for consistent single value returns
if (@return_statements == 1 && $return_statements[0] eq '1') {
$output->{value} = 1;
$output->{type} = 'boolean' if !$output->{type} || $output->{type} eq 'scalar';
$self->_log(" OUTPUT: Type already set to '$output->{type}', overriding with boolean") if($output->{'type'});
}
} else {
# No explicit return - might return nothing or implicit undef
$self->_log(" OUTPUT: No explicit return statement found");
}
}
}
# --------------------------------------------------
# _enhance_boolean_detection
#
# Purpose: Apply additional boolean-specific
# detection heuristics using a weighted
# scoring system, to override weak
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
my $boolean_score = 0; # Track evidence for boolean return
return unless !$output->{type} || $output->{type} eq 'unknown';
# Look for stronger boolean indicators
if ($pod && !$output->{type}) {
# Common boolean return patterns in POD
if ($pod =~ /returns?\s+(true|false|true|false|1|0)\s+(?:on|for|upon)\s+(success|failure|error|valid|invalid)/i) {
$boolean_score += 30;
$self->_log(' OUTPUT: Strong boolean indicator in POD (+30)');
}
# Check for method names that suggest boolean returns
if ($pod =~ /(?:method|sub)\s+(\w+)/) {
my $inferred_method_name = $1;
if ($inferred_method_name =~ /^(is_|has_|can_|should_|contains_|exists_)/) {
$boolean_score += 20;
$self->_log(" OUTPUT: Inferred method name '$inferred_method_name' suggests boolean return (+20)");
}
}
}
# Analyze code for boolean patterns
if ($code) {
# Count boolean return idioms
my $true_returns = () = $code =~ /return\s+1\s*;/g;
my $false_returns = () = $code =~ /return\s+0\s*;/g;
if ($true_returns + $false_returns >= 2) {
$boolean_score += 40;
$self->_log(' OUTPUT: Multiple 1/0 returns suggest boolean (+40)');
} elsif ($true_returns + $false_returns == 1) {
$boolean_score += 10;
$self->_log(' OUTPUT: Single 1/0 return (+10)');
}
# Ternary operators that return booleans
if ($code =~ /return\s+(?:\w+\s*[!=]=\s*\w+|\w+\s*>\s*\w+|\w+\s*<\s*\w+)\s*\?\s*(?:1|0)\s*:\s*(?:1|0)/) {
$boolean_score += 25;
$self->_log(' OUTPUT: Ternary with 1/0 suggests boolean (+25)');
}
# Check for common boolean method patterns
if ($code =~ /return\s+[!\$\@\%]/) {
# Returns negation or existence check
$boolean_score += 15;
$self->_log(' OUTPUT: Returns negation/existence check (+15)');
}
}
# Check method name for boolean indicators
if ($method_name) {
if ($method_name =~ /^(is_|has_|can_|should_|contains_|exists_|check_|verify_|validate_)/) {
$boolean_score += 25;
$self->_log(" OUTPUT: Method name '$method_name' suggests boolean return (+25)");
}
if ($method_name =~ /_ok$/) {
$boolean_score += 30;
$self->_log(" OUTPUT: Method name '$method_name' ends with '_ok' (+30)");
}
}
# Apply boolean type if we have strong evidence
# Override weak type assignments (like 'array' from false positive)
if($boolean_score >= $BOOLEAN_SCORE_THRESHOLD) {
if (!$output->{type} || $output->{type} eq 'scalar' || $output->{type} eq 'array' || $output->{type} eq 'undef') {
my $old_type = $output->{type} || 'none';
$output->{type} = 'boolean';
$self->_log(" OUTPUT: Boolean score $boolean_score >= $BOOLEAN_SCORE_THRESHOLD, setting type to boolean (was: $old_type)");
}
}
}
# --------------------------------------------------
# _detect_list_context
#
# Purpose: Detect methods that return different
# values depending on calling context
# via wantarray, and methods that
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
# Side effects: Logs detections to stdout when
# verbose is set.
# --------------------------------------------------
sub _detect_list_context {
my ($self, $output, $code) = @_;
return unless $code;
# Check for wantarray usage
if ($code =~ /wantarray/) {
$output->{_context_aware} = 1;
$self->_log(' OUTPUT: Method uses wantarray - context sensitive');
# Debug: show what we're matching against
if ($code =~ /(wantarray[^;]+;)/s) {
$self->_log(" DEBUG wantarray line: $1");
}
if ($code =~ /wantarray\s*\?\s*\(([^)]+)\)\s*:\s*([^;]+)/s) {
# Pattern 1: wantarray ? (list, items) : scalar_value (with parens)
my ($list_return, $scalar_return) = ($1, $2);
$self->_log(" DEBUG list (with parens): [$list_return], scalar: [$scalar_return]");
$output->{_list_context} = $self->_infer_type_from_expression($list_return);
$output->{_scalar_context} = $self->_infer_type_from_expression($scalar_return);
$self->_log(' OUTPUT: Detected context-dependent returns (parenthesized)');
} elsif ($code =~ /wantarray\s*\?\s*([^:]+?)\s*:\s*([^;]+)/s) {
# Pattern 2: wantarray ? @array : scalar (no parens around list)
my ($list_return, $scalar_return) = ($1, $2);
# Clean up
$list_return =~ s/^\s+|\s+$//g;
$scalar_return =~ s/^\s+|\s+$//g;
$self->_log(" DEBUG list (no parens): [$list_return], scalar: [$scalar_return]");
$output->{_list_context} = $self->_infer_type_from_expression($list_return);
$output->{_scalar_context} = $self->_infer_type_from_expression($scalar_return);
$self->_log(' OUTPUT: Detected context-dependent returns (non-parenthesized)');
} elsif ($code =~ /return[^;]*unless\s+wantarray.*?return\s*\(([^)]+)\)/s) {
# Pattern 3: return unless wantarray; return (list);
$output->{_list_context} = { type => 'array' };
$self->_log(' OUTPUT: Detected list context return after wantarray check');
}
}
# Detect explicit list returns (multiple values in parentheses)
# Avoid false positives from function calls
if ($code =~ /return\s*\(\s*([^)]+)\s*\)\s*;/) {
my $content = $1;
# Count commas outside of nested structures
my $comma_count = 0;
my $depth = 0;
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
$depth++ if $char eq '(' || $char eq '[' || $char eq '{';
$depth-- if $char eq ')' || $char eq ']' || $char eq '}';
$comma_count++ if $char eq ',' && $depth == 0;
}
if ($comma_count > 0 && $content !~ /\b(?:bless|new)\b/) {
# Multiple values returned
unless ($output->{type} && $output->{type} eq 'boolean') {
$output->{type} = 'array';
$output->{_list_return} = $comma_count + 1;
$self->_log(' OUTPUT: Returns list of ' . ($comma_count + 1) . ' values');
}
}
}
}
# --------------------------------------------------
# _detect_void_context
#
# Purpose: Detect methods that return nothing
# meaningful (void context), methods
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
'setter' => qr/^set_\w+$/,
'mutator' => qr/^(?:add|remove|delete|clear|reset|update)_/,
'logger' => qr/^(?:log|debug|warn|error|info)$/,
'printer' => qr/^(?:print|say|dump)_/,
};
# Check if method name suggests void context
foreach my $type (keys %$void_patterns) {
if ($method_name =~ $void_patterns->{$type}) {
$output->{_void_context_hint} = $type;
$self->_log(" OUTPUT: Method name suggests $type (typically void context)");
last;
}
}
# Analyze return statements
my @returns = $code =~ /return\s*([^;]*);/g;
$self->_log(' DEBUG Found ' . scalar(@returns) . ' return statements');
# Count different return patterns
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
foreach my $ret (@returns) {
$ret =~ s/^\s+|\s+$//g;
$self->_log(" DEBUG return value: [$ret]");
$no_value_returns++ if $ret eq '';
$no_value_returns++ if($ret =~ /^(if|unless)\s/);
$true_returns++ if $ret eq '1';
$self_returns++ if $ret eq '$self';
if ($ret =~ /\?\s*1\s*:\s*0\b/) {
# Strong boolean signal: ternary returning 1/0
$true_returns++;
# $self->_log(" OUTPUT: Ternary 1:0 return detected, treating as boolean (+40)");
$self->_log(' OUTPUT: Ternary 1:0 return detected, treating as boolean');
}
}
my $total_returns = scalar(@returns);
$self->_log(" DEBUG no_value=$no_value_returns, true=$true_returns, self=$self_returns, total=$total_returns");
# Void context indicators
if ($no_value_returns > 0 && $no_value_returns == $total_returns) {
$output->{_void_context} = 1;
$output->{type} = 'void'; # This should override any previous type
$self->_log(' OUTPUT: All returns are empty - void context method');
} elsif ($true_returns > 0 && $true_returns == $total_returns && $total_returns >= 1) {
# Methods that always return true (success indicator)
$output->{_success_indicator} = 1;
# Don't override type if already set to boolean
unless ($output->{type} && $output->{type} eq 'boolean') {
$output->{type} = 'boolean';
}
$self->_log(' OUTPUT: Always returns 1 - success indicator pattern');
}
}
# --------------------------------------------------
# _detect_chaining_pattern
#
# Purpose: Detect methods that return $self for
# fluent interface chaining, by counting
# the proportion of return statements
# that return $self.
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
$output->{type} = 'object';
$output->{_returns_self} = 1;
# Get the class name
if ($self->{_document}) {
my $pkg = $self->{_document}->find_first('PPI::Statement::Package');
$output->{isa} = $pkg ? $pkg->namespace : 'UNKNOWN';
$self->{_package_name} //= $output->{isa};
}
$self->_log(" OUTPUT: Chainable method - returns \$self ($self_returns/$total_returns returns)");
}
}
}
# --------------------------------------------------
# _detect_error_conventions
#
# Purpose: Analyse how a method signals errors
# by detecting patterns such as
# 'return undef if', implicit bare
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
}
}
# Detect success/failure return pattern
my @all_returns = $code =~ /return\s+([^;]+);/g;
my $has_undef = grep { /^\s*undef\s*(?:if|unless|$)/ } @all_returns;
my $has_value = grep { !/^\s*undef\s*$/ && !/^\s*$/ } @all_returns;
if ($has_undef && $has_value && scalar(@all_returns) >= 2) {
$output->{_success_failure_pattern} = 1;
$self->_log(" OUTPUT: Uses success/failure return pattern");
}
# Store error conventions in output
if(scalar(keys %error_patterns)) {
$output->{_error_handling} = \%error_patterns;
# Determine primary error convention
if ($error_patterns{undef_on_error}) {
$output->{_error_return} = 'undef';
$self->_log(" OUTPUT: Returns undef on error");
} elsif ($error_patterns{implicit_undef}) {
$output->{_error_return} = 'undef';
$self->_log(" OUTPUT: Returns implicit undef on error");
} elsif ($error_patterns{empty_list}) {
$output->{_error_return} = 'empty_list';
$self->_log(" OUTPUT: Returns empty list on error");
} elsif ($error_patterns{zero_on_error}) {
$output->{_error_return} = 'false';
$self->_log(" OUTPUT: Returns 0/false on error");
}
if ($error_patterns{exception_handling}) {
$self->_log(" OUTPUT: Has exception handling");
}
} else {
delete $output->{_error_handling};
}
}
# --------------------------------------------------
# _infer_type_from_expression
#
# Purpose: Infer the data type of a return
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
my ($self, $output, $pod) = @_;
return unless $pod;
# Look for explicit chaining documentation
if ($pod =~ /returns?\s+(?:\$)?self\b/i ||
$pod =~ /chainable/i ||
$pod =~ /fluent\s+interface/i ||
$pod =~ /method\s+chaining/i) {
$output->{_returns_self} = 1;
$self->_log(" OUTPUT: POD indicates chainable/fluent interface");
}
}
# --------------------------------------------------
# _validate_output
#
# Purpose: Apply basic sanity checks to the
# assembled output hashref and warn
# about suspicious type combinations,
# normalising clearly invalid types to
lib/App/Test/Generator/Template.pm view on Meta::CPAN
# this is about verifying the transorms
my @tests;
diag("tests for transform $transform") if($ENV{'TEST_VERBOSE'});
# Now modify the foundation with test code
# BUILD CODE TO CALL FUNCTION
# CALL FUNCTION
# CHECK STATUS CORRECT
# IF STATUS EQ LIVES
# CHECK OUTPUT USING returns_ok
# FI
my $transform_input = $transforms{$transform}{'input'} || {};
foreach my $field (keys %input) {
my $spec = $transform_input->{$field} || {};
my $type = $spec->{type} || 'string';
# If there's a specific value, test that exact value
if (exists $spec->{value}) {
lib/Devel/App/Test/Generator/LCSAJ/Runtime.pm view on Meta::CPAN
open my $fh, '>', $out_file or croak "Cannot write $out_file: $!";
print $fh encode_json(\%HITS);
close $fh;
}
1;
__END__
=head1 OUTPUT FORMAT
C<cover_html/lcsaj_hits/hits_PID.json> is a JSON object of the form:
{
"lib/Foo/Bar.pm": { "12": 3, "15": 1, ... },
...
}
Keys are lib-relative paths (C<lib/...>); values are objects mapping line
numbers (as strings) to hit counts. One file is written per process so
t/test_extractor.t view on Meta::CPAN
open my $fh, '>', $test_module or die "Can't create test module: $!";
print $fh <<'END_MODULE';
package TestModule;
use strict;
use warnings;
use Carp qw(croak);
=head2 simple_string($name)
=head3 INPUT
$name - string (3-50 chars), person's name
=cut
sub simple_string {
my ($self, $name) = @_;
croak unless defined $name;
croak unless length($name) >= 3;
croak unless length($name) <= 50;
( run in 1.116 second using v1.01-cache-2.11-cpan-13bb782fe5a )