view release on metacpan or  search on metacpan

t/extended_tests.t  view on Meta::CPAN

#!/usr/bin/env perl

# extended_tests.t - targeted coverage tests for Genealogy::Military::Branch.
#
# Each subtest is chosen to exercise a specific branch, linear code
# sequence, or decision point not reached by unit.t, integration.t, or
# edge_cases.t.  Together they aim for >=95% statement coverage and
# maximum LCSAJ/TER3 scores by exercising every reachable path through
# _get_language, _translate, new(), and detect().
#
# External dependencies are mocked where needed to isolate code paths;
# env vars are localised to prevent host-locale interference.

use strict;
use warnings;
use 5.014;

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

use_ok('Genealogy::Military::Branch') or BAIL_OUT('Cannot load Genealogy::Military::Branch');

# -----------------------------------------------------------------------
# _get_language - environment variable cascade (all fallback paths)
# Each subtest exercises a distinct branch in the cascade:
#   detect() → LANGUAGE → LC_ALL → LC_MESSAGES → LANG → C-locale → undef
# -----------------------------------------------------------------------

subtest '_get_language - LANGUAGE env var used when detect() returns nothing' => sub {
	delete local $ENV{LC_ALL};
	delete local $ENV{LC_MESSAGES};
	delete local $ENV{LANG};
	local $ENV{LANGUAGE} = 'de_DE.UTF-8';

	# detect() returns nothing so the I18N::LangTags path is skipped;
	# _get_language must fall through to the LANGUAGE env var
	my $guard = mock_scoped('I18N::LangTags::Detect::detect' => sub { () });
	my $obj = Genealogy::Military::Branch->new();

	is($obj->detect(text => 'He served in the Navy'),
		'Marine', 'LANGUAGE env var drives German language detection');
};

subtest '_get_language - LC_ALL used when LANGUAGE and detect() both absent' => sub {
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_MESSAGES};
	delete local $ENV{LANG};
	local $ENV{LC_ALL} = 'fr_FR.UTF-8';

	my $guard = mock_scoped('I18N::LangTags::Detect::detect' => sub { () });
	my $obj = Genealogy::Military::Branch->new();

	# LC_ALL is the first entry in the foreach fallback list
	is($obj->detect(text => 'He served in the Navy'),
		'marine', 'LC_ALL env var drives French language detection');
};

subtest '_get_language - LC_MESSAGES used when higher-priority vars absent' => sub {
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_ALL};
	delete local $ENV{LANG};
	local $ENV{LC_MESSAGES} = 'de_DE.UTF-8';

	my $guard = mock_scoped('I18N::LangTags::Detect::detect' => sub { () });
	my $obj = Genealogy::Military::Branch->new();

	# LC_MESSAGES is the second entry in the foreach fallback list
	is($obj->detect(text => 'He served in the Navy'),
		'Marine', 'LC_MESSAGES env var drives German language detection');
};

subtest '_get_language - C.UTF-8 locale treated as English' => sub {
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_ALL};
	delete local $ENV{LC_MESSAGES};
	local $ENV{LANG} = 'C.UTF-8';

	my $guard = mock_scoped('I18N::LangTags::Detect::detect' => sub { () });

	# 'C.UTF-8' does not start with two letters so the foreach loop skips it;
	# the explicit /^C(\.|$)/ guard then fires and returns 'en'
	my $obj = Genealogy::Military::Branch->new();
	is($obj->detect(text => 'He served in the Navy'),
		'navy', 'C.UTF-8 locale treated as English');
};

subtest '_get_language - detect() returning hyphenated tag extracts prefix' => sub {
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_ALL};
	delete local $ENV{LC_MESSAGES};
	local $ENV{LANG} = 'en_GB.UTF-8';

	# 'fr-FR' → /^([a-z]{2})/i captures 'fr'; object behaves as French
	my $guard = mock_scoped('I18N::LangTags::Detect::detect' => sub { 'fr-FR' });
	my $obj = Genealogy::Military::Branch->new();

	is($obj->detect(text => 'He served in the Navy'),
		'marine', 'hyphenated detect() tag "fr-FR" extracts "fr"');
};

subtest '_get_language - non-matching detect() tag falls through to env vars' => sub {
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_ALL};
	delete local $ENV{LC_MESSAGES};
	local $ENV{LANG} = 'de_DE.UTF-8';

	# '123' does not match /^([a-z]{2})/i so the loop exhausts without returning;
	# control falls through to the LANGUAGE/LC_ALL/LC_MESSAGES/LANG cascade
	my $guard = mock_scoped('I18N::LangTags::Detect::detect' => sub { '123' });
	my $obj = Genealogy::Military::Branch->new();

	is($obj->detect(text => 'He served in the Navy'),
		'Marine', 'non-matching detect() tag falls through to LANG env var');
};

subtest '_get_language - undef returned when no locale detectable' => sub {
	delete local $ENV{LANGUAGE};
	delete local $ENV{LC_ALL};
	delete local $ENV{LC_MESSAGES};
	delete local $ENV{LANG};

	# All env vars absent and detect() empty → _get_language returns undef;
	# new() must default gracefully via $language // _get_language() // 'en'
	my $guard = mock_scoped('I18N::LangTags::Detect::detect' => sub { () });
	my $obj = Genealogy::Military::Branch->new();

	lives_ok(sub { $obj->detect(text => 'He served in the Navy') },
		'undef language defaults to English without crashing');
	is($obj->detect(text => 'He served in the Navy'),
		'navy', 'undef language treated as English');
};

# -----------------------------------------------------------------------
# _translate - uncovered branches
# -----------------------------------------------------------------------

subtest '_translate - unknown language falls back to English' => 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 { () });

	# 'es' is not a key in %TRANSLATIONS; _translate must fall back to 'en'
	my $obj = Genealogy::Military::Branch->new(language => 'es');
	is($obj->detect(text => 'He served in the Navy'),
		'navy', 'unknown language "es" falls back to English "navy"');
	is($obj->detect(text => 'Served with the RAF'),
		'RAF', 'unknown language "es" falls back to English "RAF"');
};

subtest '_translate - bare key returned when absent from all translation tables' => 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 { () });

	# Call _translate directly with a key present in neither lang-specific nor
	# 'en' tables; the final $key fallback ($TRANSLATIONS{'en'}{$key} // $key)
	# must return the key itself
	my $obj = Genealogy::Military::Branch->new(language => 'en');
	is($obj->_translate('nonexistent_branch_key'),
		'nonexistent_branch_key',
		'_translate returns bare key when absent from all translation tables');
};

subtest '_translate - undef language field defaults to "en"' => sub {