/trunk/Examples/test-suite/perl5/li_typemaps_runme.pl
Perl | 106 lines | 96 code | 6 blank | 4 comment | 4 complexity | 7470a1465c151ec56727aacdd0e9f6b7 MD5 | raw file
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);