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 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(UP),   undef, 'main : want_at UP';
  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(UP), 1, 'sub : want_at UP';
  37   for (1) {
  38    check want_at,        1, 'for : want_at';
  39    check want_at(UP),    1, 'for : want_at UP';
  40    check want_at(UP UP), 1, 'for : want_at UP UP';
  41   }
  42   eval "
  43    check want_at,        undef, 'eval string : want_at';
  44    check want_at(UP),    1,     'eval string : want_at UP';
  45    check want_at(UP UP), 1,     'eval string : want_at UP UP';
  46   ";
  47   my $x = eval {
  48    do {
  49     check want_at,        0, 'do : want_at';
  50     check want_at(UP),    0, 'do : want_at UP';
  51     check want_at(UP UP), 1, 'do : want_at UP UP';
  52    };
  53    check want_at,        0, 'eval : want_at';
  54    check want_at(UP),    1, 'eval : want_at UP';
  55    check want_at(UP UP), 1, 'eval : want_at UP UP';
  56   };
  57  }
  58 }->();