t/67-uplevel-scope.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 2 + 2 * 6 + 3 * 2;
   7
   8 use Scope::Upper qw<uplevel HERE UP>;
   9
  10 {
  11  our $x = 1;
  12  sub {
  13   local $x = 2;
  14   sub {
  15    local $x = 3;
  16    uplevel { is $x, 3, 'global variables scoping 1' } HERE;
  17   }->();
  18  }->();
  19 }
  20
  21 {
  22  our $x = 4;
  23  sub {
  24   local $x = 5;
  25   sub {
  26    local $x = 6;
  27    uplevel { is $x, 6, 'global variables scoping 2' } UP;
  28   }->();
  29  }->();
  30 }
  31
  32 sub {
  33  'abc' =~ /(.)/;
  34  is $1, 'a', 'match variables scoping 1: before 1';
  35  sub {
  36   'uvw' =~ /(.)/;
  37   is $1, 'u', 'match variables scoping 1: before 2';
  38   uplevel {
  39    is $1, 'u', 'match variables scoping 1: before 3';
  40    'xyz' =~ /(.)/;
  41    is $1, 'x', 'match variables scoping 1: after 1';
  42   } HERE;
  43   is $1, 'u', 'match variables scoping 1: after 2';
  44  }->();
  45  is $1, 'a', 'match variables scoping 1: after 3';
  46 }->();
  47
  48 sub {
  49  'abc' =~ /(.)/;
  50  is $1, 'a', 'match variables scoping 2: before 1';
  51  sub {
  52   'uvw' =~ /(.)/;
  53   is $1, 'u', 'match variables scoping 2: before 2';
  54   uplevel {
  55    is $1, 'u', 'match variables scoping 2: before 3';
  56    'xyz' =~ /(.)/;
  57    is $1, 'x', 'match variables scoping 2: after 1';
  58   } UP;
  59   is $1, 'u', 'match variables scoping 2: after 2';
  60  }->();
  61  is $1, 'a', 'match variables scoping 2: after 3';
  62 }->();
  63
  64 SKIP: {
  65  skip 'No state variables before perl 5.10' => 3 * 2 unless "$]" >= 5.010;
  66
  67  my $desc = 'state variables';
  68
  69  {
  70   local $@;
  71   eval 'use feature "state"; sub herp { state $id = 123; return ++$id }';
  72   die $@ if $@;
  73  }
  74
  75  sub derp {
  76   sub {
  77    &uplevel(\&herp => UP);
  78   }->();
  79  }
  80
  81  for my $run (1 .. 3) {
  82   local $@;
  83   my $ret = eval {
  84    derp()
  85   };
  86   is $@,   '',         "$desc: run $run did not croak";
  87   is $ret, 123 + $run, "$desc: run $run returned the correct value";
  88  }
  89 }