#  Tests for self referential tree save and reload where most refs to the root are weakened.
use strict;
use warnings;
use File::Spec;
use Scalar::Util qw /weaken/;

local $|= 1;

use lib File::Spec->catdir(qw(t lib));

BEGIN {
    lib->import('lib')
        if !-d 't';
}

use Sereal::TestSet qw(:all);
use Sereal::BulkTest qw(:all);
use Test::More;
use Sereal::Encoder;

my $ok= have_encoder_and_decoder();
if ( not $ok ) {
    plan skip_all => 'Did not find right version of decoder';
}
else {
    run_weakref_tests();
}

sub run_weakref_tests {

    #  Child to parent refs are weak, root node is stored once in the hash
    #  Was failing on x64 Strawberry perls 5.16.3, 5.18.4, 5.20.1
    test_save_and_reload();

    #  Child to parent refs are weak, but we store the root node twice in the hash
    #  (second time is in the "TREE_BY_NAME" subhash)
    #  Was failing on x64 Strawberry perls 5.16.3, passing on 5.18.4, 5.20.1
    test_save_and_reload( store_root_by_name => 1 );

    #  child to parent refs are strong
    #  Should pass
    test_save_and_reload( no_weaken_refs => 1 );
}

pass();
done_testing();

exit;

sub get_data {
    my %args= @_;

    my @children;

    my $root= {
        name     => 'root',
        children => \@children,
    };

    my %hash= (
        TREE         => $root,
        TREE_BY_NAME => {},
    );

    if ( $args{store_root_by_name} ) {
        $hash{TREE_BY_NAME}{root}= $root;
    }

    foreach my $i ( 0 .. 1 ) {
        my $child= {
            PARENT => $root,
            NAME   => $i,
        };

        if ( !$args{no_weaken_refs} ) {
            weaken $child->{PARENT};
        }

        push @children, $child;

        #  store it in the by-name cache
        $hash{TREE_BY_NAME}{$i}= $child;
    }

    return \%hash;
}

sub test_save_and_reload {
    my %args= @_;
    my $data= get_data(%args);

    #diag '=== ARGS ARE:  ' . join ' ', %args;

    my $context_text;
    $context_text .= $args{no_weaken} ? 'not weakened' : 'weakened';
    $context_text .=
        $args{store_root_by_name}
        ? ', extra root ref stored'
        : ', extra root ref not stored';

    my $encoder= Sereal::Encoder->new;
    my $decoder= Sereal::Decoder->new;
    my ( $encoded_data, $decoded_data );

    $encoded_data= eval { $encoder->encode($data) };
    my $e= $@;
    ok( !$e, "Encoded without exception, $context_text" );

    #  no point testing if serialisation failed
    if ($encoded_data) {
        eval { $decoder->decode( $encoded_data, $decoded_data ) };
        my $e= $@;
        ok( !$e, "Decoded using Sereal, $context_text" );

        is_deeply(
            $decoded_data,
            $data,
            "Data structures match, $context_text",
        );
    }

}

1;
