t/40-localize_delete-target.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 53 + 4;
   7
   8 use Scope::Upper qw<localize_delete UP HERE>;
   9
  10 # Arrays
  11
  12 our @a;
  13
  14 {
  15  local @a = (4 .. 6);
  16  {
  17   localize_delete '@main::a', 1 => HERE;
  18   is_deeply \@a, [ 4, undef, 6 ], 'localize_delete "@a", 1 => HERE [ok]';
  19  }
  20  is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 1 => HERE [end]';
  21 }
  22
  23 {
  24  local @a = (4 .. 6);
  25  {
  26   localize_delete '@main::a', 4 => HERE;
  27   is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (nonexistent) => HERE [ok]';
  28  }
  29  is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (nonexistent) => HERE [end]';
  30 }
  31
  32 {
  33  local @a = (4 .. 6);
  34  local $a[4] = 7;
  35  {
  36   localize_delete '@main::a', 4 => HERE;
  37   is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (exists) => HERE [ok]';
  38  }
  39  is_deeply \@a, [ 4 .. 6, undef, 7 ], 'localize_delete "@a", 4 (exists) => HERE [end]';
  40 }
  41
  42 {
  43  local @a = (4 .. 6);
  44  {
  45   localize_delete '@main::a', -2 => HERE;
  46   is_deeply \@a, [ 4, undef, 6 ], 'localize_delete "@a", -2 => HERE [ok]';
  47  }
  48  is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", -2 => HERE [end]';
  49 }
  50
  51 {
  52  local @a = (4 .. 6);
  53  local $a[4] = 7;
  54  {
  55   localize_delete '@main::a', -1 => HERE;
  56   is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", -1 (exists) => HERE [ok]';
  57  }
  58  is_deeply \@a, [ 4 .. 6, undef, 7 ], 'localize_delete "@a", -1 (exists) => HERE [end]';
  59 }
  60
  61 {
  62  local @a = (4 .. 6);
  63  {
  64   eval { localize_delete '@main::a', -4 => HERE };
  65   like $@, qr/Modification of non-creatable array value attempted, subscript -4/, 'localize_delete "@a", -4 (out of bounds) => HERE [ok]';
  66  }
  67  is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", -4 (out of bounds) => HERE [end]';
  68 }
  69
  70 {
  71  local @a = (4 .. 6);
  72  {
  73   local @a = (5 .. 7);
  74   {
  75    localize_delete '@main::a', 1 => UP;
  76    is_deeply \@a, [ 5 .. 7 ], 'localize_delete "@a", 1 => UP [not yet]';
  77   }
  78   is_deeply \@a, [ 5, undef, 7 ], 'localize_delete "@a", 1 => UP [ok]';
  79  }
  80  is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 1 => UP [end]';
  81 }
  82
  83 {
  84  local @a = (4 .. 6);
  85  {
  86   local @a = (5 .. 7);
  87   {
  88    localize_delete '@main::a', 4 => UP;
  89    is_deeply \@a, [ 5 .. 7 ], 'localize_delete "@a", 4 (nonexistent) => UP [not yet]';
  90   }
  91   is_deeply \@a, [ 5 .. 7 ], 'localize_delete "@a", 4 (nonexistent) => UP [ok]';
  92  }
  93  is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (nonexistent) => UP [end]';
  94 }
  95
  96 {
  97  local @a = (4 .. 6);
  98  {
  99   local @a = (5 .. 7);
 100   local $a[4] = 8;
 101   {
 102    localize_delete '@main::a', 4 => UP;
 103    is_deeply \@a, [ 5 .. 7, undef, 8 ], 'localize_delete "@a", 4 (exists) => UP [not yet]';
 104   }
 105   is_deeply \@a, [ 5 .. 7 ], 'localize_delete "@a", 4 (exists) => UP [ok]';
 106  }
 107  is_deeply \@a, [ 4 .. 6 ], 'localize_delete "@a", 4 (exists) => UP [end]';
 108 }
 109
 110 {
 111  {
 112   localize_delete '@nonexistent', 2;
 113   is_deeply eval('*nonexistent{ARRAY}'), [ ],
 114                        'localize_delete "@nonexistent", anything => HERE [ok]';
 115  }
 116  is_deeply eval('*nonexistent{ARRAY}'), [ ],
 117                        'localize_delete "@nonexistent", anything => HERE [end]';
 118 }
 119
 120 # Hashes
 121
 122 our %h;
 123
 124 {
 125  local %h = (a => 1, b => 2);
 126  {
 127   localize_delete '%main::h', 'a' => HERE;
 128   is_deeply \%h, { b => 2 }, 'localize_delete "%h", "a" => HERE [ok]';
 129  }
 130  is_deeply \%h, { a => 1, b => 2 }, 'localize_delete "%h", "a" => HERE [end]';
 131 }
 132
 133 {
 134  local %h = (a => 1, b => 2);
 135  {
 136   localize_delete '%main::h', 'c' => HERE;
 137   is_deeply \%h, { a => 1, b => 2 }, 'localize_delete "%h", "c" => HERE [ok]';
 138  }
 139  is_deeply \%h, { a => 1, b => 2 }, 'localize_delete "%h", "c" => HERE [end]';
 140 }
 141
 142 {
 143  local %h = (a => 1, b => 2);
 144  {
 145   local %h = (a => 3, c => 4);
 146   {
 147    localize_delete '%main::h', 'a' => UP;
 148    is_deeply \%h, { a => 3, c => 4 }, 'localize_delete "%h", "a" => UP [not yet]';
 149   }
 150   is_deeply \%h, { c => 4 }, 'localize_delete "%h", "a" => UP [ok]';
 151  }
 152  is_deeply \%h, { a => 1, b => 2 }, 'localize_delete "%h", "a" => UP [end]';
 153 }
 154
 155 {
 156  {
 157   localize_delete '%nonexistent', 'a';
 158   is_deeply eval('*nonexistent{HASH}'), { },
 159                        'localize_delete "%nonexistent", anything => HERE [ok]';
 160  }
 161  is_deeply eval('*nonexistent{HASH}'), { },
 162                        'localize_delete "%nonexistent", anything => HERE [end]';
 163 }
 164
 165 # Scalars
 166
 167 our $x = 1;
 168 {
 169  localize_delete '$x', 2 => HERE;
 170  is $x, undef, 'localize_delete "$x", anything => HERE [ok]';
 171 }
 172 is $x, 1, 'localize_delete "$x", anything => HERE [end]';
 173
 174 {
 175  {
 176   localize_delete '$nonexistent', 2;
 177   is eval('${*nonexistent{SCALAR}}'), undef,
 178                        'localize_delete "$nonexistent", anything => HERE [ok]';
 179  }
 180  is eval('${*nonexistent{SCALAR}}'), undef,
 181                        'localize_delete "$nonexistent", anything => HERE [end]';
 182 }
 183
 184 # Code
 185
 186 sub x { 1 };
 187 {
 188  localize_delete '&x', 2 => HERE;
 189  ok !exists(&x), 'localize_delete "&x", anything => HERE [ok]';
 190 }
 191 is x(), 1, 'localize_delete "&x", anything => HERE [end]';
 192
 193 {
 194  {
 195   localize_delete '&nonexistent', 2;
 196   is eval('exists &nonexistent'), !1,
 197                        'localize_delete "&nonexistent", anything => HERE [ok]';
 198  }
 199  is eval('exists &nonexistent'), !1,
 200                        'localize_delete "&nonexistent", anything => HERE [end]';
 201 }
 202
 203 {
 204  localize_delete *x, sub { } => HERE;
 205  is !exists(&x),  1, 'localize_delete *x, anything => HERE [ok 1]';
 206  is !defined($x), 1, 'localize_delete *x, anything => HERE [ok 2]';
 207 }
 208 is x(), 1, 'localize_delete *x, anything => HERE [end 1]';
 209 is $x,  1, 'localize_delete *x, anything => HERE [end 2]';
 210
 211 sub X::foo { 'X::foo' }
 212
 213 {
 214  {
 215   {
 216    localize_delete '&X::foo', undef => UP;
 217    is(X->foo(), 'X::foo', 'localize_delete "&X::foo", undef => UP [not yet X]');
 218   }
 219   ok(!X->can('foo'), 'localize_delete "&X::foo", undef => UP [ok X]');
 220  }
 221  is(X->foo(), 'X::foo', 'localize_delete "&X::foo", undef => UP [end X]');
 222 }
 223
 224 @Y::ISA = 'X';
 225
 226 {
 227  {
 228   {
 229    localize_delete '&X::foo', undef => UP;
 230    is(Y->foo(), 'X::foo', 'localize_delete "&X::foo", undef => UP [not yet Y]');
 231   }
 232   ok(!Y->can('foo'), 'localize_delete "&X::foo", undef => UP [ok Y]');
 233  }
 234  is(Y->foo(), 'X::foo', 'localize_delete "&X::foo", undef => UP [end Y]');
 235 }
 236
 237
 238 {
 239  local *Y::foo = sub { 'Y::foo' };
 240  {
 241   {
 242    localize_delete '&Y::foo', undef => UP;
 243    is(Y->foo(), 'Y::foo', 'localize_delete "&Y::foo", undef => UP [not yet]');
 244   }
 245   is(Y->foo(), 'X::foo', 'localize_delete "&Y::foo", undef => UP [ok]');
 246  }
 247  is(Y->foo(), 'Y::foo', 'localize_delete "&Y::foo", undef => UP [end]');
 248 }
 249
 250 {
 251  # Prevent 'only once' warnings
 252  local *Y::foo = *Y::foo;
 253 }
 254
 255 # Invalid
 256
 257 sub invalid_ref { qr/^Invalid \Q$_[0]\E reference as the localization target/ }
 258
 259 {
 260  eval { localize_delete \1, 0 => HERE };
 261  like $@, invalid_ref('SCALAR'), 'invalid localize_delete \1, 0 => HERE';
 262 }
 263
 264 {
 265  eval { localize_delete [ ], 0 => HERE };
 266  like $@, invalid_ref('ARRAY'),  'invalid localize_delete [ ], 0 => HERE';
 267 }
 268
 269 {
 270  eval { localize_delete { }, 0 => HERE };
 271  like $@, invalid_ref('HASH'),   'invalid localize_delete { }, 0 => HERE';
 272 }
 273
 274 {
 275  eval { localize_delete sub { }, 0 => HERE };
 276  like $@, invalid_ref('CODE'),   'invalid localize_delete sub { }, 0 => HERE';
 277 }