| #!/usr/bin/perl |
| use strict; |
| use warnings; |
| use Test::More tests => 415; |
| BEGIN { use_ok('li_typemaps') } |
| require_ok('li_typemaps'); |
| |
| sub batch { my($type, @values) = @_; |
| # this is a little ugly because I'm trying to be clever and save my |
| # wrists from hammering out all these tests. |
| for my $val (@values) { |
| for my $tst (qw( |
| in inr |
| out outr |
| inout inoutr |
| )) { |
| my $func = $tst . '_' . $type; |
| is(eval { li_typemaps->can($func)->($val) }, $val, "$func $val"); |
| if($@) { |
| my $err = $@; |
| $err =~ s/^/#\$\@# /mg; |
| print $err; |
| } |
| } |
| } |
| } |
| |
| batch('bool', '', 1); |
| # let's assume we're at least on a 32 bit machine |
| batch('int', -0x80000000, -1, 0, 1, 12, 0x7fffffff); |
| # long could be bigger, but it's at least this big |
| batch('long', -0x80000000, -1, 0, 1, 12, 0x7fffffff); |
| batch('short', -0x8000, -1, 0, 1, 12, 0x7fff); |
| batch('uint', 0, 1, 12, 0xffffffff); |
| batch('ushort', 0, 1, 12, 0xffff); |
| batch('ulong', 0, 1, 12, 0xffffffff); |
| batch('uchar', 0, 1, 12, 0xff); |
| batch('schar', -0x80, 0, 1, 12, 0x7f); |
| |
| { |
| use Math::BigInt qw(); |
| # the pack dance is to get plain old NVs out of the |
| # Math::BigInt objects. |
| my $inf = unpack 'd', pack 'd', Math::BigInt->binf(); |
| my $nan = unpack 'd', pack 'd', Math::BigInt->bnan(); |
| batch('float', |
| -(2 - 2 ** -23) * 2 ** 127, |
| -1, -2 ** -149, 0, 2 ** -149, 1, |
| (2 - 2 ** -23) * 2 ** 127, |
| $nan); |
| { local $TODO = "float typemaps don't pass infinity"; |
| # it seems as though SWIG is unwilling to pass infinity around |
| # because that value always fails bounds checking. I think that |
| # is a bug. |
| batch('float', $inf); |
| } |
| batch('double', |
| -(2 - 2 ** -53) ** 1023, |
| -1, -2 ** -1074, 0, 2 ** 1074, |
| (2 - 2 ** -53) ** 1023, |
| $nan, $inf); |
| } |
| batch('longlong', -1, 0, 1, 12); |
| batch('ulonglong', 0, 1, 12); |
| SKIP: { |
| my $a = "8000000000000000"; |
| my $b = "7fffffffffffffff"; |
| my $c = "ffffffffffffffff"; |
| skip "not a 64bit Perl", 18 unless eval { pack 'q', 1 }; |
| batch('longlong', -hex($a), hex($b)); |
| batch('ulonglong', hex($c)); |
| } |
| |
| my($foo, $int) = li_typemaps::out_foo(10); |
| isa_ok($foo, 'li_typemaps::Foo'); |
| is($foo->{a}, 10); |
| is($int, 20); |
| |
| my($a, $b) = li_typemaps::inoutr_int2(13, 31); |
| is($a, 13); |
| is($b, 31); |
| |