App-MtAws

 view release on metacpan or  search on metacpan

t/integration/config_engine_upload_file_real.t  view on Meta::CPAN

{
	my ($msg, $dir, $filename, $error, %opts) = @_;
	assert_fails_on_filesystem $msg,
		[qw!upload-file --config glacier.cfg --vault myvault --journal j!, '--filename', $filename, '--dir', $dir],
		[],
		$error, %opts;
}



sub with_save_dir(&)
{
	my $curdir = Cwd::getcwd;
	shift->();
	chdir $curdir or confess;
}

sub with_my_dir($%)
{
	my ($d, $cb, @dirs) = (shift, pop, @_);
	my $dir = "$mtroot/$d";

t/lib/TestUtils.pm  view on Meta::CPAN

	$_[0]='';# perl 5.8.x issue warning if undefined $out is used in open() below
	open STDERR, '>', \$_[0] or die "Can't open STDERR: $!";
	binmode STDOUT, ":encoding($enc)";
	my $res = $_[1]->();
	close STDERR;
	$_[0] = decode($enc, $_[0], Encode::DIE_ON_ERR|Encode::LEAVE_SRC);
	$res;
}

# TODO: call only as assert_raises_exception sub {}, $e - don't omit sub!
sub assert_raises_exception(&@)
{
	my ($cb, $exception) = @_;
	ok !defined eval { $cb->(); 1 };
	my $err = $@;
	cmp_deeply $err, superhashof($exception);
	return ;
}

our $mock_order_declare;
our $mock_order_realtime;

t/lib/TestUtils.pm  view on Meta::CPAN

			die $@;
		}
	};
	if ($test_fast_ok_cnt) {
		ok 0, "$message - expected $plan tests, but ran ".($plan - $test_fast_ok_cnt);
	} else {
		ok (1, $message);
	}
}

sub with_fork(&&)
{
	my ($parent_cb, $child_cb) = @_;
	my $ppid = $$;
	my $fromchild = new IO::Pipe;
	my $tochild = new IO::Pipe;

	if (my $pid = fork()) {
		my $child_exited = 0;
		$fromchild->reader();
		$fromchild->autoflush(1);

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

use App::MtAws::ConfigEngine;
use Data::Dumper;



sub Context()
{
	$App::MtAws::ConfigEngine::context
}

sub localize(&)
{
	local $App::MtAws::ConfigEngine::context;
	shift->();
}


describe "command" => sub {
	it "should work" => sub {
		localize sub {
			my $code = sub { $_*2 };

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

is 'My message :NULL:', exception_message(exception 'code' => 'My message %04d a_42%', b_42 => 42);
is 'My message :NULL:', exception_message(exception 'code' => 'My message %a_42%', b_42 => 42);
is 'My message :NULL:', exception_message(exception 'code' => 'My message %string a_42%', b_42 => 42);
ok exception_message(exception 'code' => 'My message %string a_42%', a_42 => 42, c_42=>33);


# dump_error


sub test_error(&$$)
{
	my ($cb, $where, $e) = @_;
	capture_stderr my $out, sub {
		eval { die $e };
		dump_error($where);
	};
	$cb->($out, $@);
}

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

} '', 'somestring';

test_error {
	my ($out, $err) = @_;
	ok $out =~ /^UNEXPECTED ERROR \(here\): somestring/;
} 'here', 'somestring';


	# TODO: check also that 'next' is called!

sub check_localized(&)
{
	local $@ = 'checkme';
	local $! = ENOMEM;
	shift->();
	is $@, 'checkme', "should not clobber eval error";
	is $!+0, ENOMEM, "should not clobber errno";
}

# test get_errno with argument
{

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

my $mtroot = get_temp_dir();
my $tmp_file = "$mtroot/open_file_test";

unlink $tmp_file;
rmtree $tmp_file;


sub new_stack(&)
{
	local $OpenStack = [];
	local $BinmodeStack = [];
	shift->();
}

sub last_call()
{
	$OpenStack->[0]
}