view release on metacpan or  search on metacpan

t/unit/exceptions.t  view on Meta::CPAN

	for my $enc(qw/CP1251 KOI8-R UTF-8/) {
		local $App::MtAws::Exceptions::_errno_encoding = undef;
		my $test_str = "тест";
		my $bin_str = encode($enc, $test_str);
		no warnings 'redefine';

		local *I18N::Langinfo::langinfo = sub { $enc };
		check_localized {
			is get_errno($bin_str), $test_str, "get_errno (with arg) should work with encoding $enc";
		};

		local *I18N::Langinfo::langinfo = sub { confess };
		check_localized {
			is get_errno($bin_str), $test_str, "get_errno (with arg) should re-use encoding, $enc";
		};
	}
}

SKIP: {
	skip "Only for HP-UX", 3 if $^O ne 'hpux';
	my ($encode_enc, $i18_enc) = ('hp-roman8', 'roman8');
	local $App::MtAws::Exceptions::_errno_encoding = undef;
	my $test_str = "test";
	my $bin_str = encode($encode_enc, $test_str);
	no warnings 'redefine';

	local *I18N::Langinfo::langinfo = sub { $i18_enc };
	check_localized {
		is get_errno($bin_str), $test_str, "get_errno should work with roman8 encoding under HP-UX";
	};
	ok $App::MtAws::Exceptions::_errno_encoding, $encode_enc;
}

{
	local $App::MtAws::Exceptions::_errno_encoding = undef;
	my $test_str = encode("UTF-8", "тест");
	no warnings 'redefine';

	local *I18N::Langinfo::langinfo = sub { die };
	check_localized {
		is get_errno($test_str), hex_dump_string($test_str), "get_errno should work when CODESET crashed";
	};

	is $App::MtAws::Exceptions::_errno_encoding, App::MtAws::Exceptions::BINARY_ENCODING(),
		"should be a binary encoding, when CODESET crashed";

	local *I18N::Langinfo::langinfo = sub { "UTF-8" };
	check_localized {
		get_errno($test_str);
	};

	is $App::MtAws::Exceptions::_errno_encoding, App::MtAws::Exceptions::BINARY_ENCODING(),
		"BINARY encoding should be reused";
}

{
	local $App::MtAws::Exceptions::_errno_encoding = undef;
	my $test_str = encode("UTF-8", "тест");
	no warnings 'redefine';

	my $not_encoding = "NOT_AN_ENCODING";
	ok !defined find_encoding($not_encoding);

	local *I18N::Langinfo::langinfo = sub { $not_encoding };
	check_localized {
		is get_errno($test_str), hex_dump_string($test_str), "get_errno should work encoding is unknown";
	};

	is $App::MtAws::Exceptions::_errno_encoding, App::MtAws::Exceptions::BINARY_ENCODING(),
		"should be a binary encoding, when encoding is unknown";

	local *I18N::Langinfo::langinfo = sub { "UTF-8" };
	check_localized {
		get_errno($test_str);
	};

	is $App::MtAws::Exceptions::_errno_encoding, App::MtAws::Exceptions::BINARY_ENCODING(),
		"BINARY encoding should be reused";
}

{
	local $App::MtAws::Exceptions::_errno_encoding = undef;

	my $actual_encoding = 'KOI8-R';
	my $found_encoding = 'UTF-8';
	my $s = 'test тест';

	{
		my $bin = encode($actual_encoding, $s);
		ok ! eval { decode($found_encoding, $bin, Encode::DIE_ON_ERR|Encode::LEAVE_SRC); 1 };
	}

	my $test_str = encode($actual_encoding, $s);

	no warnings 'redefine';
	local *I18N::Langinfo::langinfo = sub { $found_encoding };
	check_localized {
		is get_errno($test_str), hex_dump_string($test_str), "get_errno should work encoding is incompatible";
	};

	is $App::MtAws::Exceptions::_errno_encoding, $found_encoding,
		"should NOT reset to binary encoding, when encoding is incompatible";

	local *I18N::Langinfo::langinfo = sub { $actual_encoding };
	check_localized {
		get_errno($test_str);
	};

	is $App::MtAws::Exceptions::_errno_encoding, $found_encoding,
		"should not be BINARY encoding";
}

{
	local $App::MtAws::Exceptions::_errno_encoding = undef;
	my $found_encoding = 'UTF-8';
	my $s = 'test тест';
	ok ! eval { decode($found_encoding, $s); 1 };
	ok utf8::is_utf8($s);
	no warnings 'redefine';
	local *I18N::Langinfo::langinfo = sub { $found_encoding };
	check_localized {
		# workaround issue https://rt.perl.org/rt3/Ticket/Display.html?id=119499
		is get_errno($s), $s, "get_errno should work ERRNO is character string";
	};