t/50-return.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Variable::Magic qw<wizard cast dispell getdata>;
   7
   8 use Test::More tests => 3 * 11;
   9
  10 our $destroyed;
  11
  12 my $destructor = wizard free => sub { ++$destroyed; return };
  13
  14 {
  15  my $increment;
  16
  17  my $increment_aux = wizard(
  18   data => sub { $_[1] },
  19   free => sub {
  20    my ($target) = $_[1];
  21    my $target_data = &getdata($target, $increment);
  22    local $target_data->{guard} = 1;
  23    ++$$target;
  24    return;
  25   },
  26  );
  27
  28  $increment = wizard(
  29   data => sub {
  30    return +{ guard => 0 };
  31   },
  32   set  => sub {
  33    return if $_[1]->{guard};
  34    my $token;
  35    cast $token, $increment_aux, $_[0];
  36    return \$token;
  37   },
  38  );
  39
  40  local $destroyed = 0;
  41
  42  {
  43   my $x = 0;
  44
  45   cast $x, $destructor;
  46
  47   {
  48    cast $x, $increment;
  49    is $x, 0;
  50    $x = 1;
  51    is $x, 2;
  52    $x = 123;
  53    is $x, 124;
  54    $x = -5;
  55    is $x, -4;
  56    $x = 27, is($x, 27);
  57    is $x, 28;
  58    my @y = ($x = -13, $x);
  59    is $x, -12;
  60    is "@y", '-13 -13';
  61   }
  62
  63   dispell $x, $increment;
  64
  65   $x = 456;
  66   is $x, 456;
  67
  68   is $destroyed, 0;
  69  }
  70
  71  is $destroyed, 1;
  72 }
  73
  74 {
  75  my $locker;
  76
  77  my $locker_aux = wizard(
  78   data => sub { $_[1] },
  79   free => sub {
  80    my ($target) = $_[1];
  81    my $target_data = &getdata($target, $locker);
  82    local $target_data->{guard} = 1;
  83    $$target = $target_data->{value};
  84    return;
  85   },
  86  );
  87
  88  $locker = wizard(
  89   data => sub {
  90    return +{ guard => 0, value => $_[1] };
  91   },
  92   set  => sub {
  93    return if $_[1]->{guard};
  94    my $token;
  95    cast $token, $locker_aux, $_[0];
  96    return \$token;
  97   },
  98  );
  99
 100  local $destroyed = 0;
 101
 102  {
 103   my $x = 0;
 104
 105   cast $x, $destructor;
 106
 107   {
 108    cast $x, $locker, 999;
 109    is $x, 0;
 110    $x = 1;
 111    is $x, 999;
 112    $x = 123;
 113    is $x, 999;
 114    $x = -5;
 115    is $x, 999;
 116    $x = 27, is($x, 27);
 117    is $x, 999;
 118    my @y = ($x = -13, $x);
 119    is $x, 999;
 120    is "@y", '-13 -13';
 121   }
 122
 123   dispell $x, $locker;
 124
 125   $x = 456;
 126   is $x, 456;
 127
 128   is $destroyed, 0;
 129  }
 130
 131  is $destroyed, 1;
 132 }
 133
 134 {
 135  my $delayed;
 136
 137  my $delayed_aux = wizard(
 138   data => sub { $_[1] },
 139   free => sub {
 140    my ($target) = $_[1];
 141    my $target_data = &getdata($target, $delayed);
 142    local $target_data->{guard} = 1;
 143    if (ref $target eq 'SCALAR') {
 144     my $orig = $$target;
 145     $$target = $target_data->{mangler}->($orig);
 146    }
 147    return;
 148   },
 149  );
 150
 151  $delayed = wizard(
 152   data => sub {
 153    return +{ guard => 0, mangler => $_[1] };
 154   },
 155   set  => sub {
 156    return if $_[1]->{guard};
 157    my $token;
 158    cast $token, $delayed_aux, $_[0];
 159    return \$token;
 160   },
 161  );
 162
 163  local $destroyed = 0;
 164
 165  {
 166   my $x = 0;
 167
 168   cast $x, $destructor;
 169
 170   {
 171    cast $x, $delayed => sub { $_[0] * 2 };
 172    is $x, 0;
 173    $x = 1;
 174    is $x, 2;
 175    $x = 123;
 176    is $x, 246;
 177    $x = -5;
 178    is $x, -10;
 179    $x = 27, is($x, 27);
 180    is $x, 54;
 181    my @y = ($x = -13, $x);
 182    is $x, -26;
 183    is "@y", '-13 -13';
 184   }
 185
 186   dispell $x, $delayed;
 187
 188   $x = 456;
 189   is $x, 456;
 190
 191   is $destroyed, 0;
 192  }
 193
 194  is $destroyed, 1;
 195 }