view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

use Test::Most;
use Scalar::Util qw(blessed reftype);

=head1 NAME

edge_cases.t - Destructive, pathological and boundary-condition tests
               for Data::Hash::Diff::Smart

=head1 DESCRIPTION

These tests probe the limits of the public API: empty structures, undef
values, extremely deep nesting, very long strings, Unicode, mixed types,
blessed objects, coderefs, IO handles, duplicate keys (impossible in Perl
but simulated via tied hashes), NaN/Inf, overloaded objects, zero/false
values, and adversarial option inputs.

Every test calls only the public interface.

=cut

BEGIN {
	use_ok('Data::Hash::Diff::Smart', qw(
		diff
		diff_text
		diff_json
		diff_yaml
		diff_test2
	));
}

# ===========================================================================
# 1. Empty and minimal structures
# ===========================================================================

subtest 'Empty and minimal structures' => sub {

	subtest 'two empty hashrefs: no changes' => sub {
		is_deeply(diff({}, {}), [], 'empty hashes: no changes');
	};

	subtest 'two empty arrayrefs: no changes' => sub {
		is_deeply(diff([], []), [], 'empty arrays: no changes');
	};

	subtest 'empty string vs empty string: no changes' => sub {
		is_deeply(diff('', ''), [], 'empty strings: no changes');
	};

	subtest 'undef vs undef: no changes' => sub {
		is_deeply(diff(undef, undef), [], 'both undef: no changes');
	};

	subtest 'empty hash vs populated hash: all adds' => sub {
		my $r = diff({}, {a => 1, b => 2});
		my @non_adds = grep { $_->{op} ne 'add' } @$r;
		is(scalar @non_adds, 0, 'all ops are add');
		is(scalar @$r,       2, 'two adds');
	};

	subtest 'populated hash vs empty hash: all removes' => sub {
		my $r = diff({a => 1, b => 2}, {});
		my @non_removes = grep { $_->{op} ne 'remove' } @$r;
		is(scalar @non_removes, 0, 'all ops are remove');
		is(scalar @$r,          2, 'two removes');
	};

	subtest 'empty array vs populated array: all adds' => sub {
		my $r = diff([], [1, 2, 3]);
		my @non_adds = grep { $_->{op} ne 'add' } @$r;
		is(scalar @non_adds, 0, 'all ops are add for empty->populated array');
	};

	subtest 'populated array vs empty array: all removes' => sub {
		my $r = diff([1, 2, 3], []);

t/edge_cases.t  view on Meta::CPAN

		);
		is($r->[0]{path}, '/a/b', 'path correct for nested undef change');
	};

	subtest 'key with undef value vs missing key' => sub {
		# {x => undef} vs {} — undef value present vs key absent
		my $r_remove = diff({x => undef}, {});
		my $r_add    = diff({}, {x => undef});
		is($r_remove->[0]{op}, 'remove', 'undef-valued key removed is a remove');
		is($r_add->[0]{op},    'add',    'undef-valued key added is an add');
	};

};

# ===========================================================================
# 3. False-y but defined values: 0, '', '0'
# ===========================================================================

subtest 'False-y but defined values' => sub {

	subtest 'integer 0 vs 0: no change' => sub {
		is_deeply(diff({x => 0}, {x => 0}), [], '0 vs 0: no change');
	};

	subtest 'integer 0 vs 1: change' => sub {
		my $r = diff({x => 0}, {x => 1});
		is($r->[0]{op}, 'change', '0 vs 1: change');
	};

	subtest 'empty string vs empty string: no change' => sub {
		is_deeply(diff({x => ''}, {x => ''}), [], '"" vs "": no change');
	};

	subtest 'empty string vs non-empty: change' => sub {
		my $r = diff({x => ''}, {x => 'hello'});
		is($r->[0]{op}, 'change', '"" vs "hello": change');
	};

	subtest 'string "0" vs "0": no change' => sub {
		is_deeply(diff({x => '0'}, {x => '0'}), [], '"0" vs "0": no change');
	};

	subtest 'string "0" vs integer 0: no change (string eq)' => sub {
		# _eq uses string eq, so "0" eq 0 is true
		is_deeply(diff({x => '0'}, {x => 0}), [], '"0" eq 0: no change');
	};

	subtest 'false value in array: detected correctly' => sub {
		my $r = diff([0, '', undef, '0'], [0, '', undef, '0']);
		is_deeply($r, [], 'array of false values identical: no changes');
	};

	subtest 'false value change in array' => sub {
		my $r = diff([0], [1]);
		is($r->[0]{op}, 'change', '0->1 in array is change');
	};

};

# ===========================================================================
# 4. Numeric edge cases: floats, NaN, Inf
# ===========================================================================

subtest 'Numeric edge cases' => sub {

	subtest 'integer vs float with same string repr: no change' => sub {
		is_deeply(diff({x => 1}, {x => 1.0}), [], '1 vs 1.0: no change');
	};

	subtest 'floats that differ in string repr: change' => sub {
		my $r = diff({x => 1.1}, {x => 1.2});
		is($r->[0]{op}, 'change', '1.1 vs 1.2: change');
	};

	subtest 'very large integer: no change' => sub {
		my $big = 9**9**2;
		is_deeply(diff({x => $big}, {x => $big}), [], 'large integer vs itself: no change');
	};

	subtest 'Inf vs Inf: no change' => sub {
		my $inf = 9**9**9;
		is_deeply(diff({x => $inf}, {x => $inf}), [], 'Inf vs Inf: no change');
	};

	subtest 'Inf vs large number: change' => sub {
		my $inf  = 9**9**9;
		my $big  = 9**9**2;
		my $r    = diff({x => $inf}, {x => $big});
		is($r->[0]{op}, 'change', 'Inf vs large number: change');
	};

	subtest 'negative zero vs zero: no change (string eq)' => sub {
		my $negzero = -0.0;
		is_deeply(diff({x => $negzero}, {x => 0}), [], '-0.0 vs 0: no change');
	};

};

# ===========================================================================
# 5. String edge cases
# ===========================================================================

subtest 'String edge cases' => sub {

	subtest 'very long string: change detected' => sub {
		my $long_old = 'x' x 100_000;
		my $long_new = 'x' x 99_999 . 'y';
		my $r = diff({s => $long_old}, {s => $long_new});
		is($r->[0]{op}, 'change', '100k-char string: change detected');
	};

	subtest 'very long identical string: no change' => sub {
		my $long = 'a' x 100_000;
		is_deeply(diff({s => $long}, {s => $long}), [], '100k-char identical string: no change');
	};

	subtest 'string with embedded newlines' => sub {
		my $r = diff({s => "line1\nline2"}, {s => "line1\nline3"});
		is($r->[0]{op}, 'change', 'string with newline: change detected');
	};