################################################################################
#
# $Project: /Convert-Binary-C $
# $Author: mhx $
# $Date: 2011/04/10 12:32:22 +0200 $
# $Revision: 21 $
# $Source: /tests/211_clone.t $
#
################################################################################
#
# Copyright (c) 2002-2011 Marcus Holland-Moritz. All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
################################################################################

use Test;
use Convert::Binary::C @ARGV;

$^W = 1;

BEGIN { plan tests => 35 }

my $CCCFG = require 'tests/include/config.pl';

eval {
  $orig = new Convert::Binary::C %$CCCFG;
};
ok($@,'',"failed to create Convert::Binary::C object");

eval {
  # Clone at least twice, to make sure memory of the first clone(s) will
  # get freed (and to make sure that cloning works a couple of times)
  $clone = $orig->clone->clone->clone;
};
ok($@,'',"failed to clone empty object");

ok( reccmp($orig->configure(), $clone->configure()), 1, "wrong configuration" );

eval {
  my $foo = $clone->struct;
};
ok( $@, qr/without parse data/, "parse data check failed" );

eval {
  $orig->parse_file( 'tests/include/include.c' );
};
ok($@,'',"failed to parse C-file");

eval {
  $clone = $orig->clone->clone->clone;
};
ok($@,'',"failed to clone full object");

eval {
  $dump1 = $orig->sourcify;
  $dump2 = $clone->sourcify;
};
ok($@,'',"failed to sourcify");
ok( $dump1, $dump2, "dumps differ" );

ok( reccmp(scalar $orig->dependencies, scalar $clone->dependencies), 1, "dependencies differ" );

ok( reccmp($orig->configure, $clone->configure), 1, "wrong configuration" );

@meth = qw( enum compound struct union typedef );

for my $meth ( @meth ) {
  my $meth_names = $meth.'_names';
  $ORIG{$meth}        = [$orig->$meth()];
  $ORIG{$meth_names}  = [$orig->$meth_names()];
  $ORIG{$meth.'hash'} = { map { ($_ => $orig->$meth($_)) } $orig->$meth_names() };
}

undef $orig;  # destroy original object

for my $meth ( @meth ) {
  my $meth_names = $meth.'_names';
  my @orig_names = sort @{$ORIG{$meth_names}};

  print "# checking if any names exist\n";
  ok( @orig_names > 0 );

  print "# checking counts for \$clone->$meth / \$clone->$meth_names\n";
  ok(scalar @{$ORIG{$_}}, scalar $clone->$_(), "count mismatch in $_")
      for $meth, $meth_names;

  print "# checking parsed names for \$clone->$meth_names\n";
  ok(join( ',', @orig_names ),
     join( ',', sort $clone->$meth_names() ),
     "parsed names differ in $meth_names" );

  ok( scalar grep $_, map {
        print "# checking \$clone->$meth( \"$_\" )\n";
        reccmp($ORIG{$meth.'hash'}{$_}, $clone->$meth($_))
      } @orig_names );
}

sub reccmp
{
  my($ref, $val) = @_;

  ref $ref or return $ref eq $val;

  if( ref $ref eq 'ARRAY' ) {
    @$ref == @$val or return 0;
    for( 0..$#$ref ) {
      reccmp( $ref->[$_], $val->[$_] ) or return 0;
    }
  }
  elsif( ref $ref eq 'HASH' ) {
    @{[keys %$ref]} == @{[keys %$val]} or return 0;
    for( keys %$ref ) {
      reccmp( $ref->{$_}, $val->{$_} ) or return 0;
    }
  }
  else { return 0 }

  return 1;
}