t/11-target.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 14;
   7
   8 use Scope::Context;
   9
  10 use Scope::Upper qw<HERE>;
  11
  12 # Constructor
  13
  14 {
  15  my $here = Scope::Context->new;
  16  is $here->cxt, HERE, 'default context';
  17 }
  18
  19 {
  20  my $cxt = HERE;
  21  {
  22   my $here = Scope::Context->new($cxt);
  23   is $here->cxt, $cxt, 'forced context';
  24  }
  25 }
  26
  27 # up
  28
  29 {
  30  my $cxt = HERE;
  31  {
  32   my $here = Scope::Context->new;
  33   my $up = $here->up;
  34   is $up->cxt, $cxt, 'up(undef)';
  35  }
  36 }
  37
  38 {
  39  my $cxt = HERE;
  40  {
  41   my $here = Scope::Context->new;
  42   my $up1 = $here->up(1);
  43   is $up1->cxt, $cxt, 'up(1)';
  44  }
  45 }
  46
  47 {
  48  my $cxt = HERE;
  49  {
  50   {
  51    my $up2 = Scope::Context->up(2);
  52    is $up2->cxt, $cxt, 'up(2)';
  53   }
  54  }
  55 }
  56
  57 # sub
  58
  59 {
  60  sub {
  61   my $cxt = HERE;
  62   {
  63    my $sub = Scope::Context->new->sub;
  64    is $sub->cxt, $cxt, 'sub(undef)';
  65   }
  66  }->();
  67 }
  68
  69 {
  70  sub {
  71   my $cxt = HERE;
  72   {
  73    my $sub = Scope::Context->new->sub(0);
  74    is $sub->cxt, $cxt, 'sub(0)';
  75   }
  76  }->();
  77 }
  78
  79 {
  80  sub {
  81   my $cxt = HERE;
  82   sub {
  83    my $sub = Scope::Context->sub(1);
  84    is $sub->cxt, $cxt, 'sub(1)';
  85   }->();
  86  }->();
  87 }
  88
  89 # eval
  90
  91 {
  92  local $@;
  93  eval {
  94   my $cxt = HERE;
  95   {
  96    my $eval = Scope::Context->new->eval;
  97    is $eval->cxt, $cxt, 'eval(undef)';
  98   }
  99  };
 100  die $@ if $@;
 101 }
 102
 103 {
 104  local $@;
 105  eval {
 106   my $cxt = HERE;
 107   {
 108    my $eval = Scope::Context->new->eval(0);
 109    is $eval->cxt, $cxt, 'eval(0)';
 110   }
 111  };
 112  die $@ if $@;
 113 }
 114
 115 {
 116  local $@;
 117  eval {
 118   my $cxt = HERE;
 119   eval {
 120    my $eval = Scope::Context->eval(1);
 121    is $eval->cxt, $cxt, 'eval(1)';
 122   };
 123   die $@ if $@;
 124  };
 125  die $@ if $@;
 126 }
 127
 128 # want
 129
 130 {
 131  my $want;
 132  {
 133   local $@;
 134   my @res = eval {
 135    $want = Scope::Context->up->want;
 136   };
 137   die $@ if $@;
 138  };
 139  is $want, undef, 'want: void context';
 140 }
 141
 142 {
 143  local $@;
 144  my $want;
 145  my $scalar = eval {
 146   my @res = do {
 147    $want = Scope::Context->eval->want;
 148   };
 149   'XXX';
 150  };
 151  die $@ if $@;
 152  is $want, !1, 'scalar context';
 153 }
 154
 155 {
 156  my $want;
 157  my @list = sub {
 158   sub {
 159    $want = Scope::Context->sub->up->want;
 160   }->();
 161   'YYY';
 162  }->();
 163  is $want, 1, 'want: list context';
 164 }