Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
00version.t	611 B	-r--r--r--	2014-12-27 11:49
any-all.t	895 B	-r--r--r--	2014-12-27 11:49
blessed.t	1.27 KB	-r--r--r--	2014-12-27 11:49
dualvar.t	3.57 KB	-r--r--r--	2014-12-27 11:49
first.t	3.76 KB	-r--r--r--	2014-12-27 11:49
getmagic-once.t	823 B	-r--r--r--	2014-12-27 11:49
isvstring.t	648 B	-r--r--r--	2014-12-27 11:49
lln.t	1.34 KB	-r--r--r--	2014-12-27 11:49
max.t	1.3 KB	-r--r--r--	2014-12-27 11:49
maxstr.t	717 B	-r--r--r--	2014-12-27 11:49
min.t	1.29 KB	-r--r--r--	2014-12-27 11:49
minstr.t	716 B	-r--r--r--	2014-12-27 11:49
multicall-refcount.t	263 B	-r--r--r--	2014-12-27 11:49
openhan.t	2.42 KB	-r--r--r--	2014-12-27 11:49
pair.t	2.96 KB	-r--r--r--	2014-12-27 11:49
product.t	1.74 KB	-r--r--r--	2014-12-27 11:49
proto.t	1.44 KB	-r--r--r--	2014-12-27 11:49
readonly.t	1.12 KB	-r--r--r--	2014-12-27 11:49
reduce.t	4.4 KB	-r--r--r--	2014-12-27 11:49
refaddr.t	1.96 KB	-r--r--r--	2014-12-27 11:49
reftype.t	1.38 KB	-r--r--r--	2014-12-27 11:49
shuffle.t	626 B	-r--r--r--	2014-12-27 11:49
stack-corruption.t	630 B	-r--r--r--	2014-12-27 11:49
sum.t	1.68 KB	-r--r--r--	2014-12-27 11:49
sum0.t	204 B	-r--r--r--	2014-12-27 11:49
tainted.t	845 B	-r--r--r--	2014-12-27 11:49
weak.t	2.82 KB	-r--r--r--	2014-12-27 11:49

Rename

#!./perl

use strict;
use Config;
BEGIN {
    unless (-d 'blib') {
	chdir 't' if -d 't';
	@INC = '../lib';
	keys %Config; # Silence warning
	if ($Config{extensions} !~ /\bList\/Util\b/) {
	    print "1..0 # Skip: List::Util was not built\n";
	    exit 0;
	}
    }
}

use Scalar::Util ();
use Test::More  ((grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) and !$ENV{PERL_CORE})
			? (skip_all => 'weaken requires XS version')
			: (tests => 28);

Scalar::Util->import(qw(weaken unweaken isweak));

# two references, one is weakened, the other is then undef'ed.
{
  my ($y,$z);

{
    my $x = "foo";
    $y = \$x;
    $z = \$x;
  }

ok(ref($y) and ref($z));

weaken($y);
  ok(ref($y) and ref($z));

undef($z);
  ok(not(defined($y) and defined($z)));

undef($y);
  ok(not(defined($y) and defined($z)));
}

# one reference, which is weakened
{
  my $y;

{
    my $x = "foo";
    $y = \$x;
  }

ok(ref($y));

weaken($y);
  ok(not defined $y);
}

my $flag;

# a circular structure
{
  $flag = 0;

{
    my $y = bless {}, 'Dest';
    $y->{Self} = $y;
    $y->{Flag} = \$flag;

weaken($y->{Self});
    ok( ref($y) );
  }

ok( $flag == 1 );
  undef $flag;
}

# a more complicated circular structure
{
  $flag = 0;

{
    my $y = bless {}, 'Dest';
    my $x = bless {}, 'Dest';
    $x->{Ref} = $y;
    $y->{Ref} = $x;
    $x->{Flag} = \$flag;
    $y->{Flag} = \$flag;

weaken($x->{Ref});
  }
  ok( $flag == 2 );
}

# deleting a weakref before the other one
{
  my ($y,$z);
  {
    my $x = "foo";
    $y = \$x;
    $z = \$x;
  }

weaken($y);
  undef($y);

ok(not defined $y);
  ok(ref($z) );
}

# isweakref
{
  $a = 5;
  ok(!isweak($a));
  $b = \$a;
  ok(!isweak($b));
  weaken($b);
  ok(isweak($b));
  $b = \$a;
  ok(!isweak($b));

my $x = {};
  weaken($x->{Y} = \$a);
  ok(isweak($x->{Y}));
  ok(!isweak($x->{Z}));
}

# unweaken
{
  my ($y,$z);
  {
    my $x = "foo";
    $y = \$x;
    $z = \$x;
  }

weaken($y);

ok(isweak($y), '$y is weak after weaken()');
  is($$y, "foo", '$y points at \"foo" after weaken()');

unweaken($y);

is(ref $y, "SCALAR", '$y is still a SCALAR ref after unweaken()');
  ok(!isweak($y), '$y is not weak after unweaken()');
  is($$y, "foo", '$y points at \"foo" after unweaken()');

undef $z;
  ok(defined $y, '$y still defined after undef $z');
}

# test weaken on a read only ref
SKIP: {
  # Doesn't work for older perls, see bug [perl #24506]
  skip("Test does not work with perl < 5.8.3", 5) if $] < 5.008003;

# in a MAD build, constants have refcnt 2, not 1
  skip("Test does not work with MAD", 5) if exists $Config{mad};

$a = eval '\"hello"';
  ok(ref($a)) or print "# didn't get a ref from eval\n";

$b = $a;
  eval { weaken($b) };
  # we didn't die
  is($@, "");
  ok(isweak($b));
  is($$b, "hello");

$a="";
  ok(not $b) or diag("b did not go away");
}

package Dest;

sub DESTROY {
  ${$_[0]{Flag}} ++;
}