view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

	subtest 'unordered mode: empty vs empty' => sub {
		is_deeply(diff([], [], array_mode => 'unordered'), [], 'unordered: empty vs empty');
	};

	subtest 'unordered mode: single element same' => sub {
		is_deeply(diff([42], [42], array_mode => 'unordered'), [], 'unordered: single same');
	};

	subtest 'unordered mode: single element changed' => sub {
		my $r = diff([42], [99], array_mode => 'unordered');
		ok(scalar @$r > 0, 'unordered: single element change detected');
	};

	subtest 'unordered mode: all elements removed' => sub {
		my $r = diff([1, 2, 3], [], array_mode => 'unordered');
		my @removes = grep { $_->{op} eq 'remove' } @$r;
		is(scalar @removes, 3, 'unordered: all three elements removed');
	};

	subtest 'unordered mode: large reordered array: no changes' => sub {
		my @elems = map { "item_$_" } 1 .. 100;
		my @shuffled = reverse @elems;
		my $r = diff(\@elems, \@shuffled, array_mode => 'unordered');
		is_deeply($r, [], 'unordered: 100-element reversal: no changes');
	};

	subtest 'array_key with missing key field: no exception' => sub {
		# Elements lack the nominated key field — must not die
		my $old = [{name => 'Alice'}, {name => 'Bob'}];
		my $new = [{name => 'Bob'},   {name => 'Alice'}];
		lives_ok(
			sub { diff($old, $new, array_mode => 'unordered', array_key => 'id') },
			'array_key with missing field: no exception'
		);
	};

};

# ===========================================================================
# 15. Renderer edge cases
# ===========================================================================

subtest 'Renderer edge cases' => sub {

	subtest 'diff_text: value containing newline renders without breaking structure' => sub {
		my $r = diff({x => "line1\nline2"}, {x => "line1\nline3"});
		my $t;
		lives_ok(sub { $t = diff_text({x => "line1\nline2"}, {x => "line1\nline3"}) },
			'diff_text: newline in value: no exception');
		ok(defined $t, 'diff_text: defined output for newline value');
	};

	subtest 'diff_json: value containing double-quote is valid JSON' => sub {
		require JSON::MaybeXS;
		my $j;
		lives_ok(
			sub { $j = diff_json({x => 'say "hello"'}, {x => 'say "goodbye"'}) },
			'diff_json: quote in value: no exception'
		);
		my $decoded = eval { JSON::MaybeXS::decode_json($j) };
		ok(!$@, 'diff_json: quote in value: valid JSON output');
	};

	subtest 'diff_json: Unicode value produces valid JSON' => sub {
		require JSON::MaybeXS;
		my $j = diff_json({x => "caf\x{e9}"}, {x => "caf\x{e8}"});
		my $decoded = eval { JSON::MaybeXS::decode_json($j) };
		ok(!$@, 'diff_json: Unicode value: valid JSON output');
	};

	subtest 'diff_test2: all lines carry "# " prefix for deep nested change' => sub {
		my $old = {a => {b => {c => {d => 1}}}};
		my $new = {a => {b => {c => {d => 2}}}};
		my $t   = diff_test2($old, $new);
		my @bad = grep { length($_) && $_ !~ /^# / } split /\n/, $t;
		is(scalar @bad, 0, 'diff_test2: no unpreFixed lines for deep change');
	};

	subtest 'diff_yaml: large change list renders without exception' => sub {
		my %old = map { ( "k$_" => $_ ) }      1 .. 50;
		my %new = map { ( "k$_" => $_ + 100 ) } 1 .. 50;
		lives_ok(sub { diff_yaml(\%old, \%new) }, 'diff_yaml: 50-change list: no exception');
	};

	subtest 'diff_text: empty string value renders without mangling path' => sub {
		my $t = diff_text({x => 'old'}, {x => ''});
		like($t, qr{/x}, 'diff_text: path /x present even when new value is empty string');
	};

};

# ===========================================================================
# 16. Idempotency: diffing the result of a merge must yield no changes
# ===========================================================================

subtest 'Idempotency: applying changes yields a structure with no further diff' => sub {

	# We manually apply the changes from diff() to reconstruct $new from $old,
	# then diff the result against the original $new — it must be empty.
	# This is a black-box end-to-end sanity check.

	my $old = {name => 'Alice', score => 10, active => 1};
	my $new = {name => 'Bob',   score => 20, active => 1};

	my $changes = diff($old, $new);

	# Apply changes manually
	my %reconstructed = %$old;
	for my $c (@$changes) {
		next unless $c->{op} eq 'change';
		# Extract the key from the path (single-level only for this test)
		(my $key = $c->{path}) =~ s{^/}{};
		$reconstructed{$key} = $c->{to};
	}

	my $residual = diff(\%reconstructed, $new);
	is_deeply($residual, [], 'applied changes produce no further diff against target');

};

# ===========================================================================
# 17. Stability: repeated calls with same input produce same output
# ===========================================================================

subtest 'Stability: repeated calls produce identical results' => sub {

	my $old = {a => 1, b => [1, 2, 3], c => {d => 'x'}};