t/23-localize-ctl.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 44;
   7
   8 use Scope::Upper qw/localize/;
   9
  10 our ($x, $y);
  11
  12 {
  13  local $x = 1;
  14  {
  15   local $x = 2;
  16   localize '$y' => 1 => 0;
  17   is $x, 2, 'last 0 [ok - x]';
  18   is $y, 1, 'last 0 [ok - y]';
  19   last;
  20   $y = 2;
  21  }
  22  is $x, 1,     'last 0 [end - x]';
  23  is $y, undef, 'last 0 [end - y]';
  24 }
  25
  26 {
  27  local $x = 1;
  28 LOOP:
  29  {
  30   local $x = 2;
  31   local $y = 0;
  32   {
  33    local $x = 3;
  34    localize '$y' => 1 => 1;
  35    is $x, 3, 'last 1 [ok - x]';
  36    is $y, 0, 'last 1 [ok - y]';
  37    last LOOP;
  38    $y = 3;
  39   }
  40   $y = 2;
  41  }
  42  is $x, 1,     'last 1 [end - x]';
  43  is $y, undef, 'last 1 [end - y]';
  44 }
  45
  46 {
  47  local $x = 1;
  48  {
  49   local $x = 2;
  50   localize '$y' => 1 => 0;
  51   is $x, 2, 'next 0 [ok - x]';
  52   is $y, 1, 'next 0 [ok - y]';
  53   next;
  54   $y = 2;
  55  }
  56  is $x, 1,     'next 0 [end - x]';
  57  is $y, undef, 'next 0 [end - y]';
  58 }
  59
  60 {
  61  local $x = 1;
  62 LOOP:
  63  {
  64   local $x = 2;
  65   local $y = 0;
  66   {
  67    local $x = 3;
  68    localize '$y' => 1 => 1;
  69    is $x, 3, 'next 1 [ok - x]';
  70    is $y, 0, 'next 1 [ok - y]';
  71    next LOOP;
  72    $y = 3;
  73   }
  74   $y = 2;
  75  }
  76  is $x, 1,     'next 1 [end - x]';
  77  is $y, undef, 'next 1 [end - y]';
  78 }
  79
  80 {
  81  local $x = 1;
  82  {
  83   local $x = 2;
  84   {
  85    localize '$y' => 1 => 2;
  86   }
  87   is $x, 2,     'goto 1 [not yet - x]';
  88   is $y, undef, 'goto 1 [not yet - y]';
  89   {
  90    local $x = 3;
  91    goto OVER1;
  92   }
  93  }
  94  $y = 0;
  95 OVER1:
  96  is $x, 1, 'goto 1 [ok - x]';
  97  is $y, 1, 'goto 1 [ok - y]';
  98 }
  99
 100 $y = undef;
 101 {
 102  local $x = 1;
 103  {
 104   local $x = 2;
 105   {
 106    local $x = 3;
 107    {
 108     localize '$y' => 1 => 3;
 109    }
 110    is $x, 3,     'goto 2 [not yet - x]';
 111    is $y, undef, 'goto 2 [not yet - y]';
 112    {
 113     local $x = 4;
 114     goto OVER2;
 115    }
 116   }
 117  }
 118  $y = 0;
 119 OVER2:
 120  is $x, 1, 'goto 2 [ok - x]';
 121  is $y, 1, 'goto 2 [ok - y]';
 122 }
 123
 124 $y = undef;
 125 {
 126  local $x = 1;
 127  {
 128   eval {
 129    local $x = 2;
 130    {
 131     {
 132      local $x = 3;
 133      localize '$y' => 1 => 4;
 134      is $x, 3,     'die - reap outside eval [not yet 1 - x]';
 135      is $y, undef, 'die - reap outside eval [not yet 1 - y]';
 136     }
 137     is $x, 2,     'die - reap outside eval [not yet 2 - x]';
 138     is $y, undef, 'die - reap outside eval [not yet 2 - y]';
 139     die;
 140    }
 141   };
 142   is $x, 1,     'die - reap outside eval [not yet 3 - x]';
 143   is $y, undef, 'die - reap outside eval [not yet 3 - y]';
 144  } # should trigger here
 145  is $x, 1, 'die - reap outside eval [ok - x]';
 146  is $y, 1, 'die - reap outside eval [ok - y]';
 147 }
 148
 149 $y = undef;
 150 {
 151  local $x = 1;
 152  eval {
 153   local $x = 2;
 154   {
 155    {
 156     local $x = 3;
 157     localize '$y' => 1 => 3;
 158     is $x, 3,     'die - reap at eval [not yet 1 - x]';
 159     is $y, undef, 'die - reap at eval [not yet 1 - y]';
 160    }
 161    is $x, 2,     'die - reap at eval [not yet 2 - x]';
 162    is $y, undef, 'die - reap at eval [not yet 2 - y]';
 163    die;
 164   }
 165  }; # should trigger here
 166  is $x, 1, 'die - reap at eval [ok - x]';
 167  is $y, 1, 'die - reap at eval [ok - y]';
 168 }
 169
 170 $y = undef;
 171 {
 172  local $x = 1;
 173  eval {
 174   local $x = 2;
 175   {
 176    {
 177     local $x = 3;
 178     localize '$y' => 1 => 2;
 179     is $x, 3,     'die - reap inside eval [not yet 1 - x]';
 180     is $y, undef, 'die - reap inside eval [not yet 1 - y]';
 181    }
 182    is $x, 2,     'die - reap inside eval [not yet 2 - x]';
 183    is $y, undef, 'die - reap inside eval [not yet 2 - y]';
 184    die;
 185   } # should trigger here
 186  };
 187  is $x, 1,     'die - reap inside eval [ok - x]';
 188  is $y, undef, 'die - reap inside eval [ok - y]';
 189 }