git.maemo.org Git - pkg-perl/blob - deb-src/libsub-uplevel-perl/libsub-uplevel-perl-0.1901/t/06_db_args.t

   1 use lib qw(t/lib);
   2 use strict;
   3 use Test::More tests => 3;
   4
   5 BEGIN { use_ok('Sub::Uplevel'); }
   6
   7 sub get_caller_args {
   8     package DB;
   9     my @x = caller(1);
  10     return @DB::args;
  11 }
  12
  13 sub addition {
  14     my $x;
  15     $x += $_ for @_;
  16     return $x;
  17 }
  18
  19 sub wrap_addition {
  20     my @args = get_caller_args();
  21     my $sum = uplevel 1, \&addition, @_;
  22     return ($sum, @args);
  23 }
  24
  25 my ($sum, @args) = wrap_addition(1, 2, 3);
  26
  27 is($sum, 6, "wrapper returned value correct");
  28 is_deeply( \@args, [1, 2, 3], "wrapper returned args correct" );
  29
  30
  31