Data-Hash-Diff-Smart
view release on metacpan or search on metacpan
t/edge_cases.t view on Meta::CPAN
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');
};
t/extended_tests.t view on Meta::CPAN
};
# ===========================================================================
# 11. diff_yaml: structural round-trip
# The YAML output must decode back to a structure that faithfully
# represents the change list.
# ===========================================================================
subtest 'diff_yaml: structural round-trip' => sub {
subtest 'decoded YAML is an arrayref of hashrefs' => sub {
require YAML::XS;
my $y = diff_yaml({a => 1}, {a => 2});
my $decoded = YAML::XS::Load($y);
isa_ok($decoded, 'ARRAY', 'decoded YAML is arrayref');
isa_ok($decoded->[0], 'HASH', 'first element is hashref');
};
subtest 'decoded YAML preserves op field' => sub {
require YAML::XS;
my $decoded = YAML::XS::Load(diff_yaml({a => 1}, {a => 2}));
is($decoded->[0]{op}, 'change', 'op=change preserved through YAML');
};
subtest 'decoded YAML preserves path field' => sub {
require YAML::XS;
my $decoded = YAML::XS::Load(diff_yaml({name => 'A'}, {name => 'B'}));
is($decoded->[0]{path}, '/name', 'path preserved through YAML');
};
subtest 'decoded YAML preserves from and to fields' => sub {
require YAML::XS;
my $decoded = YAML::XS::Load(diff_yaml({x => 'old'}, {x => 'new'}));
is($decoded->[0]{from}, 'old', 'from preserved through YAML');
is($decoded->[0]{to}, 'new', 'to preserved through YAML');
};
subtest 'decoded YAML for add op has value field' => sub {
require YAML::XS;
my $decoded = YAML::XS::Load(diff_yaml({}, {added => 42}));
is($decoded->[0]{op}, 'add', 'op=add preserved');
is($decoded->[0]{value}, 42, 'value=42 preserved');
};
subtest 'decoded YAML for remove op has from field' => sub {
require YAML::XS;
my $decoded = YAML::XS::Load(diff_yaml({gone => 'bye'}, {}));
is($decoded->[0]{op}, 'remove', 'op=remove preserved');
is($decoded->[0]{from}, 'bye', 'from=bye preserved');
};
subtest 'decoded YAML entry count matches diff() count' => sub {
require YAML::XS;
my $old = {a => 1, b => 2, c => 3};
my $new = {a => 9, b => 2, c => 99};
my $changes = diff($old, $new);
my $decoded = YAML::XS::Load(diff_yaml($old, $new));
is(scalar @$decoded, scalar @$changes,
'YAML entry count matches diff() count');
};
};
# ===========================================================================
# 12. array_mode interactions with other options
# ===========================================================================
subtest 'array_mode interactions with ignore and compare' => sub {
t/function.t view on Meta::CPAN
# ===========================================================================
# SECTION 3: diff_json()
# ===========================================================================
subtest 'diff_json()' => sub {
subtest 'returns valid JSON string' => sub {
require JSON::MaybeXS;
my $j = diff_json({a => 1}, {a => 2});
ok(defined $j, 'returns a defined value');
my $decoded = eval { JSON::MaybeXS::decode_json($j) };
ok(!$@, 'output is valid JSON');
isa_ok($decoded, 'ARRAY', 'decoded JSON is an array');
};
subtest 'JSON contains op field' => sub {
require JSON::MaybeXS;
my $j = diff_json({a => 1}, {a => 2});
my $decoded = JSON::MaybeXS::decode_json($j);
is($decoded->[0]{op}, 'change', 'first entry has op=change');
};
subtest 'JSON for identical structures' => sub {
require JSON::MaybeXS;
my $j = diff_json({a => 1}, {a => 1});
my $decoded = JSON::MaybeXS::decode_json($j);
is_deeply($decoded, [], 'empty JSON array for no changes');
};
};
# ===========================================================================
# SECTION 4: diff_yaml()
# ===========================================================================
subtest 'diff_yaml()' => sub {
t/integration.t view on Meta::CPAN
my $changes = diff($old, $new);
is(scalar @$changes, 2, 'diff: two changes (role and score)');
my $text = diff_text($old, $new);
like($text, qr/role/, 'diff_text: mentions role');
like($text, qr/score/, 'diff_text: mentions score');
require JSON::MaybeXS;
my $json = diff_json($old, $new);
my $decoded = JSON::MaybeXS::decode_json($json);
is(scalar @$decoded, 2, 'diff_json: two entries');
my $yaml = diff_yaml($old, $new);
like($yaml, qr/role/, 'diff_yaml: mentions role');
like($yaml, qr/score/, 'diff_yaml: mentions score');
my $t2 = diff_test2($old, $new);
like($t2, qr/role/, 'diff_test2: mentions role');
like($t2, qr/score/, 'diff_test2: mentions score');
};
t/integration.t view on Meta::CPAN
active => 1,
};
my $changes = diff($data, $data);
is_deeply($changes, [], 'diff: no changes for identical deep structure');
my $text = diff_text($data, $data);
ok(!length($text) || $text =~ /^\s*$/, 'diff_text: empty for identical');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($data, $data));
is_deeply($decoded, [], 'diff_json: empty array for identical');
my $t2 = diff_test2($data, $data);
ok(!length($t2) || $t2 =~ /^\s*$/, 'diff_test2: empty for identical');
};
# ===========================================================================
# 3. All three op types in a single diff
#
# One key changed, one key added, one key removed. Every renderer must
t/integration.t view on Meta::CPAN
is(scalar @{ $by_op{remove} // [] }, 1, 'one remove op');
# diff_text must contain markers for all three
my $text = diff_text($old, $new);
like($text, qr/change|new|old/i, 'diff_text: change present');
like($text, qr/add|here/i, 'diff_text: add present');
like($text, qr/remove|gone/i, 'diff_text: remove present');
# diff_json must contain all three op types
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($old, $new));
my %json_ops;
$json_ops{$_->{op}}++ for @$decoded;
ok($json_ops{change}, 'diff_json: change op present');
ok($json_ops{add}, 'diff_json: add op present');
ok($json_ops{remove}, 'diff_json: remove op present');
# diff_test2 lines must all carry the "# " prefix
my $t2 = diff_test2($old, $new);
my @bad = grep { length($_) && $_ !~ /^# / } split /\n/, $t2;
is(scalar @bad, 0, 'diff_test2: all non-empty lines carry "# " prefix');
};
t/integration.t view on Meta::CPAN
my $changes = diff($old, $new, %opts);
is(scalar @$changes, 1, 'diff: only one change (secret ignored)');
is($changes->[0]{path}, '/public', 'diff: surviving change is /public');
my $text = diff_text($old, $new, %opts);
like($text, qr/public/, 'diff_text: public mentioned');
unlike($text, qr/secret/, 'diff_text: secret suppressed');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($old, $new, %opts));
is(scalar @$decoded, 1, 'diff_json: one entry');
is($decoded->[0]{path}, '/public', 'diff_json: entry is /public');
my $t2 = diff_test2($old, $new, %opts);
like($t2, qr/public/, 'diff_test2: public mentioned');
unlike($t2, qr/secret/, 'diff_test2: secret suppressed');
};
# ===========================================================================
# 5. compare option: custom comparator flows through to renderers
# ===========================================================================
t/integration.t view on Meta::CPAN
my $old = { price => 9.999, label => 'same' };
my $new = { price => 10.001, label => 'same' };
my $changes = diff($old, $new, %opts);
is_deeply($changes, [], 'diff: within tolerance = no changes');
my $text = diff_text($old, $new, %opts);
ok(!length($text) || $text =~ /^\s*$/, 'diff_text: empty within tolerance');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($old, $new, %opts));
is_deeply($decoded, [], 'diff_json: empty within tolerance');
}
# Outside tolerance: all renderers must show the price change
{
my $old = { price => 9.00, label => 'same' };
my $new = { price => 10.00, label => 'same' };
my $changes = diff($old, $new, %opts);
is(scalar @$changes, 1, 'diff: outside tolerance = one change');
my $text = diff_text($old, $new, %opts);
like($text, qr/price|9|10/, 'diff_text: price change mentioned');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($old, $new, %opts));
is($decoded->[0]{path}, '/price', 'diff_json: change is on /price');
}
};
# ===========================================================================
# 6. array_mode => 'index': end-to-end
# ===========================================================================
subtest "array_mode => 'index': end-to-end" => sub {
t/integration.t view on Meta::CPAN
my $changes = diff($old, $new, array_mode => 'index');
is(scalar @$changes, 1, 'one element changed');
is($changes->[0]{from}, 'b', 'from is b');
is($changes->[0]{to}, 'x', 'to is x');
like($changes->[0]{path}, qr{/items/1}, 'path includes array index');
my $text = diff_text($old, $new, array_mode => 'index');
like($text, qr/b|x/, 'diff_text: old/new values present');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(
diff_json($old, $new, array_mode => 'index')
);
is($decoded->[0]{from}, 'b', 'diff_json: from is b');
is($decoded->[0]{to}, 'x', 'diff_json: to is x');
};
# ===========================================================================
# 7. array_mode => 'lcs': end-to-end
# ===========================================================================
subtest "array_mode => 'lcs': end-to-end" => sub {
# Insertion in the middle: LCS should detect one add, not two changes
t/integration.t view on Meta::CPAN
is(scalar @adds, 1, 'lcs: one insertion detected');
is($adds[0]{value}, 2, 'lcs: inserted value is 2');
is(scalar @changes_op, 0, 'lcs: no spurious change ops');
# diff_text must mention the added value
my $text = diff_text($old, $new, array_mode => 'lcs');
like($text, qr/2/, 'diff_text: added value 2 mentioned');
# diff_json must agree
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(
diff_json($old, $new, array_mode => 'lcs')
);
my @jadd = grep { $_->{op} eq 'add' } @$decoded;
is(scalar @jadd, 1, 'diff_json: one add');
is($jadd[0]{value}, 2, 'diff_json: added value is 2');
# Deletion in the middle
my $old2 = { items => [1, 2, 3, 5] };
my $new2 = { items => [1, 3, 5] };
my $changes2 = diff($old2, $new2, array_mode => 'lcs');
my @removes = grep { $_->{op} eq 'remove' } @$changes2;
is(scalar @removes, 1, 'lcs: one deletion detected');
t/integration.t view on Meta::CPAN
is($ch[0]{from}, 'Alice', 'from is Alice');
is($ch[0]{to}, 'Alicia', 'to is Alicia');
my $text = diff_text($old, $new,
array_mode => 'unordered',
array_key => 'id',
);
like($text, qr/Alice|Alicia/, 'diff_text: name change reflected');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($old, $new,
array_mode => 'unordered',
array_key => 'id',
));
my @jch = grep { $_->{op} eq 'change' } @$decoded;
ok(scalar @jch >= 1, 'diff_json: name change reflected');
}
};
# ===========================================================================
# 9. Deeply nested structures: path notation and renderer output
# ===========================================================================
subtest 'Deeply nested structures: paths and renderer output' => sub {
t/integration.t view on Meta::CPAN
is(scalar @$changes, 1, 'one change in deeply nested structure');
is($changes->[0]{path}, '/org/dept/team/lead', 'full path correct');
is($changes->[0]{from}, 'Alice', 'from is Alice');
is($changes->[0]{to}, 'Bob', 'to is Bob');
my $text = diff_text($old, $new);
like($text, qr/Alice/, 'diff_text: old value present');
like($text, qr/Bob/, 'diff_text: new value present');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($old, $new));
is($decoded->[0]{path}, '/org/dept/team/lead',
'diff_json: full nested path preserved');
my $t2 = diff_test2($old, $new);
like($t2, qr/org|dept|team|lead/, 'diff_test2: path components mentioned');
};
# ===========================================================================
# 10. Mixed structure: hash containing arrays containing hashes
# ===========================================================================
t/integration.t view on Meta::CPAN
is($by_path{'/scores/1'}{to}, 99, '/scores/1 to=99');
is($by_path{'/meta/version'}{from}, 1, '/meta/version from=1');
is($by_path{'/meta/version'}{to}, 2, '/meta/version to=2');
# All renderers agree on two changes
my $text = diff_text($old, $new);
like($text, qr/20|99/, 'diff_text: scores change present');
like($text, qr/version/, 'diff_text: version change present');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($old, $new));
is(scalar @$decoded, 2, 'diff_json: two entries');
};
# ===========================================================================
# 11. Multiple options combined: ignore + compare + array_mode together
# ===========================================================================
subtest 'Multiple options combined: ignore + compare + array_mode' => sub {
my $old = {
t/integration.t view on Meta::CPAN
);
my $changes = diff($old, $new, %opts);
is_deeply($changes, [],
'combined options: price within tolerance, tags reordered, debug ignored = no changes');
my $text = diff_text($old, $new, %opts);
ok(!length($text) || $text =~ /^\s*$/, 'diff_text: empty with combined options');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($old, $new, %opts));
is_deeply($decoded, [], 'diff_json: empty with combined options');
my $t2 = diff_test2($old, $new, %opts);
ok(!length($t2) || $t2 =~ /^\s*$/, 'diff_test2: empty with combined options');
};
# ===========================================================================
# 12. Cycle detection: all renderers survive cyclic input
# ===========================================================================
t/integration.t view on Meta::CPAN
lives_ok(sub { $changes = diff($a, $b) }, 'diff: survives cycle');
lives_ok(sub { $text = diff_text($a, $b) }, 'diff_text: survives cycle');
lives_ok(sub { $json = diff_json($a, $b) }, 'diff_json: survives cycle');
lives_ok(sub { $yaml = diff_yaml($a, $b) }, 'diff_yaml: survives cycle');
lives_ok(sub { $t2 = diff_test2($a, $b) }, 'diff_test2: survives cycle');
isa_ok($changes, 'ARRAY', 'diff: result is arrayref after cycle');
require JSON::MaybeXS;
my $decoded = eval { JSON::MaybeXS::decode_json($json) };
ok(!$@, 'diff_json: output is valid JSON after cycle');
# The one genuine change (value 1->2) must survive even with cycles
my @value_changes = grep {
$_->{op} eq 'change' && $_->{path} eq '/value'
} @$changes;
is(scalar @value_changes, 1, 'value change detected despite cyclic structure');
};
t/integration.t view on Meta::CPAN
is(scalar @changes_op, 10, '10 value changes detected');
is(scalar @adds, 5, '5 additions detected');
is(scalar @removes, 5, '5 removals detected');
# All renderers must produce non-empty output
my $text = diff_text(\%old, \%new);
like($text, qr/\S/, 'diff_text: non-empty for large hash');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json(\%old, \%new));
is(scalar @$decoded, 20, 'diff_json: 20 total entries (10+5+5)');
};
# ===========================================================================
# 14. Realistic use-case: API response comparison
#
# Simulates comparing two versions of a JSON-like API response, the
# kind of real-world task the module's SYNOPSIS implies.
# ===========================================================================
t/integration.t view on Meta::CPAN
ok(scalar @name_ch >= 1, 'name change detected');
ok(scalar @role_add >= 1, 'new role (admin) detected as add');
is(scalar @req_id, 0, 'request_id ignored');
# Renderers all reflect the name change
my $text = diff_text($v1, $v2, %opts);
like($text, qr/Nigel Horne|N\. Horne/, 'diff_text: name change reflected');
unlike($text, qr/request_id/, 'diff_text: request_id suppressed');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($v1, $v2, %opts));
my @jreq = grep { ($_->{path}//'') =~ /request_id/ } @$decoded;
is(scalar @jreq, 0, 'diff_json: request_id not in output');
my $t2 = diff_test2($v1, $v2, %opts);
my @bad_lines = grep { length($_) && $_ !~ /^# / } split /\n/, $t2;
is(scalar @bad_lines, 0, 'diff_test2: all lines carry "# " prefix');
};
# ===========================================================================
# 15. Realistic use-case: configuration file comparison
t/integration.t view on Meta::CPAN
is(scalar @$changes, 3, 'exactly three changes after ignoring timestamps');
# All renderers agree on three changes
my $text = diff_text($cfg_old, $cfg_new, %opts);
like($text, qr/db1|db2/, 'diff_text: db host change present');
like($text, qr/300|600/, 'diff_text: ttl change present');
like($text, qr/4|8/, 'diff_text: workers change present');
unlike($text, qr/updated/, 'diff_text: timestamps suppressed');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($cfg_old, $cfg_new, %opts));
is(scalar @$decoded, 3, 'diff_json: three entries');
my @updated = grep { ($_->{path}//'') =~ /updated/ } @$decoded;
is(scalar @updated, 0, 'diff_json: no updated entries');
};
# ===========================================================================
# 16. diff() output drives subsequent diff_text / diff_json calls identically
#
# Calling diff() once and calling diff_text() / diff_json() independently
# must yield consistent results — the renderers must not apply different
# diffing logic from the engine.
t/integration.t view on Meta::CPAN
my $new = { a => 9, b => [1, 2, 9], c => { d => 'y' } };
my $changes = diff($old, $new);
# Count ops from diff()
my $n = scalar @$changes;
ok($n > 0, 'diff: at least one change');
# diff_json should contain the same number of entries
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($old, $new));
is(scalar @$decoded, $n, 'diff_json entry count matches diff() count');
# Each path from diff() must appear in diff_text output
my $text = diff_text($old, $new);
for my $c (@$changes) {
# paths like /a or /b/2 — take the last segment as a unique token
(my $leaf = $c->{path}) =~ s{.*/}{};
next unless length $leaf;
like($text, qr/\Q$leaf\E/, "diff_text: path segment '$leaf' present");
}
subtest 'returns a defined string' => sub {
my $j = diff_json({a => 1}, {a => 2});
ok(defined $j, 'defined');
ok(!ref($j), 'plain string');
};
subtest 'output is valid JSON' => sub {
require JSON::MaybeXS;
my $j = diff_json({a => 1}, {a => 2});
my $decoded = eval { JSON::MaybeXS::decode_json($j) };
ok(!$@, "output parses as JSON: $@");
};
subtest 'decoded JSON is an array' => sub {
require JSON::MaybeXS;
my $j = diff_json({a => 1}, {a => 2});
my $decoded = JSON::MaybeXS::decode_json($j);
isa_ok($decoded, 'ARRAY', 'decoded JSON');
};
subtest 'no changes: decoded JSON is empty array' => sub {
require JSON::MaybeXS;
my $j = diff_json({a => 1}, {a => 1});
my $decoded = JSON::MaybeXS::decode_json($j);
is_deeply($decoded, [], 'empty JSON array for identical structures');
};
subtest 'change record present in JSON output' => sub {
require JSON::MaybeXS;
my $j = diff_json({a => 1}, {a => 2});
my $decoded = JSON::MaybeXS::decode_json($j);
is($decoded->[0]{op}, 'change', 'first entry has op=change');
};
subtest 'path field present in JSON output' => sub {
require JSON::MaybeXS;
my $j = diff_json({name => 'A'}, {name => 'B'});
my $decoded = JSON::MaybeXS::decode_json($j);
is($decoded->[0]{path}, '/name', 'path field is /name');
};
subtest 'from and to fields present for change' => sub {
require JSON::MaybeXS;
my $j = diff_json({x => 'old'}, {x => 'new'});
my $decoded = JSON::MaybeXS::decode_json($j);
is($decoded->[0]{from}, 'old', 'from field present');
is($decoded->[0]{to}, 'new', 'to field present');
};
subtest 'accepts and applies options' => sub {
require JSON::MaybeXS;
my $j = diff_json(
{a => 1, b => 2},
{a => 9, b => 2},
ignore => ['/a'],
);
my $decoded = JSON::MaybeXS::decode_json($j);
is_deeply($decoded, [], 'ignored path: empty JSON array');
};
};
# ===========================================================================
# diff_yaml() — public function
#
# POD: "Render the diff as YAML using YAML::XS"
# ===========================================================================
my $new = {a => 1, b => [1, 2], c => {d => 'x'}};
my $changes = diff($old, $new);
is_deeply($changes, [], 'diff: no changes');
my $text = diff_text($old, $new);
ok(!length($text) || $text =~ /^\s*$/, 'diff_text: empty for no changes');
require JSON::MaybeXS;
my $json = diff_json($old, $new);
my $decoded = JSON::MaybeXS::decode_json($json);
is_deeply($decoded, [], 'diff_json: empty array for no changes');
my $t2 = diff_test2($old, $new);
ok(!length($t2) || $t2 =~ /^\s*$/, 'diff_test2: empty for no changes');
};
subtest 'all functions agree: changes present for differing input' => sub {
my $old = {x => 1};
my $new = {x => 2};
my $changes = diff($old, $new);
ok(scalar @$changes > 0, 'diff: changes present');
my $text = diff_text($old, $new);
like($text, qr/\S/, 'diff_text: non-empty for changes');
require JSON::MaybeXS;
my $json = diff_json($old, $new);
my $decoded = JSON::MaybeXS::decode_json($json);
ok(scalar @$decoded > 0, 'diff_json: non-empty array for changes');
my $t2 = diff_test2($old, $new);
like($t2, qr/\S/, 'diff_test2: non-empty for changes');
};
subtest 'ignore option honoured consistently across all functions' => sub {
my $old = {a => 1, b => 2};
my $new = {a => 9, b => 2};
my %opts = (ignore => ['/a']);
my $changes = diff($old, $new, %opts);
is_deeply($changes, [], 'diff: ignored');
my $text = diff_text($old, $new, %opts);
ok(!length($text) || $text =~ /^\s*$/, 'diff_text: empty when ignored');
require JSON::MaybeXS;
my $decoded = JSON::MaybeXS::decode_json(diff_json($old, $new, %opts));
is_deeply($decoded, [], 'diff_json: empty when ignored');
my $t2 = diff_test2($old, $new, %opts);
ok(!length($t2) || $t2 =~ /^\s*$/, 'diff_test2: empty when ignored');
};
};
done_testing();
( run in 0.780 second using v1.01-cache-2.11-cpan-df04353d9ac )