view release on metacpan or  search on metacpan

t/unit.t  view on Meta::CPAN

			{a => 9, b => 9},
			ignore => ['/a'],
		);
		is(scalar @$r, 1, 'one change (b) despite ignore on a');
		is($r->[0]{path}, '/b', 'the surviving change is /b');
	};

	subtest 'regex: matching path suppressed' => sub {
		my $r = diff(
			{debug => 1, value => 'x'},
			{debug => 9, value => 'x'},
			ignore => [qr{^/debug$}],
		);
		is_deeply($r, [], 'regex-matched path suppressed');
	};

	subtest 'regex: non-matching path still reported' => sub {
		my $r = diff(
			{debug => 1, value => 'x'},
			{debug => 9, value => 'y'},
			ignore => [qr{^/debug$}],
		);
		is(scalar @$r, 1,       'one change survives regex ignore');
		is($r->[0]{path}, '/value', 'surviving change is /value');
	};

	subtest 'wildcard: matching path suppressed' => sub {
		my $r = diff(
			{users => {alice => {score => 1}, bob => {score => 2}}},
			{users => {alice => {score => 9}, bob => {score => 9}}},
			ignore => ['/users/*/score'],
		);
		is_deeply($r, [], 'wildcard-matched paths suppressed');
	};

	subtest 'wildcard: only matching segments suppressed' => sub {
		my $r = diff(
			{users => {alice => {score => 1, name => 'Alice'}}},
			{users => {alice => {score => 9, name => 'Alicia'}}},
			ignore => ['/users/*/score'],
		);
		is(scalar @$r, 1, 'one change survives (name)');
		like($r->[0]{path}, qr{/name$}, 'surviving change is the name field');
	};

	subtest 'multiple ignore rules applied together' => sub {
		my $r = diff(
			{a => 1, b => 2, c => 3},
			{a => 9, b => 9, c => 3},
			ignore => ['/a', '/b'],
		);
		is_deeply($r, [], 'both ignored paths suppressed');
	};

};

# ===========================================================================
# diff() — option: compare
#
# POD: "compare => { '/price' => sub { abs($_[0] - $_[1]) < 0.01 } }"
# POD: "Custom comparator callbacks for specific paths"
# ===========================================================================

subtest 'diff() - compare option' => sub {

	subtest 'custom comparator: within tolerance, no change' => sub {
		my $r = diff(
			{price => 1.001},
			{price => 1.002},
			compare => { '/price' => sub { abs($_[0] - $_[1]) < 0.01 } },
		);
		is_deeply($r, [], 'within tolerance: no change reported');
	};

	subtest 'custom comparator: outside tolerance, change reported' => sub {
		my $r = diff(
			{price => 1.00},
			{price => 1.50},
			compare => { '/price' => sub { abs($_[0] - $_[1]) < 0.01 } },
		);
		is(scalar @$r, 1,        'outside tolerance: one change');
		is($r->[0]{op}, 'change', 'op is change');
	};

	subtest 'custom comparator: only applied to its own path' => sub {
		# /price has a tolerant comparator; /tax uses default equality
		my $r = diff(
			{price => 1.001, tax => 10},
			{price => 1.002, tax => 11},
			compare => { '/price' => sub { abs($_[0] - $_[1]) < 0.01 } },
		);
		is(scalar @$r, 1,      'one change (tax); price within tolerance');
		is($r->[0]{path}, '/tax', 'change is on /tax');
	};

	subtest 'custom comparator: receives old and new values as arguments' => sub {
		my ($got_old, $got_new);
		diff(
			{x => 'OLD'},
			{x => 'NEW'},
			compare => { '/x' => sub { $got_old = $_[0]; $got_new = $_[1]; 0 } },
		);
		is($got_old, 'OLD', 'comparator receives old value as first arg');
		is($got_new, 'NEW', 'comparator receives new value as second arg');
	};

	subtest 'custom comparator: exception captured in error field' => sub {
		my $r = diff(
			{x => 1},
			{x => 2},
			compare => { '/x' => sub { die "comparator exploded\n" } },
		);
		is($r->[0]{op}, 'change', 'exception still yields a change record');
		ok(exists $r->[0]{error}, 'error field present');
		like($r->[0]{error}, qr/comparator exploded/, 'error message captured');
	};

};

# ===========================================================================
# diff() — option: array_mode