t/23-localize-ctl.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 44 + 30;
   7
   8 use Scope::Upper qw<localize UP HERE>;
   9
  10 our ($x, $y);
  11
  12 {
  13  local $x = 1;
  14  {
  15   local $x = 2;
  16   localize '$y' => 1 => HERE;
  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 => UP;
  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 => HERE;
  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 => UP;
  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 => UP UP;
  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 => UP UP UP;
 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 => UP UP UP UP;
 134      is $x, 3,     'die - localize outside eval [not yet 1 - x]';
 135      is $y, undef, 'die - localize outside eval [not yet 1 - y]';
 136     }
 137     is $x, 2,     'die - localize outside eval [not yet 2 - x]';
 138     is $y, undef, 'die - localize outside eval [not yet 2 - y]';
 139     die;
 140    }
 141   };
 142   is $x, 1,     'die - localize outside eval [not yet 3 - x]';
 143   is $y, undef, 'die - localize outside eval [not yet 3 - y]';
 144  } # should trigger here
 145  is $x, 1, 'die - localize outside eval [ok - x]';
 146  is $y, 1, 'die - localize 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 => UP UP UP;
 158     is $x, 3,     'die - localize at eval [not yet 1 - x]';
 159     is $y, undef, 'die - localize at eval [not yet 1 - y]';
 160    }
 161    is $x, 2,     'die - localize at eval [not yet 2 - x]';
 162    is $y, undef, 'die - localize at eval [not yet 2 - y]';
 163    die;
 164   }
 165  }; # should trigger here
 166  is $x, 1, 'die - localize at eval [ok - x]';
 167  is $y, 1, 'die - localize 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 => UP UP;
 179     is $x, 3,     'die - localize inside eval [not yet 1 - x]';
 180     is $y, undef, 'die - localize inside eval [not yet 1 - y]';
 181    }
 182    is $x, 2,     'die - localize inside eval [not yet 2 - x]';
 183    is $y, undef, 'die - localize inside eval [not yet 2 - y]';
 184    die;
 185   } # should trigger here
 186  };
 187  is $x, 1,     'die - localize inside eval [ok - x]';
 188  is $y, undef, 'die - localize inside eval [ok - y]';
 189 }
 190
 191 SKIP:
 192 {
 193  skip 'Perl 5.10 required to test given/when' => 30 if "$]" < 5.010;
 194  skip 'Not testing deprecated given/when on Perl 5.37.10 or later'
 195       => 30 if "$]" >= 5.037010;
 196
 197  eval <<' GIVEN_TEST_1';
 198   BEGIN {
 199    if ("$]" >= 5.017_011) {
 200     require warnings;
 201     warnings->unimport('experimental::smartmatch');
 202    }
 203   }
 204   use feature 'switch';
 205   local $y;
 206   {
 207    local $x = 1;
 208    given (1) {
 209     local $x = 2;
 210     when (1) {
 211      local $x = 3;
 212      localize '$y' => 1 => UP UP;
 213      is $x, 3,     'given/when - localize at given [not yet - x]';
 214      is $y, undef, 'given/when - localize at given [not yet - y]';
 215     }
 216     fail 'not reached';
 217    }
 218    is $x, 1, 'given/when - localize at given [ok - x]';
 219    is $y, 1, 'given/when - localize at given [ok - y]';
 220   }
 221  GIVEN_TEST_1
 222  fail $@ if $@;
 223
 224  eval <<' GIVEN_TEST_2';
 225   BEGIN {
 226    if ("$]" >= 5.017_011) {
 227     require warnings;
 228     warnings->unimport('experimental::smartmatch');
 229    }
 230   }
 231   use feature 'switch';
 232   local $y;
 233   {
 234    local $x = 1;
 235    given (1) {
 236     local $x = 2;
 237     when (1) {
 238      local $x = 3;
 239      localize '$y' => 1 => UP UP;
 240      is $x, 3,     'given/when/continue - localize at given [not yet 1 - x]';
 241      is $y, undef, 'given/when/continue - localize at given [not yet 1 - y]';
 242      continue;
 243     }
 244     is $x, 2,     'given/when/continue - localize at given [not yet 2 - x]';
 245     is $y, undef, 'given/when/continue - localize at given [not yet 2 - y]';
 246    }
 247    is $x, 1, 'given/when/continue - localize at given [ok - x]';
 248    is $y, 1, 'given/when/continue - localize at given [ok - y]';
 249   }
 250  GIVEN_TEST_2
 251  fail $@ if $@;
 252
 253  eval <<' GIVEN_TEST_3';
 254   BEGIN {
 255    if ("$]" >= 5.017_011) {
 256     require warnings;
 257     warnings->unimport('experimental::smartmatch');
 258    }
 259   }
 260   use feature 'switch';
 261   local $y;
 262   {
 263    local $x = 1;
 264    given (1) {
 265     local $x = 2;
 266     default {
 267      local $x = 3;
 268      localize '$y' => 1 => UP UP;
 269      is $x, 3,     'given/default - localize at given [not yet - x]';
 270      is $y, undef, 'given/default - localize at given [not yet - y]';
 271     }
 272     fail 'not reached';
 273    }
 274    is $x, 1, 'given/default - localize at given [ok - x]';
 275    is $y, 1, 'given/default - localize at given [ok - y]';
 276   }
 277  GIVEN_TEST_3
 278  fail $@ if $@;
 279
 280  eval <<' GIVEN_TEST_4';
 281   BEGIN {
 282    if ("$]" >= 5.017_011) {
 283     require warnings;
 284     warnings->unimport('experimental::smartmatch');
 285    }
 286   }
 287   use feature 'switch';
 288   local $y;
 289   {
 290    local $x = 1;
 291    given (1) {
 292     local $x = 2;
 293     default {
 294      local $x = 3;
 295      localize '$y' => 1 => UP UP;
 296      is $x, 3,     'given/default/continue - localize at given [not yet 1 - x]';
 297      is $y, undef, 'given/default/continue - localize at given [not yet 1 - y]';
 298      continue;
 299     }
 300     is $x, 2,     'given/default/continue - localize at given [not yet 2 - x]';
 301     is $y, undef, 'given/default/continue - localize at given [not yet 2 - y]';
 302    }
 303    is $x, 1, 'given/default/continue - localize at given [ok - x]';
 304    is $y, 1, 'given/default/continue - localize at given [ok - y]';
 305   }
 306  GIVEN_TEST_4
 307  fail $@ if $@;
 308
 309  eval <<' GIVEN_TEST_5';
 310   BEGIN {
 311    if ("$]" >= 5.017_011) {
 312     require warnings;
 313     warnings->unimport('experimental::smartmatch');
 314    }
 315   }
 316   use feature 'switch';
 317   local $y;
 318   {
 319    local $x = 1;
 320    given (1) {
 321     local $x = 2;
 322     default {
 323      local $x = 3;
 324      given (2) {
 325       local $x = 4;
 326       when (2) {
 327        local $x = 5;
 328        localize '$y' => 1 => UP UP UP;
 329        is $x, 5,     'given/default/given/when - localize at default [not yet 1 - x]';
 330        is $y, undef, 'given/default/given/when - localize at default [not yet 1 - y]';
 331        continue;
 332       }
 333       is $x, 4,     'given/default/given/when - localize at default [not yet 2 - x]';
 334       is $y, undef, 'given/default/given/when - localize at default [not yet 2 - y]';
 335      }
 336      is $x, 3,     'given/default/given/when - localize at default [not yet 3 - x]';
 337      is $y, undef, 'given/default/given/when - localize at default [not yet 3 - y]';
 338      continue;
 339     }
 340     is $x, 2, 'given/default/given/when - localize at default [ok 1 - x]';
 341     is $y, 1, 'given/default/given/when - localize at default [ok 1 - y]';
 342    }
 343    is $x, 1,     'given/default/given/when - localize at default [ok 2 - x]';
 344    is $y, undef, 'given/default/given/when - localize at default [ok 2 - y]';
 345   }
 346  GIVEN_TEST_5
 347  fail $@ if $@;
 348 }