/trunk/Examples/test-suite/perl5/li_typemaps_runme.pl

  1#!/usr/bin/perl
  2use strict;
  3use warnings;
  4use Test::More tests => 631;
  5BEGIN { use_ok('li_typemaps') }
  6require_ok('li_typemaps');
  7
  8my @tests = qw(
  9  in inr
 10  out outr
 11  inout inoutr
 12);
 13
 14sub should_pass { my($type, @values) = @_;
 15  # verify that each value passes cleanly
 16  for my $test (@tests) {
 17    my $name = "${test}_${type}";
 18    my $func = li_typemaps->can($name);
 19    for my $val (@values) {
 20      my $rv = eval { $func->($val) };
 21      is($rv, $val, "$name $val");
 22    }
 23  }
 24}
 25
 26sub should_fail { my($type, @values) = @_;
 27  # verify that all values trigger runtime errors
 28  for my $test (@tests) {
 29    my $name = "${test}_${type}";
 30    my $func = li_typemaps->can($name);
 31    for my $val (@values) {
 32      my $rv = eval { $func->($val) };
 33      like($@, qr/\b(?:Overflow|Type)Error\b/, "overflow $name $val");
 34    }
 35  }
 36}
 37
 38sub pad { my($t, $s, $f) = @_;
 39  my $nbytes = length pack $t, 0;
 40  return unpack $t, $s . ($f x ($nbytes - 1));
 41}
 42
 43# some edge case values:
 44my $nan = unpack 'f>', "\x7f\xc0\x00\x00";
 45my $inf = unpack 'f>', "\x7f\x80\x00\x00";
 46my $char_min   = pad 'c', "\x80";
 47my $char_max   = pad 'c', "\x7f";
 48my $char_umax  = pad 'C', "\xff";
 49my $short_min  = pad 's!>', "\x80", "\x00";
 50my $short_max  = pad 's!>', "\x7f", "\xff";
 51my $short_umax = pad 'S!>', "\xff", "\xff";
 52my $int_min    = pad 'i!>', "\x80", "\x00";
 53my $int_max    = pad 'i!>', "\x7f", "\xff";
 54my $int_umax   = pad 'I!>', "\xff", "\xff";
 55my $long_min   = pad 'l!>', "\x80", "\x00";
 56my $long_max   = pad 'l!>', "\x7f", "\xff";
 57my $long_umax  = pad 'L!>', "\xff", "\xff";
 58
 59should_pass('bool', '', 1);
 60should_pass('int', $int_min, -1, 0, 1, 12, $int_max);
 61should_fail('int', $int_min - 1000, $int_max + 1000, $inf, $nan);
 62should_pass('long', $long_min, -1, 0, 1, 12, $long_max);
 63should_fail('long', $long_min - 8000, $long_max + 8000, $inf, $nan);
 64should_pass('short', $short_min, -1, 0, 1, 12, $short_max);
 65should_fail('short', $short_min - 1, $short_max + 1, $inf, $nan);
 66should_pass('uint', 0, 1, 12, $int_umax);
 67should_fail('uint', -1, $int_umax + 1000, $inf, $nan);
 68should_pass('ushort', 0, 1, 12, $short_umax);
 69should_fail('ushort', -1, $short_umax + 1, $inf, $nan);
 70should_pass('ulong', 0, 1, 12, $long_umax);
 71should_fail('ulong', -1, $long_umax + 8000, $inf, $nan);
 72should_pass('uchar', 0, 1, 12, $char_umax);
 73should_fail('uchar', -1, $char_umax + 1, $inf, $nan);
 74should_pass('schar', $char_min, -1, 0, 1, 12, $char_max);
 75should_fail('schar', $char_min - 1, $char_max + 1, $inf, $nan);
 76should_pass('float', -1, 0, 1, $nan);
 77TODO: {
 78  local $TODO = "typemaps don't allow float infinity";
 79  should_pass('float', -$inf, $inf);
 80}
 81should_pass('double', -$inf, -1, 0, 1, $inf, $nan);
 82should_pass('longlong', -1, 0, 1, 12);
 83should_fail('longlong', $inf, $nan);
 84should_pass('ulonglong', 0, 1, 12);
 85should_fail('ulonglong', -1, $inf, $nan);
 86SKIP: {
 87  my $llong_min  = eval { pad 'q>', "\x80", "\x00" };
 88  my $llong_max  = eval { pad 'q>', "\x7f", "\xff" };
 89  my $llong_umax = eval { pad 'Q>', "\xff", "\xff" };
 90
 91  skip 'not a 64 bit perl', 6 * 6 unless defined $llong_min;
 92
 93  should_pass('longlong', $llong_min, $llong_max);
 94  should_fail('longlong', $llong_min - 8000, $llong_max + 8000);
 95  should_pass('ulonglong', $llong_umax);
 96  should_fail('ulonglong', $llong_umax + 8000);
 97}
 98
 99my($foo, $int) = li_typemaps::out_foo(10);
100isa_ok($foo, 'li_typemaps::Foo');
101is($foo->{a}, 10);
102is($int, 20);
103
104my($a, $b) = li_typemaps::inoutr_int2(13, 31);
105is($a, 13);
106is($b, 31);