#!./perl

use strict;
use warnings;

use Config;

use Scalar::Util qw(weaken unweaken isweak);
use Test::More tests => 28;

# 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}} ++;
}