view release on metacpan or  search on metacpan

t/Mutation-BooleanNegation.t  view on Meta::CPAN

# ==================================================================
# mutate -- ID uniqueness across same-line returns (col differentiates)
# ==================================================================
subtest 'mutate: IDs are unique across same file' => sub {
	my $m   = _mutation();
	my $doc = _doc(<<'CODE');
sub a { return $x; }
sub b { return $y; }
sub c { return $z; }
CODE

	my @mutants = $m->mutate($doc);
	is(scalar @mutants, 3, 'three mutants for three subs');

	my %ids = map { $_->id => 1 } @mutants;
	is(scalar keys %ids, 3, 'all IDs distinct across different lines');

	done_testing();
};

# ==================================================================
# mutate -- transform applies negation correctly
# ==================================================================
subtest 'mutate: transform negates return expression' => sub {
	my $m   = _mutation();
	my $src = 'sub foo { return $ok; }';
	my $doc = _doc($src);

	my @mutants = $m->mutate($doc);
	is(scalar @mutants, 1, 'one mutant produced');

	# Apply the transform to a fresh copy of the document
	my $copy = _doc($src);
	$mutants[0]->transform->($copy);

	# The transformed document must contain the negation
	my $transformed = $copy->serialize;
	like($transformed, qr/!\(/, 'transform inserts negation operator');
	like($transformed, qr/!\(\s*\$ok\s*\)/, 'negation wraps original expression');

	done_testing();
};

# ==================================================================
# mutate -- transform targets correct line when multiple returns exist
# ==================================================================
subtest 'mutate: transform targets correct return statement' => sub {
	my $m   = _mutation();
	my $src = <<'CODE';
sub check {
	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");
	}

	done_testing();
};

# ==================================================================
# mutate -- transform does not modify the original document
# ==================================================================
subtest 'mutate: transform does not modify original document' => sub {
	my $m   = _mutation();
	my $src = 'sub foo { return $ok; }';
	my $doc = _doc($src);

	my @mutants = $m->mutate($doc);

	# Capture original serialisation before transform
	my $before = $doc->serialize;

	# Apply transform to a different copy
	my $copy = _doc($src);
	$mutants[0]->transform->($copy);

	# Original document must be unchanged
	is($doc->serialize, $before, 'original document not modified by transform');

	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
# ==================================================================
subtest 'mutate: group field contains line number' => sub {
	my $m   = _mutation();
	my $doc = _doc(<<'CODE');
sub foo {
	return $a;
	return $b;
}
CODE

	my @mutants = $m->mutate($doc);
	is(scalar @mutants, 2, 'two mutants produced');

	for my $mut (@mutants) {
		like($mut->group, qr/^BOOL_NEGATE:\d+$/,
			'group has correct format for mutant ' . $mut->id);

		# Group must contain the same line number as the ID
		my ($id_line)    = $mut->id    =~ /BOOL_NEGATE_(\d+)/;
		my ($group_line) = $mut->group =~ /BOOL_NEGATE:(\d+)/;
		is($id_line, $group_line,
			'group line matches ID line for mutant ' . $mut->id);
	}

	done_testing();
};

# ==================================================================
# mutate -- various expression types are handled
# ==================================================================
subtest 'mutate: various expression types' => sub {
	my $m = _mutation();

	# Numeric literal
	my @mutants = $m->mutate(_doc('sub foo { return 1; }'));
	is(scalar @mutants, 1, 'numeric literal return produces mutant');

	# String literal
	@mutants = $m->mutate(_doc("sub foo { return 'ok'; }"));
	is(scalar @mutants, 1, 'string literal return produces mutant');

	# Method call
	@mutants = $m->mutate(_doc('sub foo { return $self->is_valid(); }'));
	is(scalar @mutants, 1, 'method call return produces mutant');

	# Comparison expression
	@mutants = $m->mutate(_doc('sub foo { return $x > 0; }'));
	is(scalar @mutants, 1, 'comparison return produces mutant');

	# Undef return