The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
################################################################################
#
# $Project: /Convert-Binary-C $
# $Author: mhx $
# $Date: 2011/04/10 12:32:21 +0200 $
# $Revision: 25 $
# $Source: /tests/001_init.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::More tests => 29;

use constant SUCCEED => 1;
use constant FAIL    => 0;

#===================================================================
# try to require the modules (2 tests)
#===================================================================
require_ok('Convert::Binary::C');
require_ok('Convert::Binary::C::Cached');

#===================================================================
# check if we build the right object (4 tests)
#===================================================================
eval { $p = new Convert::Binary::C };
is($@, '', "create Convert::Binary::C object");
is(ref $p, 'Convert::Binary::C',
   "blessed Convert::Binary::C reference");

eval { $p = new Convert::Binary::C::Cached };
is($@, '', "create Convert::Binary::C::Cached object");
is(ref $p, 'Convert::Binary::C::Cached',
   "blessed Convert::Binary::C::Cached reference");

#===================================================================
# check initialization during construction (4 tests)
#===================================================================
eval {
  $p = new Convert::Binary::C PointerSize => 4,
                              EnumSize    => 4,
                              IntSize     => 4,
                              Alignment   => 2,
                              ByteOrder   => 'BigEndian',
                              EnumType    => 'Both';
};
is($@, '', "create Convert::Binary::C object with arguments");
is(ref $p, 'Convert::Binary::C',
   "blessed Convert::Binary::C reference");

@warn = ();
eval {
  local $SIG{__WARN__} = sub { push @warn, $_[0] };
  $p = new Convert::Binary::C::Cached Cache       => 'tests/cache.cbc',
                                      PointerSize => 4,
                                      EnumSize    => 4,
                                      IntSize     => 4,
                                      Alignment   => 2,
                                      ByteOrder   => 'BigEndian',
                                      EnumType    => 'Both';
};
is($@, '', "create Convert::Binary::C::Cached object with arguments");
is(ref $p, 'Convert::Binary::C::Cached',
   "blessed Convert::Binary::C::Cached reference");

if (@warn) {
  my $ok = 1;
  printf "# %d warning(s) issued:\n", scalar @warn;
  for (@warn) {
    diag($_);
    /Cannot load (?:Data::Dumper|IO::File), disabling cache at $0/
      or $ok = 0;
  }
  ok($ok, 'warnings');
}
else { pass('warnings') }

#===================================================================
# check unknown options in constructor (2 tests)
#===================================================================
eval {
  $p = new Convert::Binary::C FOO => 123, ByteOrder => 'BigEndian', BAR => ['abc'];
};
like($@, qr/Invalid option 'FOO' at \Q$0/);

eval {
  $p = new Convert::Binary::C::Cached FOO => 123, ByteOrder => 'BigEndian', BAR => ['abc'];
};
like($@, qr/Invalid option 'FOO' at \Q$0/);

#===================================================================
# check invalid construction (2 tests)
#===================================================================
eval {
  $p = new Convert::Binary::C FOO;
};
like($@, qr/Number of configuration arguments to new must be even at \Q$0/);

eval {
  $p = new Convert::Binary::C::Cached FOO;
};
like($@, qr/Number of configuration arguments to new must be even at \Q$0/);

#===================================================================
# check invalid construction (2 tests)
#===================================================================
eval {
  $p = new Convert::Binary::C ByteOrder => 'FOO';
};
like($@, qr/ByteOrder must be.*not 'FOO' at \Q$0/);

eval {
  $p = new Convert::Binary::C::Cached ByteOrder => 'FOO';
};
like($@, qr/ByteOrder must be.*not 'FOO' at \Q$0/);

#===================================================================
# check undefined feature (2 tests)
#===================================================================
eval {
  $p = Convert::Binary::C::feature('foobar');
};
is($@, '');
ok(not defined $p);

#===================================================================
# check calling feature as method (2 tests)
#===================================================================
eval {
  $p = new Convert::Binary::C;
  $p = $p->feature('debug');
};
is($@, '');
ok(defined $p);

#===================================================================
# check object corruption (8 tests)
#===================================================================
for my $class (qw(Convert::Binary::C Convert::Binary::C::Cached)) {
  eval { $p = $class->new };
  is($@, '');
  
  eval { $p->{''} = 0 };
  like($@, qr/^Modification of a read-only value attempted/);
  
  $tmp = delete $p->{''};
  
  eval { $p->clean };
  like($@, qr/THIS is corrupt/);
  
  $p->{''} = $tmp;
  
  $e = {'' => $tmp};
  bless $e, ref $p;
  
  eval { $e->clean };
  like($@, qr/THIS->hv is corrupt/);
  
  # don't forget to rebless to avoid warnings during cleanup
  bless $e, 'main';
}