t/lib/u-weak.t

   1 BEGIN {
   2         chdir 't' if -d 't';
   3         @INC = '../lib';
   4 }
   5
   6 BEGIN {
   7   $|=1;
   8   require Scalar::Util;
   9   if (grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) {
  10     print("1..0\n");
  11     exit;
  12   }
  13
  14   $DEBUG = 0;
  15
  16   if ($DEBUG && eval { require Devel::Peek } ) {
  17     Devel::Peek->import('Dump');
  18   }
  19   else {
  20     *Dump = sub {};
  21   }
  22 }
  23
  24 use Scalar::Util qw(weaken isweak);
  25 print "1..17\n";
  26
  27 ######################### End of black magic.
  28
  29 $cnt = 0;
  30
  31 sub ok {
  32         ++$cnt;
  33         if($_[0]) { print "ok $cnt\n"; } else {print "not ok $cnt\n"; }
  34 }
  35
  36 $| = 1;
  37
  38 if(1) {
  39
  40 my ($y,$z);
  41
  42 #
  43 # Case 1: two references, one is weakened, the other is then undef'ed.
  44 #
  45
  46 {
  47         my $x = "foo";
  48         $y = \$x;
  49         $z = \$x;
  50 }
  51 print "# START:\n";
  52 Dump($y); Dump($z);
  53
  54 ok( $y ne "" and $z ne "" );
  55 weaken($y);
  56
  57 print "# WEAK:\n";
  58 Dump($y); Dump($z);
  59
  60 ok( $y ne "" and $z ne "" );
  61 undef($z);
  62
  63 print "# UNDZ:\n";
  64 Dump($y); Dump($z);
  65
  66 ok( not (defined($y) and defined($z)) );
  67 undef($y);
  68
  69 print "# UNDY:\n";
  70 Dump($y); Dump($z);
  71
  72 ok( not (defined($y) and defined($z)) );
  73
  74 print "# FIN:\n";
  75 Dump($y); Dump($z);
  76
  77 # exit(0);
  78
  79 # }
  80 # {
  81
  82 #
  83 # Case 2: one reference, which is weakened
  84 #
  85
  86 # kill 5,$$;
  87
  88 print "# CASE 2:\n";
  89
  90 {
  91         my $x = "foo";
  92         $y = \$x;
  93 }
  94
  95 ok( $y ne "" );
  96 print "# BW: \n";
  97 Dump($y);
  98 weaken($y);
  99 print "# AW: \n";
 100 Dump($y);
 101 ok( not defined $y  );
 102
 103 print "# EXITBLOCK\n";
 104 }
 105
 106 # exit(0);
 107
 108 #
 109 # Case 3: a circular structure
 110 #
 111
 112 # kill 5, $$;
 113
 114 $flag = 0;
 115 {
 116         my $y = bless {}, Dest;
 117         Dump($y);
 118         print "# 1: $y\n";
 119         $y->{Self} = $y;
 120         Dump($y);
 121         print "# 2: $y\n";
 122         $y->{Flag} = \$flag;
 123         print "# 3: $y\n";
 124         weaken($y->{Self});
 125         print "# WKED\n";
 126         ok( $y ne "" );
 127         print "# VALS: HASH ",$y,"   SELF ",\$y->{Self},"  Y ",\$y,
 128                 "    FLAG: ",\$y->{Flag},"\n";
 129         print "# VPRINT\n";
 130 }
 131 print "# OUT $flag\n";
 132 ok( $flag == 1 );
 133
 134 print "# AFTER\n";
 135
 136 undef $flag;
 137
 138 print "# FLAGU\n";
 139
 140 #
 141 # Case 4: a more complicated circular structure
 142 #
 143
 144 $flag = 0;
 145 {
 146         my $y = bless {}, Dest;
 147         my $x = bless {}, Dest;
 148         $x->{Ref} = $y;
 149         $y->{Ref} = $x;
 150         $x->{Flag} = \$flag;
 151         $y->{Flag} = \$flag;
 152         weaken($x->{Ref});
 153 }
 154 ok( $flag == 2 );
 155
 156 #
 157 # Case 5: deleting a weakref before the other one
 158 #
 159
 160 {
 161         my $x = "foo";
 162         $y = \$x;
 163         $z = \$x;
 164 }
 165
 166 print "# CASE5\n";
 167 Dump($y);
 168
 169 weaken($y);
 170 Dump($y);
 171 undef($y);
 172
 173 ok( not defined $y);
 174 ok($z ne "");
 175
 176
 177 #
 178 # Case 6: test isweakref
 179 #
 180
 181 $a = 5;
 182 ok(!isweak($a));
 183 $b = \$a;
 184 ok(!isweak($b));
 185 weaken($b);
 186 ok(isweak($b));
 187 $b = \$a;
 188 ok(!isweak($b));
 189
 190 $x = {};
 191 weaken($x->{Y} = \$a);
 192 ok(isweak($x->{Y}));
 193 ok(!isweak($x->{Z}));
 194
 195
 196 package Dest;
 197
 198 sub DESTROY {
 199         print "# INCFLAG\n";
 200         ${$_[0]{Flag}} ++;
 201 }