t/23-localize-ctl.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 28;
   7
   8 use Scope::Upper qw/localize/;
   9
  10 our ($x, $y);
  11
  12 {
  13  local $x = 1;
  14  {
  15   local $x = 2;
  16   {
  17    localize '$y' => 1 => 2;
  18   }
  19   is $x, 2,     'goto 1 [not yet - x]';
  20   is $y, undef, 'goto 1 [not yet - y]';
  21   {
  22    local $x = 3;
  23    goto OVER1;
  24   }
  25  }
  26  $y = 0;
  27 OVER1:
  28  is $x, 1, 'goto 1 [ok - x]';
  29  is $y, 1, 'goto 1 [ok - y]';
  30 }
  31
  32 $y = undef;
  33 {
  34  local $x = 1;
  35  {
  36   local $x = 2;
  37   {
  38    local $x = 3;
  39    {
  40     localize '$y' => 1 => 3;
  41    }
  42    is $x, 3,     'goto 2 [not yet - x]';
  43    is $y, undef, 'goto 2 [not yet - y]';
  44    {
  45     local $x = 4;
  46     goto OVER2;
  47    }
  48   }
  49  }
  50  $y = 0;
  51 OVER2:
  52  is $x, 1, 'goto 2 [ok - x]';
  53  is $y, 1, 'goto 2 [ok - y]';
  54 }
  55
  56 $y = undef;
  57 {
  58  local $x = 1;
  59  {
  60   eval {
  61    local $x = 2;
  62    {
  63     {
  64      local $x = 3;
  65      localize '$y' => 1 => 4;
  66      is $x, 3,     'die - reap outside eval [not yet 1 - x]';
  67      is $y, undef, 'die - reap outside eval [not yet 1 - y]';
  68     }
  69     is $x, 2,     'die - reap outside eval [not yet 2 - x]';
  70     is $y, undef, 'die - reap outside eval [not yet 2 - y]';
  71     die;
  72    }
  73   };
  74   is $x, 1,     'die - reap outside eval [not yet 3 - x]';
  75   is $y, undef, 'die - reap outside eval [not yet 3 - y]';
  76  } # should trigger here
  77  is $x, 1, 'die - reap outside eval [ok - x]';
  78  is $y, 1, 'die - reap outside eval [ok - y]';
  79 }
  80
  81 $y = undef;
  82 {
  83  local $x = 1;
  84  eval {
  85   local $x = 2;
  86   {
  87    {
  88     local $x = 3;
  89     localize '$y' => 1 => 3;
  90     is $x, 3,     'die - reap at eval [not yet 1 - x]';
  91     is $y, undef, 'die - reap at eval [not yet 1 - y]';
  92    }
  93    is $x, 2,     'die - reap at eval [not yet 2 - x]';
  94    is $y, undef, 'die - reap at eval [not yet 2 - y]';
  95    die;
  96   }
  97  }; # should trigger here
  98  is $x, 1, 'die - reap at eval [ok - x]';
  99  is $y, 1, 'die - reap at eval [ok - y]';
 100 }
 101
 102 $y = undef;
 103 {
 104  local $x = 1;
 105  eval {
 106   local $x = 2;
 107   {
 108    {
 109     local $x = 3;
 110     localize '$y' => 1 => 2;
 111     is $x, 3,     'die - reap inside eval [not yet 1 - x]';
 112     is $y, undef, 'die - reap inside eval [not yet 1 - y]';
 113    }
 114    is $x, 2,     'die - reap inside eval [not yet 2 - x]';
 115    is $y, undef, 'die - reap inside eval [not yet 2 - y]';
 116    die;
 117   } # should trigger here
 118  };
 119  is $x, 1,     'die - reap inside eval [ok - x]';
 120  is $y, undef, 'die - reap inside eval [ok - y]';
 121 }