t/curry-packagevar.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::More tests => 18;
   5 use Scalar::Util qw(weaken);
   6 use curry;
   7
   8 sub dispose_ok($;$) {
   9         weaken(my $copy = $_[0]);
  10         fail("variable is not a ref") unless ref $_[0];
  11         undef $_[0];
  12         ok(!defined($copy), $_[1]);
  13 }
  14
  15 {
  16         package Foo;
  17         sub new { bless {}, shift }
  18 }
  19
  20 { # basic behaviour - can we call without args?
  21         my $foo = Foo->new;
  22
  23         my $called;
  24         my $code = $foo->$curry::curry(sub {
  25                 ok(shift->isa('Foo'), '$curry::curry object is correct class');
  26                 ok(!@_, '$curry::curry did not pick up any stray parameters');
  27                 ++$called;
  28         });
  29         fail('$curry::curry did not give us a coderef') unless ref($code) eq 'CODE';
  30         $code->();
  31         ok($called, 'curried code was called');
  32         undef $foo;
  33         $called = 0;
  34         $code->();
  35         ok($called, 'curried code executed successfully after original object goes out of scope');
  36 }
  37
  38 { # parameter passthrough
  39         my $foo = Foo->new;
  40
  41         my $called;
  42         my $code = $foo->$curry::curry(sub {
  43                 ok(shift->isa('Foo'), '$curry::curry object is correct class');
  44                 is_deeply(\@_, [qw(one two three)], 'curried code had the expected parameters');
  45                 ++$called;
  46         });
  47         fail('$curry::curry did not give us a coderef') unless ref($code) eq 'CODE';
  48         $code->(qw(one two three));
  49         ok($called, 'curried code was called');
  50         undef $foo;
  51         $called = 0;
  52         $code->(qw(one two three));
  53         ok($called, 'curried code again executed successfully after original object goes out of scope');
  54 }
  55
  56 { # stashed parameters
  57         my $foo = Foo->new;
  58
  59         my $called;
  60         my $code = $foo->$curry::curry(sub {
  61                 ok(shift->isa('Foo'), '$curry::curry object is correct class');
  62                 is_deeply(\@_, [qw(stashed parameters one two three)], 'curried code had the expected parameters');
  63                 ++$called;
  64         }, qw(stashed parameters));
  65         fail('$curry::curry did not give us a coderef') unless ref($code) eq 'CODE';
  66         $code->(qw(one two three));
  67         ok($called, 'curried code was called');
  68         undef $foo;
  69         $called = 0;
  70         $code->(qw(one two three));
  71         ok($called, 'curried code again executed successfully after original object goes out of scope');
  72 }
  73
  74 done_testing;