view release on metacpan or  search on metacpan

tests/211_clone.t  view on Meta::CPAN

################################################################################
#
# Copyright (c) 2002-2024 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 = Convert::Binary::C->new( %$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";