cpan/Scalar-List-Utils/t/weak.t

   1 #!./perl
   2
   3 use strict;
   4 use Config;
   5 BEGIN {
   6     unless (-d 'blib') {
   7         chdir 't' if -d 't';
   8         @INC = '../lib';
   9         keys %Config; # Silence warning
  10         if ($Config{extensions} !~ /\bList\/Util\b/) {
  11             print "1..0 # Skip: List::Util was not built\n";
  12             exit 0;
  13         }
  14     }
  15 }
  16
  17 use Scalar::Util ();
  18 use Test::More  ((grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) and !$ENV{PERL_CORE})
  19                         ? (skip_all => 'weaken requires XS version')
  20                         : (tests => 28);
  21
  22 Scalar::Util->import(qw(weaken unweaken isweak));
  23
  24 # two references, one is weakened, the other is then undef'ed.
  25 {
  26   my ($y,$z);
  27
  28   {
  29     my $x = "foo";
  30     $y = \$x;
  31     $z = \$x;
  32   }
  33
  34   ok(ref($y) and ref($z));
  35
  36   weaken($y);
  37   ok(ref($y) and ref($z));
  38
  39   undef($z);
  40   ok(not(defined($y) and defined($z)));
  41
  42   undef($y);
  43   ok(not(defined($y) and defined($z)));
  44 }
  45
  46 # one reference, which is weakened
  47 {
  48   my $y;
  49
  50   {
  51     my $x = "foo";
  52     $y = \$x;
  53   }
  54
  55   ok(ref($y));
  56
  57   weaken($y);
  58   ok(not defined $y);
  59 }
  60
  61 my $flag;
  62
  63 # a circular structure
  64 {
  65   $flag = 0;
  66
  67   {
  68     my $y = bless {}, 'Dest';
  69     $y->{Self} = $y;
  70     $y->{Flag} = \$flag;
  71
  72     weaken($y->{Self});
  73     ok( ref($y) );
  74   }
  75
  76   ok( $flag == 1 );
  77   undef $flag;
  78 }
  79
  80 # a more complicated circular structure
  81 {
  82   $flag = 0;
  83
  84   {
  85     my $y = bless {}, 'Dest';
  86     my $x = bless {}, 'Dest';
  87     $x->{Ref} = $y;
  88     $y->{Ref} = $x;
  89     $x->{Flag} = \$flag;
  90     $y->{Flag} = \$flag;
  91
  92     weaken($x->{Ref});
  93   }
  94   ok( $flag == 2 );
  95 }
  96
  97 # deleting a weakref before the other one
  98 {
  99   my ($y,$z);
 100   {
 101     my $x = "foo";
 102     $y = \$x;
 103     $z = \$x;
 104   }
 105
 106   weaken($y);
 107   undef($y);
 108
 109   ok(not defined $y);
 110   ok(ref($z) );
 111 }
 112
 113 # isweakref
 114 {
 115   $a = 5;
 116   ok(!isweak($a));
 117   $b = \$a;
 118   ok(!isweak($b));
 119   weaken($b);
 120   ok(isweak($b));
 121   $b = \$a;
 122   ok(!isweak($b));
 123
 124   my $x = {};
 125   weaken($x->{Y} = \$a);
 126   ok(isweak($x->{Y}));
 127   ok(!isweak($x->{Z}));
 128 }
 129
 130 # unweaken
 131 {
 132   my ($y,$z);
 133   {
 134     my $x = "foo";
 135     $y = \$x;
 136     $z = \$x;
 137   }
 138
 139   weaken($y);
 140
 141   ok(isweak($y), '$y is weak after weaken()');
 142   is($$y, "foo", '$y points at \"foo" after weaken()');
 143
 144   unweaken($y);
 145
 146   is(ref $y, "SCALAR", '$y is still a SCALAR ref after unweaken()');
 147   ok(!isweak($y), '$y is not weak after unweaken()');
 148   is($$y, "foo", '$y points at \"foo" after unweaken()');
 149
 150   undef $z;
 151   ok(defined $y, '$y still defined after undef $z');
 152 }
 153
 154 # test weaken on a read only ref
 155 SKIP: {
 156   # Doesn't work for older perls, see bug [perl #24506]
 157   skip("Test does not work with perl < 5.8.3", 5) if $] < 5.008003;
 158
 159   # in a MAD build, constants have refcnt 2, not 1
 160   skip("Test does not work with MAD", 5) if exists $Config{mad};
 161
 162   $a = eval '\"hello"';
 163   ok(ref($a)) or print "# didn't get a ref from eval\n";
 164
 165   $b = $a;
 166   eval { weaken($b) };
 167   # we didn't die
 168   is($@, "");
 169   ok(isweak($b));
 170   is($$b, "hello");
 171
 172   $a="";
 173   ok(not $b) or diag("b did not go away");
 174 }
 175
 176 package Dest;
 177
 178 sub DESTROY {
 179   ${$_[0]{Flag}} ++;
 180 }