Examples/test-suite/perl5/li_typemaps_runme.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 415;
   5 BEGIN { use_ok('li_typemaps') }
   6 require_ok('li_typemaps');
   7
   8 sub batch { my($type, @values) = @_;
   9   # this is a little ugly because I'm trying to be clever and save my
  10   # wrists from hammering out all these tests.
  11   for my $val (@values) {
  12     for my $tst (qw(
  13       in inr
  14       out outr
  15       inout inoutr
  16     )) {
  17       my $func = $tst . '_' . $type;
  18       is(eval { li_typemaps->can($func)->($val) }, $val, "$func $val");
  19       if($@) {
  20         my $err = $@;
  21         $err =~ s/^/#\$\@# /mg;
  22         print $err;
  23       }
  24     }
  25   }
  26 }
  27
  28 batch('bool', '', 1);
  29 # let's assume we're at least on a 32 bit machine
  30 batch('int', -0x80000000, -1, 0, 1, 12, 0x7fffffff);
  31 # long could be bigger, but it's at least this big
  32 batch('long', -0x80000000, -1, 0, 1, 12, 0x7fffffff);
  33 batch('short', -0x8000, -1, 0, 1, 12, 0x7fff);
  34 batch('uint', 0, 1, 12, 0xffffffff);
  35 batch('ushort', 0, 1, 12, 0xffff);
  36 batch('ulong', 0, 1, 12, 0xffffffff);
  37 batch('uchar', 0, 1, 12, 0xff);
  38 batch('schar', -0x80, 0, 1, 12, 0x7f);
  39
  40 {
  41         use Math::BigInt qw();
  42         # the pack dance is to get plain old NVs out of the
  43         # Math::BigInt objects.
  44         my $inf = unpack 'd', pack 'd', Math::BigInt->binf();
  45         my $nan = unpack 'd', pack 'd', Math::BigInt->bnan();
  46         batch('float',
  47           -(2 - 2 ** -23) * 2 ** 127,
  48           -1, -2 ** -149, 0, 2 ** -149, 1,
  49           (2 - 2 ** -23) * 2 ** 127,
  50           $nan);
  51         { local $TODO = "float typemaps don't pass infinity";
  52           # it seems as though SWIG is unwilling to pass infinity around
  53           # because that value always fails bounds checking.  I think that
  54           # is a bug.
  55           batch('float', $inf);
  56         }
  57         batch('double',
  58           -(2 - 2 ** -53) ** 1023,
  59           -1, -2 ** -1074, 0, 2 ** 1074,
  60           (2 - 2 ** -53) ** 1023,
  61           $nan, $inf);
  62 }
  63 batch('longlong', -1, 0, 1, 12);
  64 batch('ulonglong', 0, 1, 12);
  65 SKIP: {
  66   my $a = "8000000000000000";
  67   my $b = "7fffffffffffffff";
  68   my $c = "ffffffffffffffff";
  69   skip "not a 64bit Perl", 18 unless eval { pack 'q', 1 };
  70   batch('longlong', -hex($a), hex($b));
  71   batch('ulonglong', hex($c));
  72 }
  73
  74 my($foo, $int) = li_typemaps::out_foo(10);
  75 isa_ok($foo, 'li_typemaps::Foo');
  76 is($foo->{a}, 10);
  77 is($int, 20);
  78
  79 my($a, $b) = li_typemaps::inoutr_int2(13, 31);
  80 is($a, 13);
  81 is($b, 31);
  82