use 5.010;
use strict;
use Perinci::Sub::Wrapper qw(wrap_sub);
use Test::More 0.96;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(test_wrap);
our $VERSION = '0.09'; # VERSION
sub test_wrap {
my %test_args = @_;
my $wrap_args = $test_args{wrap_args} or die "BUG: wrap_args not defined";
my $test_name = $test_args{name} or die "BUG: test name not defined";
subtest $test_name => sub {
my $wrap_res;
eval { $wrap_res = wrap_sub(%$wrap_args) };
my $wrap_eval_err = $@;
if ($test_args{wrap_dies}) {
ok($wrap_eval_err, "wrap dies");
} else {
ok(!$wrap_eval_err, "wrap doesn't die") or diag $wrap_eval_err;
}
if (defined $test_args{wrap_status}) {
is(ref($wrap_res), 'ARRAY', 'wrap res is array');
is($wrap_res->[0], $test_args{wrap_status},
"wrap status is $test_args{wrap_status}");
}
my $call_argsr = $test_args{call_argsr};
my $call_res;
if ($call_argsr) {
my $sub = $wrap_res->[2]{sub};
eval { $call_res = $sub->(@$call_argsr) };
my $call_eval_err = $@;
if ($test_args{call_dies}) {
ok($call_eval_err, "call dies");
} else {
ok(!$call_eval_err, "call doesn't die")
or diag $call_eval_err;
}
if (defined $test_args{call_status}) {
is(ref($call_res), 'ARRAY', 'call res is array');
is($call_res->[0], $test_args{call_status},
"call status is $test_args{call_status}");
}
if (exists $test_args{call_res}) {
is_deeply($call_res, $test_args{call_res},
"call res")
or diag explain $call_res;
}
}
if ($test_args{posttest}) {
$test_args{posttest}->($wrap_res, $call_res);
}
done_testing();
};
}
1;
__END__
=pod
=head1 NAME
Test::Perinci::Sub::Wrapper
=head1 VERSION
version 0.09
=head1 AUTHOR
Steven Haryanto <stevenharyanto@gmail.com>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2012 by Steven Haryanto.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut