#!/usr/bin/perl

use strict;
use warnings;
use blib;
use Data::Structure::Util qw(has_circular_ref circular_off); 
use Data::Dumper;


BEGIN {
  eval q{ use Scalar::Util qw(weaken isweak) };
  if ($@) {
    my $reason = "A recent version of Scalar::Util must be installed";
    eval qq{ use Test::More skip_all => "$reason" };
    exit;
  }
  else {
    eval q{ use Test::More tests => 32 };
  }
}

ok(1,"we loaded fine...");

my $obj = bless {
                  key1 => [1, 2, 3, bless {} => 'Tagada'],
                  key2 => undef,
                  key3 => {
                            key31 => {},
                            key32 => bless { bla => [] } => 'Tagada',
                          },
                  key5 => bless [] => 'Ponie',
                } => 'Scoobidoo';
$obj->{key4} = \$obj;
$obj->{key3}->{key33} = $obj->{key3}->{key31};

my $thing = { var1 => {} };
$thing->{var2} = [ $thing->{var1}->{hello } ];
$thing->{var1}->{hello} = $thing->{var2};

my $obj2 = { key1 => [ sub { [] } ] };
$obj2->{key2} = $obj2->{key1};

my $obj3;
$obj3 = \$obj3;

my $obj4 = { key1 => $obj3 };

our @V1 = (1, 2, sub {} );
my $obj5 = {
             key1 => undef,
             key2 => sub {},
             key3 => \@V1,
             key4 => $obj2,
             key5 => {
                       key51 => sub {},
                       key52 => \*STDERR,
                       key53 => [0, \"hello"],
                     },
             key6 => qr/adsa[sdf]+/,
           };
$obj5->{key5}->{key53}->[2] = $obj5->{key5};
$obj5->{key5}->{key54} = $obj5->{key5}->{key53}->[2];
$obj5->{key6} = $obj5->{key5}->{key53}->[2];
$obj5->{key5}->{key55} = $obj5->{key5}->{key53}->[2];

my $obj6 = { key1 => undef };
my $obj6b = $obj6;
my $V2 = [1, undef, \5, sub {} ];
foreach (1 .. 50) {
  $obj6b->{key2} = bless {} => 'Test';
  $obj6b->{key1} = $V2;
  $obj6b = $obj6b->{key2};
  $obj6b->{key3} = [ $obj6 ]; # \$obj6 fails
}

ok(! has_circular_ref($thing), "Not a circular ref");
{
is(circular_off($thing), 0, "No circular ref broken");
}

print "foo\n";
my $ref = has_circular_ref($obj);
ok($ref, "Got a circular reference");
is(circular_off($obj), 1, "Weaken circular references");
is(circular_off($obj), 0, "No more weaken circular references");
ok(! has_circular_ref($obj), "No more circular ref");

ok(! has_circular_ref($obj2), "No circular reference");
is(circular_off($obj2), 0, "No circular ref broken");

ok(has_circular_ref([ $obj3, $obj4, $obj5]), "Got a circular reference");
is(circular_off([$obj3, $obj4, $obj5]), 4, "Weaken circular references");
ok(! has_circular_ref([$obj3, $obj4, $obj5]), "No more circular ref");

ok(has_circular_ref($obj6), "Got a circular reference");
ok($obj6 == has_circular_ref($obj6), "Match reference");
is(circular_off($obj6), 50, "Weaken 50 circular refs");
ok(! has_circular_ref($obj6), "Got a circular reference");


ok(! has_circular_ref(), "No circular reference");
ok(! has_circular_ref( [] ), "No circular reference");
ok(! has_circular_ref( [ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\$ref ] ), "Has circular reference");

my $spy;
{
  my $obj7 =  { key1 => {} };
  $obj7->{key1}->{key11} = $obj7->{key1};
  $spy = $obj7->{key1};
  weaken($spy);
  ok(isweak($spy), "got a spy");
  ok(has_circular_ref($obj7), "Got a circular reference");
  is(circular_off($obj7), 1, "Removed circular refs");
}
ok(! $spy, "No memory leak");



my $obj8 = bless {
                  key1 => bless {
                                  parent => undef,
                                } => 'Bar',
                 } => 'Foo';
$obj8->{key1}->{parent} = $obj8;
ok( has_circular_ref($obj8), "Got circular");
is( circular_off($obj8), 1, "removed circular");
ok( isweak( $obj8->{key1}->{parent} ), "is weak");
ok( ! has_circular_ref($obj8), "no circular");
ok( ! circular_off($obj8), "removed circular");

my $obj9 = bless {
                  key1 => bless {
                                  parent => undef,
                                } => 'Bar',
                 } => 'Foo';
$obj9->{key1}->{parent} = $obj9;
ok( has_circular_ref($obj9), "got circular");
my $obj91 = $obj9->{key1};
weaken( $obj9->{key1} );
ok( isweak( $obj9->{key1} ), "is weak");
ok( ! has_circular_ref($obj9), "no circular");
ok( ! circular_off($obj9), "no circular");

# This test is failing - don't know why - I suspect perl 5.8.0
# my $obj8 = [];
# $obj8->[0] = \$obj8;
# is( circular_off($obj8), 1, "Removed circular refs");