App-Test-Generator
view release on metacpan or search on metacpan
Add fuzzy regex generator
Do basic hard-coded tests where possible, to get it started
Allow pathnames in the module name
Added qwrap - GitHub#1 - thanks to neo1ite
Don't try to fuzz input if no %input is given
Added %config - GitHub#2
Generate tests for routines that take one unnamed parameter - GitHub#2
Added fallback for perl_quote for hashes and objects
0.03 Mon Sep 29 18:18:36 EDT 2025
If minimum is not set, verify 0 or empty fields are allowable
Added the testing dashboard
Fixed handling of memberof in input/output array creation
If TEST_VERBOSE is set, print the generated dataset when running it
Always ensure mandatory strings are passed when testing other arguments
rand_int and rand_numb now also sometimes return very large and very small numbers
Put utf-8 and NUL bytes into strings
0.02 Sun Sep 28 09:03:49 EDT 2025
Use gtar on OS/X to generate the distro
Added edge case test generator for booleans and memberof
closedir($dh);
}
done_testing();
## Property-Based Testing with Transforms
The generator can create property-based tests using [Test::LectroTest](https://metacpan.org/pod/Test%3A%3ALectroTest) when the
`properties` configuration option is enabled.
This provides more comprehensive
testing by automatically generating thousands of test cases and verifying that
mathematical properties hold across all inputs.
### Basic Property-Based Transform Example
Here's a complete example testing the `abs` builtin function:
**t/conf/abs.yml**:
---
module: builtin
type: number
max: 0
output:
type: number
min: 0
This configuration:
- Enables property-based testing with 1000 trials per property
- Defines two transforms: one for positive numbers, one for negative
- Automatically generates properties that verify `abs()` always returns non-negative numbers
Generate the test:
fuzz-harness-generator t/conf/abs.yml > t/abs_property.t
The generated test will include:
- Traditional edge-case tests for boundary conditions
- Random fuzzing with 30 iterations (or as configured)
- Property-based tests that verify the transforms with 1000 trials each
### What Properties Are Tested?
The generator automatically detects and tests these properties based on your transform specifications:
- **Range constraints** - If output has `min` or `max`, verifies results stay within bounds
- **Type preservation** - Ensures numeric inputs produce numeric outputs
- **Definedness** - Verifies the function doesn't return `undef` unexpectedly
- **Specific values** - If output specifies a `value`, checks exact equality
For the `abs` example above, the generated properties verify:
# For the "positive" transform:
- Given a positive number, abs() returns >= 0
- The result is a valid number
- The result is defined
# For the "negative" transform:
- Given a negative number, abs() returns >= 0
- The result is a valid number
- The result is defined
doc/getting-started-blog.md view on Meta::CPAN
value: { type: number, value: 50 }
min: { type: number, value: 100 }
max: { type: number, value: 0 }
output:
_STATUS: DIES
iterations: 50
seed: 42
```
This generates tests that verify:
1. The math is correct (transforms)
2. Boundary conditions work (min=0 returns 0, max=100 returns 1)
3. Invalid inputs are rejected (inverted range dies)
4. Random inputs within range work correctly
## The Five-Minute Quick Start
### 1. Install the module
```bash
lib/App/Test/Generator.pm view on Meta::CPAN
closedir($dh);
}
done_testing();
=head2 Property-Based Testing with Transforms
The generator can create property-based tests using L<Test::LectroTest> when the
C<properties> configuration option is enabled.
This provides more comprehensive
testing by automatically generating thousands of test cases and verifying that
mathematical properties hold across all inputs.
=head3 Basic Property-Based Transform Example
Here's a complete example testing the C<abs> builtin function:
B<t/conf/abs.yml>:
---
module: builtin
lib/App/Test/Generator.pm view on Meta::CPAN
min: 0
This configuration:
=over 4
=item * Enables property-based testing with 1000 trials per property
=item * Defines two transforms: one for positive numbers, one for negative
=item * Automatically generates properties that verify C<abs()> always returns non-negative numbers
=back
Generate the test:
fuzz-harness-generator t/conf/abs.yml > t/abs_property.t
The generated test will include:
=over 4
=item * Traditional edge-case tests for boundary conditions
=item * Random fuzzing with 30 iterations (or as configured)
=item * Property-based tests that verify the transforms with 1000 trials each
=back
=head3 What Properties Are Tested?
The generator automatically detects and tests these properties based on your transform specifications:
=over 4
=item * B<Range constraints> - If output has C<min> or C<max>, verifies results stay within bounds
=item * B<Type preservation> - Ensures numeric inputs produce numeric outputs
=item * B<Definedness> - Verifies the function doesn't return C<undef> unexpectedly
=item * B<Specific values> - If output specifies a C<value>, checks exact equality
=back
For the C<abs> example above, the generated properties verify:
# For the "positive" transform:
- Given a positive number, abs() returns >= 0
- The result is a valid number
- The result is defined
# For the "negative" transform:
- Given a negative number, abs() returns >= 0
- The result is a valid number
- The result is defined
lib/App/Test/Generator/Emitter/Perl.pm view on Meta::CPAN
my \$result = eval { \$obj->$method(undef) };
ok(!\$result || \$@, '$method handles invalid input');
}
END_TEST
}
# --------------------------------------------------
# _emit_context_test
#
# Purpose: Emit tests that call the method in
# both scalar and list context to verify
# context-aware return behaviour.
#
# Entry: $method - method name string.
# Exit: Returns a string of Perl test code.
# Side effects: None.
# Notes: Uses eval to verify the calls survive
# rather than checking return values,
# since context-aware return values vary.
# --------------------------------------------------
sub _emit_context_test {
my ($self, $method) = @_;
return <<"END_TEST";
{
my \$scalar = eval { \$obj->$method() };
ok(!\$@, '$method survives in scalar context');
lib/App/Test/Generator/LCSAJ/Coverage.pm view on Meta::CPAN
a C<covered> key added to each path record.
=head3 Side effects
Writes to C<$out_file>. Croaks if any file cannot be read or written.
=head3 Notes
A path is considered covered if any line in the range C<start..end>
was executed at least once. This is a conservative approximation —
it does not verify that the jump target was actually reached. As a
result, coverage may be slightly overstated for paths where only the
beginning of the sequence was executed.
=head3 API specification
=head4 input
{
lcsaj_file => { type => SCALAR },
hits_file => { type => SCALAR },
lib/App/Test/Generator/Sample/Module.pm view on Meta::CPAN
=head4 output
{ type => 'number' }
=cut
sub mysterious_method {
my ($self, $thing) = @_;
# Intentionally unvalidated — used to verify that SchemaExtractor
# flags low-confidence schemas when no validation logic is present.
# Callers passing non-numeric values will trigger a Perl warning;
# this is expected behaviour for this test fixture.
return $thing * 2;
}
=head1 AUTHOR
Example Author
lib/App/Test/Generator/SchemaExtractor.pm view on Meta::CPAN
# 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
lib/App/Test/Generator/Template.pm view on Meta::CPAN
foreach my $transform (keys %transforms) {
my $foundation = _fill_foundation(); # basic set of data with every field filled in with a sensible default value
# The foundation should work
my $case = { _NAME => "basic $transform test", _LINE => __LINE__ };
my $positions = populate_positions(\%input);
run_test($case, $foundation, \%output, $positions);
# Generate transform tests
# Don't generate invalid data, that's all already done,
# 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
lib/App/Test/Generator/TestStrategy.pm view on Meta::CPAN
# to avoid uninitialized value warnings
# when schema fields are absent.
# --------------------------------------------------
sub _plan_for_method {
my ($self, $schema) = @_;
my %plan;
# --------------------------------------------------
# Context-aware returns need both scalar and list
# context tests to verify correct behaviour in each
# --------------------------------------------------
if($schema->{output}{_context_aware}) {
$plan{$TEST_CONTEXT} = 1;
}
# --------------------------------------------------
# Accessor detection — choose test types based on
# whether the method is a getter, setter, or both
# --------------------------------------------------
if($schema->{accessor} && scalar keys %{ $schema->{accessor} }) {
lib/App/Test/Generator/TestStrategy.pm view on Meta::CPAN
if($param_type eq $TYPE_OBJECT) {
$plan{$TEST_OBJECT_INJECT} = 1;
} elsif($param_type eq $TYPE_BOOLEAN) {
$plan{$TEST_BOOLEAN_SET} = 1;
}
$plan{$TEST_GETSET} = 1;
}
}
# --------------------------------------------------
# Void return type — verify the method returns nothing
# and does not accidentally return a useful value
# --------------------------------------------------
if(($schema->{output}{type} // '') eq $TYPE_VOID) {
$plan{$TEST_VOID} = 1;
}
# --------------------------------------------------
# Error handling — verify error return conventions
# are tested explicitly
# --------------------------------------------------
if($schema->{output}{_error_return}
|| $schema->{output}{success_failure_pattern}) {
$plan{$TEST_ERROR_HANDLING} = 1;
}
# --------------------------------------------------
# Boundary hints from YAML test configuration —
# generate boundary/equivalence class tests
# --------------------------------------------------
if($schema->{_yamltest_hints} && keys %{ $schema->{_yamltest_hints} }) {
$plan{$TEST_BOUNDARY} = 1;
}
# --------------------------------------------------
# Method chaining — verify that $self is returned
# and that calls can be chained
# --------------------------------------------------
if($schema->{output}{_returns_self}) {
$plan{$TEST_CHAINING} = 1;
}
# --------------------------------------------------
# Boolean output — needs predicate tests regardless
# of whether an accessor was detected
# --------------------------------------------------
t/Analyzer-Return.t view on Meta::CPAN
my @prop = grep { $_->{signal} eq 'returns_property' } @{$ev};
ok(scalar @const > 0, 'returns_constant detected in multi-signal method');
ok(scalar @prop > 0, 'returns_property detected in multi-signal method');
done_testing();
};
# ==================================================================
# analyze -- add_evidence is called with correct named args
# --------------------------------------------------
# Uses a spy to verify the exact call signature rather than
# relying on side effects collected via the mock object
# ==================================================================
subtest 'analyze calls add_evidence with correct named arguments' => sub {
my ($mock, $evidence) = _mock_method(
'sub name { my $self = shift; return $self->{name}; }'
);
# Spy on add_evidence to capture the exact arguments passed
my $spy = spy 'MockMethod::add_evidence';
t/CoverageGuided_Fuzzer_unit.t view on Meta::CPAN
},
target_sub => sub {
my $v = $_[0];
die "intentional error\n" if defined($v) && length($v) >= 1;
1;
},
iterations => 20,
seed => 42,
);
$f->run();
# May or may not find bugs depending on generated inputs — just verify
# the bugs arrayref is well-formed
for my $bug (@{$f->bugs()}) {
ok(exists $bug->{input}, 'bug entry has input key');
ok(exists $bug->{error}, 'bug entry has error key');
ok(defined $bug->{error}, 'bug error is defined');
}
};
# ==================================================================
# save_corpus()
t/Generator.t view on Meta::CPAN
subtest '_is_perl_builtin() returns 0 for undef' => sub {
is(_is_perl_builtin(undef), 0, 'undef -> 0');
};
subtest '_is_perl_builtin() returns 0 for empty string' => sub {
is(_is_perl_builtin(''), 0, 'empty string -> 0');
};
subtest 'Generator: generate() sort handles undef values correctly' => sub {
# The comparator at lines 1752-1761 handles undef $a and $b
# Test by generating output from two schemas and verifying order is stable
my ($fh1, $p1) = tempfile(SUFFIX => '.yml', UNLINK => 1);
print $fh1 "module: builtin\nfunction: beta\ninput:\n type: string\noutput:\n type: string\n";
close $fh1;
my ($fh2, $p2) = tempfile(SUFFIX => '.yml', UNLINK => 1);
print $fh2 "module: builtin\nfunction: alpha\ninput:\n type: string\noutput:\n type: string\n";
close $fh2;
my ($out1) = capture(sub { App::Test::Generator->generate($p1) });
my ($out2) = capture(sub { App::Test::Generator->generate($p2) });
isnt($out1, $out2, 'different function names produce different output');
};
t/Mutation-BooleanNegation.t view on Meta::CPAN
my ($x) = @_;
return 0 unless $x;
return $x > 0;
}
CODE
my $doc = _doc($src);
my @mutants = $m->mutate($doc);
is(scalar @mutants, 2, 'two mutants for two return-with-expression statements');
# Apply each transform to a fresh copy and verify only one return is negated
for my $mut (@mutants) {
my $copy = _doc($src);
$mut->transform->($copy);
my $transformed = $copy->serialize;
# Exactly one negation must appear in the transformed source
my @negs = ($transformed =~ /!\(/g);
is(scalar @negs, 1,
"transform for mutant ${\$mut->id} negates exactly one return");
}
t/Mutation-BooleanNegation.t view on Meta::CPAN
done_testing();
};
# ==================================================================
# mutate -- return value is a list (current API)
# ==================================================================
subtest 'mutate: returns a list' => sub {
my $m = _mutation();
my $doc = _doc('sub foo { return $x; return $y; }');
# Current API returns a flat list -- verify it can be assigned to an array
my @mutants = $m->mutate($doc);
is(scalar @mutants, 2, 'mutate returns flat list assignable to array');
# TODO: API should return arrayref for efficiency -- see note at end of file
done_testing();
};
# ==================================================================
# mutate -- group field is set correctly
t/Mutation-ConditionalInversion.t view on Meta::CPAN
sub check {
if($a) { return 1; }
if($b) { return 2; }
}
CODE
my $doc = _doc($src);
my @mutants = $m->mutate($doc);
is(scalar @mutants, 2, 'two mutants for two if statements');
# Apply each transform to a fresh copy and verify only one keyword flips
for my $mut (@mutants) {
my $copy = _doc($src);
$mut->transform->($copy);
my $transformed = $copy->serialize;
# Count how many unless keywords appear — exactly one should be added
my @unless_count = ($transformed =~ /\bunless\b/g);
is(scalar @unless_count, 1,
"transform for mutant ${\$mut->id} flips exactly one if to unless");
}
t/Mutation-ConditionalInversion.t view on Meta::CPAN
'original contains the condition expression');
};
# ==================================================================
# mutate -- conditional without a condition block is skipped
# ==================================================================
subtest 'mutate: conditional without condition block skipped' => sub {
my $m = _mutation();
# A well-formed if always has a condition -- test that the guard works
# by verifying normal operation first
my @mutants = $m->mutate(_doc('sub foo { if($x) { 1; } }'));
is(scalar @mutants, 1, 'normal if with condition produces one mutant');
};
# ==================================================================
# mutate -- ID uniqueness: group contains same line as ID
# ==================================================================
subtest 'mutate: group line matches ID line' => sub {
my $m = _mutation();
my $doc = _doc(<<'CODE');
t/Mutation-ReturnUndef.t view on Meta::CPAN
my ($x) = @_;
return 0 unless $x;
return $x > 0;
}
CODE
my $doc = _doc($src);
my @mutants = $m->mutate($doc);
is(scalar @mutants, 2, 'two mutants for two return-with-expression statements');
# Apply each transform to a fresh copy and verify only one expression is replaced
for my $mut (@mutants) {
my $copy = _doc($src);
$mut->transform->($copy);
my $transformed = $copy->serialize;
# Exactly one undef must appear in the transformed source
my @undefs = ($transformed =~ /\bundef\b/g);
is(scalar @undefs, 1,
"transform for mutant ${\$mut->id} replaces exactly one return expression");
}
t/SchemaExtractor_function.t view on Meta::CPAN
};
# ==================================================================
# _extract_class_methods — smoke test
# ==================================================================
subtest '_extract_class_methods() appends to methods arrayref' => sub {
my $e = _extractor();
my @methods;
my $code = "class Foo { method bar() { return 1; } }";
$e->_extract_class_methods($code, \@methods);
# May or may not find methods depending on class syntax — just verify no crash
ok(1, '_extract_class_methods ran without crash');
ok(ref(\@methods) eq 'REF' || ref(\@methods) eq 'ARRAY' || 1,
'methods array still usable');
};
# ==================================================================
# _parse_schema_hash and _extract_schema_hash_from_block
# ==================================================================
subtest '_parse_schema_hash() returns empty input for empty block' => sub {
t/SchemaExtractor_function.t view on Meta::CPAN
subtest '_extract_validator_schema() returns undef for empty string' => sub {
my $e = _extractor();
my $result = $e->_extract_validator_schema('');
ok(!defined $result, 'empty string -> undef');
};
subtest '_extract_validator_schema() dispatches to _extract_pvs_schema for validate_strict' => sub {
my $e = _extractor();
my $code = 'sub foo { my $p = validate_strict({ name => { type => "string" } }); }';
my $result = $e->_extract_validator_schema($code);
# May or may not parse depending on exact format — just verify no crash
ok(1, '_extract_validator_schema dispatched without crash');
};
subtest '_extract_validator_schema() dispatches to _extract_pv_schema for validate' => sub {
my $e = _extractor();
my $code = 'sub foo { my %a = validate(\@_, { x => { type => SCALAR } }); }';
my $result = $e->_extract_validator_schema($code);
ok(1, '_extract_validator_schema dispatched to pv extractor without crash');
};
t/SchemaExtractor_function.t view on Meta::CPAN
subtest '_extract_pv_schema() handles Params::Validate::validate fully-qualified form' => sub {
my $e = _extractor();
my $code = q{
sub foo {
my %args = Params::Validate::validate(\@_, {
x => { type => SCALAR },
});
}
};
my $result = $e->_extract_pv_schema($code);
# Just verify no crash — fully qualified form may or may not parse
ok(1, 'fully-qualified validate form handled without crash');
};
subtest '_extract_pv_schema() does not confuse validate_strict with validate' => sub {
my $e = _extractor();
# validate_strict should NOT be matched by _extract_pv_schema
# Both functions check for their keyword, but _extract_pv_schema
# should still attempt a match since 'validate' appears in 'validate_strict'
# The function will find it but the PPI parse may return nothing useful
my $code = q{
sub foo {
validate_strict(args => \@_, schema => { x => { type => 'string' } });
}
};
# No assertion on result — just verify no crash or exception
lives_ok(sub { $e->_extract_pv_schema($code) },
'validate_strict code does not crash _extract_pv_schema');
};
# ==================================================================
# _extract_moosex_params_schema — strengthened assertions
# ==================================================================
subtest '_extract_moosex_params_schema() returns undef when no validated_hash present' => sub {
my $e = _extractor();
t/Template_unit.t view on Meta::CPAN
subtest 'get_data_section() called as plain function returns same content' => sub {
my $class_result = App::Test::Generator::Template->get_data_section('test.tt');
my $plain_result = App::Test::Generator::Template::get_data_section('test.tt');
is(${ $class_result }, ${ $plain_result },
'class method and plain call return identical content');
};
subtest 'get_data_section() strips class name argument when called as method' => sub {
# Calling ->get_data_section('test.tt') must not treat the class name
# as the template name — verify the returned content is the template,
# not undef from looking up 'App::Test::Generator::Template'
my $result = App::Test::Generator::Template->get_data_section('test.tt');
ok(defined ${ $result }, 'content is defined — class name not used as key');
};
subtest 'get_data_section() returns ref to undef for unknown template name' => sub {
my $result = App::Test::Generator::Template->get_data_section('nonexistent.tt');
ok(ref($result), 'still returns a reference');
ok(!defined(${ $result }), 'dereferenced value is undef for unknown name');
};
t/extended_tests.t view on Meta::CPAN
subtest 'LCSAJ: _build_cfg fallthrough loop connects exactly i to i+1' => sub {
# Two sequential blocks with no branch — fallthrough must connect [0] to [1]
require PPI;
my $src = "sub foo { my \$x = 1; my \$y = 2; return \$x + \$y; }\n";
my $doc = PPI::Document->new(\$src);
my $sub = $doc->find_first('PPI::Statement::Sub');
my $blocks = _build_cfg($sub);
ok(scalar @{$blocks} >= 1, 'at least one block');
# For a linear sub the single block should have no edges (it's a leaf)
# or fallthrough to a next block — verify no crash
ok(1, '_build_cfg linear sub did not crash');
};
subtest 'LCSAJ: _build_cfg branch creates true and false successor blocks' => sub {
require PPI;
my $src = "sub foo { my \$x = shift; if(\$x > 0) { return 1; } return 0; }\n";
my $doc = PPI::Document->new(\$src);
my $sub = $doc->find_first('PPI::Statement::Sub');
my $blocks = _build_cfg($sub);
# With one if-branch: pre-branch block, true block, false block, post-branch
t/extended_tests.t view on Meta::CPAN
schema => { input => { type => 'string' } },
target_sub => sub { 1 },
iterations => 0,
seed => 42,
);
is(App::Test::Generator::CoverageGuidedFuzzer::_validate_value(
$f, undef, { type => 'string' }), 0, 'undef: always invalid');
};
# ==================================================================
# Stateful tests — verify state accumulates correctly across calls
# ==================================================================
subtest 'CoverageGuidedFuzzer: corpus accumulates across multiple run() calls' => sub {
my $f = App::Test::Generator::CoverageGuidedFuzzer->new(
schema => { input => { type => 'string' } },
target_sub => sub { length($_[0] // '') },
iterations => 5,
seed => 42,
);
$f->run();
t/function.t view on Meta::CPAN
# The _source key must be injected with the originating file path
ok(exists $schema->{_source}, '_source key injected');
is($schema->{_source}, $tmpfile, '_source contains the file path');
done_testing();
};
# ==================================================================
# generate (smoke tests)
# --------------------------------------------------
# End-to-end tests verifying that generate() produces
# a file that compiles and contains expected markers
# ==================================================================
subtest 'generate smoke' => sub {
my $dir = tempdir(CLEANUP => 1);
# Write a minimal valid schema to a temp file
my ($schema_fh, $schema_file) = tempfile(
DIR => $dir,
SUFFIX => '.yml',
UNLINK => 1,
t/integration.t view on Meta::CPAN
use warnings;
use Test::Most;
use Capture::Tiny qw(capture);
use File::Path qw(make_path);
use File::Temp qw(tempdir tempfile);
use File::Spec;
use YAML::XS qw(LoadFile);
# Integration tests for App::Test::Generator.
# Each subtest exercises end-to-end behaviour across multiple modules,
# verifying that they compose correctly and that state flows through
# the pipeline as documented.
BEGIN {
use_ok('App::Test::Generator');
use_ok('App::Test::Generator::SchemaExtractor');
use_ok('App::Test::Generator::Planner');
use_ok('App::Test::Generator::Emitter::Perl');
use_ok('App::Test::Generator::Mutator');
use_ok('App::Test::Generator::LCSAJ');
use_ok('App::Test::Generator::CoverageGuidedFuzzer');
t/integration.t view on Meta::CPAN
my $err = $@;
chdir $orig;
die $err if $err;
return @mutants;
}
# ==================================================================
# PIPELINE 1: SchemaExtractor -> Generator
#
# Extract schemas from a real .pm file, feed them directly into
# Generator::generate(), verify the produced test files are runnable.
# ==================================================================
subtest 'SchemaExtractor -> Generator: extract then generate test file' => sub {
my ($pm, $tmpdir) = _make_sample_module();
my $out_dir = File::Spec->catdir($tmpdir, 'schemas');
mkdir $out_dir or die $!;
# Step 1: extract schemas
my $extractor = App::Test::Generator::SchemaExtractor->new(
input_file => $pm,
t/integration.t view on Meta::CPAN
plans => $plans,
package => 'Sample::Calculator',
);
my $code = $emitter->emit();
like($code, qr/get\/set works/, 'emitted code contains getset block');
};
# ==================================================================
# PIPELINE 3: Mutator -> full mutation cycle on a real module
#
# Generate mutants, prepare workspace, apply each mutant, verify
# the workspace copy is modified while the original is unchanged.
# ==================================================================
subtest 'Mutator: generate -> prepare_workspace -> apply_mutant pipeline' => sub {
my ($pm, $tmpdir) = _make_sample_module();
require Cwd;
my $orig = Cwd::cwd();
chdir $tmpdir or die $!;
my $rel_lib = 'lib';
t/mutator_num_boundary.t view on Meta::CPAN
# --------------------------------------------------
# Verify expected mutations exist
# --------------------------------------------------
my @ids = map { $_->id } @mutants;
ok(grep(/^NUM_BOUNDARY_\d+_\d+_/, @ids), 'IDs formatted correctly');
# --------------------------------------------------
# Apply one mutant and verify operator changed
# --------------------------------------------------
my ($first) = @mutants;
my $clone = PPI::Document->new(\$source);
$first->{transform}->($clone);
like($clone->serialize, qr/!=|>=|<=|<|>/, 'Operator was transformed');
done_testing();
( run in 2.607 seconds using v1.01-cache-2.11-cpan-13bb782fe5a )