view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

#!/usr/bin/env perl

# edge_cases.t - destructive, pathological, and boundary-condition tests
# for Genealogy::Occupation.
#
# Tests are deliberately adversarial: malformed input, boundary-straddling
# strings, homoglyphs, empty arrays, enormous arrays, regex-hostile
# characters, filter-vs-normalise ordering traps, and known false-positive
# risks in the filter patterns.  Each subtest documents the exact behaviour
# that results, even when that behaviour is surprising.

use strict;
use warnings;
use 5.014;

use Test::Most;
use Test::Mockingbird 0.10 qw(mock_scoped);

use_ok('Genealogy::Occupation') or BAIL_OUT('Cannot load Genealogy::Occupation');

# Convenience: English-locale object with language detection mocked out
# so that individual test environment locale cannot affect results.
# Returns ($obj, $guard); caller must keep $guard in scope.
sub _en {
	my %args   = @_;
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_ALL};
	delete local $ENV{LC_MESSAGES};
	local $ENV{LANG} = 'en_GB.UTF-8';
	my $guard  = mock_scoped('I18N::LangTags::Detect::detect' => sub { () });
	my $obj    = Genealogy::Occupation->new(%args);
	# Return guard separately so the caller can keep it alive past return
	return ($obj, $guard);
}

# -----------------------------------------------------------------------
# String-cleaning step boundary conditions
# The cleaning pipeline runs in this order:
#   tr/\r\n/ /   -> s/\.+$//   -> s/[\(\)]//g ->
#   s/\s\s+/ /g  -> s/\s+$//   -> s/\./;/g
# -----------------------------------------------------------------------

subtest 'cleaning - dots-only string collapses to empty and is skipped' => sub {
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_ALL};
	delete local $ENV{LC_MESSAGES};
	local $ENV{LANG} = 'en_GB.UTF-8';
	my $guard = mock_scoped('I18N::LangTags::Detect::detect' => sub { () });
	my $obj = Genealogy::Occupation->new();

	# '...' -> s/\.+$// -> '' -> length 0 -> skipped entirely
	is_deeply($obj->normalise(occupation => '...'), [],
		'dots-only string produces empty result');
};

subtest 'cleaning - parentheses-only string collapses to empty and is skipped' => sub {
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_ALL};
	delete local $ENV{LC_MESSAGES};
	local $ENV{LANG} = 'en_GB.UTF-8';
	my $guard = mock_scoped('I18N::LangTags::Detect::detect' => sub { () });
	my $obj = Genealogy::Occupation->new();

	# '()' -> s/[\(\)]//g -> '' -> length 0 -> skipped
	is_deeply($obj->normalise(occupation => '()'), [],
		'parentheses-only string produces empty result');

	# Parens with only whitespace inside also collapses
	is_deeply($obj->normalise(occupation => '(  )'), [],
		'whitespace-inside-parens string produces empty result');
};

subtest 'cleaning - embedded CR+LF normalised to single space' => sub {
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_ALL};
	delete local $ENV{LC_MESSAGES};
	local $ENV{LANG} = 'en_GB.UTF-8';
	my $guard = mock_scoped('I18N::LangTags::Detect::detect' => sub { () });
	my $obj = Genealogy::Occupation->new();

	# tr/\r\n/ / converts each \r and \n to a space, then s/\s\s+/ /g
	# collapses them, restoring the string to a matchable form
	is_deeply($obj->normalise(occupation => "Ag\r\nLab"), ['Agricultural Labourer'],
		'CRLF within occupation string cleaned to single space before lookup');

	# Multiple newlines also collapse
	is_deeply($obj->normalise(occupation => "Ag\n\n\nLab"), ['Agricultural Labourer'],
		'multiple newlines collapsed to single space');
};

subtest 'cleaning - trailing dots stripped, internal dots become semicolons' => sub {
	delete local $ENV{LANGUAGE};