t/06-want_at.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 19;
   7
   8 use Scope::Upper qw/want_at/;
   9
  10 sub check {
  11  my ($w, $exp, $desc) = @_;
  12  my $cx = sub {
  13   my $a = shift;
  14   if (!defined $a) {
  15    return 'void';
  16   } elsif ($a) {
  17    return 'list';
  18   } else {
  19    return 'scalar';
  20   }
  21  };
  22  is $cx->($w), $cx->($exp), $desc;
  23 }
  24
  25 my $w;
  26
  27 check want_at,     undef, 'main : want_at';
  28 check want_at(0),  undef, 'main : want_at(0)';
  29 check want_at(1),  undef, 'main : want_at(1)';
  30 check want_at(-1), undef, 'main : want_at(-1)';
  31
  32 my @a = sub {
  33  check want_at, 1, 'sub0 : want_at';
  34  {
  35   check want_at,    1, 'sub : want_at';
  36   check want_at(1), 1, 'sub : want_at(1)';
  37   for (1) {
  38    check want_at,    1, 'for : want_at';
  39    check want_at(1), 1, 'for : want_at(1)';
  40    check want_at(2), 1, 'for : want_at(2)';
  41   }
  42   eval "
  43    check want_at,    undef, 'eval string : want_at';
  44    check want_at(1), 1,     'eval string : want_at(1)';
  45    check want_at(2), 1,     'eval string : want_at(2)';
  46   ";
  47   my $x = eval {
  48    do {
  49     check want_at,    0, 'do : want_at';
  50     check want_at(1), 0, 'do : want_at(0)';
  51     check want_at(2), 1, 'do : want_at(1)';
  52    };
  53    check want_at,    0, 'eval : want_at';
  54    check want_at(1), 1, 'eval : want_at(0)';
  55    check want_at(2), 1, 'eval : want_at(1)';
  56   };
  57  }
  58 }->();