view release on metacpan or  search on metacpan

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

use strict;
use warnings;
use utf8;
use Test::More tests => 150;
use Test::Deep;
use Encode;
use FindBin;
use Carp;
use POSIX;
use lib map { "$FindBin::RealBin/$_" } qw{../lib ../../lib};
use TestUtils 'w_fatal';
use App::MtAws::Exceptions;
use App::MtAws::Utils;
use I18N::Langinfo; # TODO: skip test without that module??




cmp_deeply exception('MyMessage'), { MTEXCEPTION => bool(1), message => 'MyMessage'};
cmp_deeply exception('mycode' => 'MyMessage'), { MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode'};
cmp_deeply exception('mycode' => 'MyMessage', myvar => 1),
	{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode', myvar => 1};
cmp_deeply exception('mycode' => 'MyMessage', myvar => 1, anothervar => 2),
	{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode', myvar => 1, anothervar => 2};
cmp_deeply exception('mycode' => 'MyMessage', code => 'code2'),
	{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'code2'};

my $existing_exception = exception('xcode' => 'xmessage', myvar => 'xvar');

cmp_deeply exception($existing_exception, 'MyMessage'),
	{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'xcode', myvar => 'xvar'};
cmp_deeply exception($existing_exception, 'mycode' => 'MyMessage'),
	{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode', myvar => 'xvar'};
cmp_deeply exception($existing_exception, 'mycode' => 'MyMessage', myvar => 1),
	{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode', myvar => 1};
cmp_deeply exception($existing_exception, 'mycode' => 'MyMessage', myvar2 => 1),
	{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode', myvar => 'xvar', myvar2=>1};
cmp_deeply exception($existing_exception, 'mycode' => 'MyMessage', myvar => 1, anothervar => 2),
	{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode', myvar => 1, anothervar => 2};

# detecting wrong args
{
	ok ! eval { exception('mycode' => 'MyMessage', 'abc'); 1 };
	like $@, qr/Malformed exception/;

	ok ! eval { exception('mycode' => 'MyMessage', 'abc' => 'def', 'xyz'); 1 };
	like $@, qr/Malformed exception/;
}

# parsing args with errno ERRNO - unit
{
	no warnings 'redefine';
	local $! = EACCES;
	local *App::MtAws::Exceptions::get_errno = sub { "checkme" };
	cmp_deeply exception('mycode' => 'MyMessage', 'ERRNO'),
		{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode', errno => "checkme", errno_code => EACCES+0 };
}
# parsing args with errno ERRNO - integration
{
	my $expect_errno = get_errno(POSIX::strerror(EACCES)); # real integration test with current locale
	local $! = EACCES;

	cmp_deeply exception('mycode' => 'MyMessage', 'ERRNO'),
		{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode', errno => $expect_errno, errno_code => EACCES};

	cmp_deeply exception('mycode' => 'MyMessage', 'ERRNO', A => 123),
		{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode', errno=> $expect_errno, errno_code => EACCES, A => 123};
	cmp_deeply exception('mycode' => 'MyMessage', A => 123, 'ERRNO'),
		{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode', errno => $expect_errno, errno_code => EACCES, A => 123};
	cmp_deeply exception('mycode' => 'MyMessage', A => 123, 'ERRNO', B => 456),
		{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode', errno => $expect_errno, errno_code => EACCES, A => 123, B => 456};


	local $! = EACCES;
	ok ! eval { exception('mycode' => 'MyMessage', ERRNO => 'xyz'); 1 };
	like $@, qr/Malformed exception/;

	local $! = EACCES;
	ok ! eval { exception('mycode' => 'MyMessage', 'ERRNO', A => 123, 'xyz'); 1 };
	like $@, qr/Malformed exception/;

	local $! = EACCES;
	ok ! eval { exception('mycode' => 'MyMessage', ERRNO => 'ERRNO'); 1 };
	like $@, qr/already used/i;

	local $! = EACCES;
	ok ! eval { exception('mycode' => 'MyMessage', 'ERRNO', x => 'y', 'ERRNO'); 1 };
	like $@, qr/already used/i;

	local $! = EACCES;
	cmp_deeply exception('mycode' => 'MyMessage', 'ERRNO', B => 'ERRNO'),
		{ MTEXCEPTION => bool(1), message => 'MyMessage', code => 'mycode', errno => $expect_errno, errno_code => EACCES, B => 'ERRNO'};

	my $r = exception('mycode' => 'MyMessage', 'ERRNO');
	{
		no warnings 'numeric';
		is $r->{errno}+1, 1, "strip magick";
	}
	is "$r->{errno_code}", EACCES, "strip magick";
}

# get_exception

{
	eval { die exception('mycode' => 'MyMessage') };
	ok get_exception;
	is get_exception->{code}, 'mycode';
	is get_exception->{message}, 'MyMessage';
}

{
	eval { die exception('mycode' => 'MyMessage') };
	eval { 1; };
	ok $@ eq '';
	ok !get_exception;
}

{
	my $e = exception('mycode' => 'MyMessage');
	ok get_exception($e);

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

	{
		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";
	};

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

}

{
	ok ! defined find_encoding(App::MtAws::Exceptions::BINARY_ENCODING()),
		"BINARY_ENCODING should not be a valid encoding";
	ok App::MtAws::Exceptions::BINARY_ENCODING(), "BINARY_ENCODING should be TRUE";
}

{
	for my $err (EACCES, EAGAIN, ENOMEM, EEXIST) {
		local $App::MtAws::Exceptions::_errno_encoding = undef;
		local $! = $err;
		my $res_errno = get_errno($!);
		my $enc = $App::MtAws::Exceptions::_errno_encoding;

		my $expect = POSIX::strerror($err);
		check_localized { # dont use $! inside this block
			if ($enc eq App::MtAws::Exceptions::BINARY_ENCODING()) {
				is $res_errno, hex_dump_string($expect), "get_errno should work in real with real locales";
			} else {
				if (utf8::is_utf8($expect)) { # workaround issue https://rt.perl.org/rt3/Ticket/Display.html?id=119499
					is $res_errno, $expect, "get_errno should work in real with real locales";
				} else {
					is $res_errno, decode($enc, $expect), "get_errno should work in real with real locales";
				}
			}
		};
	}
}

1;