t/80-leaks.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 11;
   7
   8 use Variable::Magic qw<wizard cast getdata>;
   9
  10 our $destroyed;
  11
  12 {
  13  package Variable::Magic::TestDestructor;
  14
  15  sub new { bless { }, shift }
  16
  17  sub DESTROY { ++$::destroyed }
  18 }
  19
  20 sub D () { 'Variable::Magic::TestDestructor' }
  21
  22 {
  23  local $destroyed = 0;
  24
  25  my $w = wizard data => sub { $_[1] };
  26
  27  {
  28   my $obj = D->new;
  29
  30   {
  31    my $x = 1;
  32    cast $x, $w, $obj;
  33    is $destroyed, 0;
  34   }
  35
  36   is $destroyed, 0;
  37  }
  38
  39  is $destroyed, 1;
  40 }
  41
  42 {
  43  local $destroyed = 0;
  44
  45  my $w = wizard data => sub { $_[1] };
  46
  47  {
  48   my $copy;
  49
  50   {
  51    my $obj = D->new;
  52
  53    {
  54     my $x = 1;
  55     cast $x, $w, $obj;
  56     is $destroyed, 0;
  57     $copy = getdata $x, $w;
  58    }
  59
  60    is $destroyed, 0;
  61   }
  62
  63   is $destroyed, 0;
  64  }
  65
  66  is $destroyed, 1;
  67 }
  68
  69 {
  70  local $destroyed = 0;
  71
  72  {
  73   my $obj = D->new;
  74
  75   {
  76    my $w  = wizard set => $obj;
  77
  78    {
  79     my $x = 1;
  80     cast $x, $w;
  81     is $destroyed, 0;
  82    }
  83
  84    is $destroyed, 0;
  85   }
  86
  87   is $destroyed, 0;
  88  }
  89
  90  is $destroyed, 1;
  91 }