t/lib/u-weak.t

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