t/06-want_at.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 18;
   7
   8 use Scope::Upper qw<want_at UP HERE>;
   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(HERE), undef, 'main : want_at HERE';
  29 check want_at(-1),   undef, 'main : want_at -1';
  30
  31 my @a = sub {
  32  check want_at, 1, 'sub0 : want_at';
  33  {
  34   check want_at,     1, 'sub : want_at';
  35   check want_at(UP), 1, 'sub : want_at UP';
  36   for (1) {
  37    check want_at,        1, 'for : want_at';
  38    check want_at(UP),    1, 'for : want_at UP';
  39    check want_at(UP UP), 1, 'for : want_at UP UP';
  40   }
  41   eval "
  42    check want_at,        undef, 'eval string : want_at';
  43    check want_at(UP),    1,     'eval string : want_at UP';
  44    check want_at(UP UP), 1,     'eval string : want_at UP UP';
  45   ";
  46   my $x = eval {
  47    do {
  48     check want_at,        0, 'do : want_at';
  49     check want_at(UP),    0, 'do : want_at UP';
  50     check want_at(UP UP), 1, 'do : want_at UP UP';
  51    };
  52    check want_at,        0, 'eval : want_at';
  53    check want_at(UP),    1, 'eval : want_at UP';
  54    check want_at(UP UP), 1, 'eval : want_at UP UP';
  55   };
  56  }
  57 }->();