* revert perl5 li_typemaps run tests due to Windows regressions.

 * stricter casting to sidestep compiler warnings on Windows.


git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@13002 626c5289-ae23-0410-ae9c-e8d60b6d4f22

2 files changed, 62 insertions, 86 deletions

diff --git a/Examples/test-suite/perl5/li_typemaps_runme.pl b/Examples/test-suite/perl5/li_typemaps_runme.pl
index 194c98ca3..c182cdbb1 100644
--- a/Examples/test-suite/perl5/li_typemaps_runme.pl
+++ b/Examples/test-suite/perl5/li_typemaps_runme.pl
@@ -1,99 +1,74 @@
 #!/usr/bin/perl
 use strict;
 use warnings;
-use Test::More tests => 631;
+use Test::More tests => 415;
 BEGIN { use_ok('li_typemaps') }
 require_ok('li_typemaps');
 
-my @tests = qw(
-  in inr
-  out outr
-  inout inoutr
-);
-
-sub should_pass { my($type, @values) = @_;
-  # verify that each value passes cleanly
-  for my $test (@tests) {
-    my $name = "${test}_${type}";
-    my $func = li_typemaps->can($name);
-    for my $val (@values) {
-      my $rv = eval { $func->($val) };
-      is($rv, $val, "$name $val");
-    }
-  }
-}
-
-sub should_fail { my($type, @values) = @_;
-  # verify that all values trigger runtime errors
-  for my $test (@tests) {
-    my $name = "${test}_${type}";
-    my $func = li_typemaps->can($name);
-    for my $val (@values) {
-      my $rv = eval { $func->($val) };
-      like($@, qr/\b(?:Overflow|Type)Error\b/, "overflow $name $val");
+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;
+      }
     }
   }
 }
 
-sub pad { my($t, $s, $f) = @_;
-  my $nbytes = length pack $t, 0;
-  return unpack $t, $s . ($f x ($nbytes - 1));
-}
-
-# some edge case values:
-my $nan = unpack 'f>', "\x7f\xc0\x00\x00";
-my $inf = unpack 'f>', "\x7f\x80\x00\x00";
-my $char_min   = pad 'c', "\x80";
-my $char_max   = pad 'c', "\x7f";
-my $char_umax  = pad 'C', "\xff";
-my $short_min  = pad 's!>', "\x80", "\x00";
-my $short_max  = pad 's!>', "\x7f", "\xff";
-my $short_umax = pad 'S!>', "\xff", "\xff";
-my $int_min    = pad 'i!>', "\x80", "\x00";
-my $int_max    = pad 'i!>', "\x7f", "\xff";
-my $int_umax   = pad 'I!>', "\xff", "\xff";
-my $long_min   = pad 'l!>', "\x80", "\x00";
-my $long_max   = pad 'l!>', "\x7f", "\xff";
-my $long_umax  = pad 'L!>', "\xff", "\xff";
+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);
 
-should_pass('bool', '', 1);
-should_pass('int', $int_min, -1, 0, 1, 12, $int_max);
-should_fail('int', $int_min - 1000, $int_max + 1000, $inf, $nan);
-should_pass('long', $long_min, -1, 0, 1, 12, $long_max);
-should_fail('long', $long_min - 8000, $long_max + 8000, $inf, $nan);
-should_pass('short', $short_min, -1, 0, 1, 12, $short_max);
-should_fail('short', $short_min - 1, $short_max + 1, $inf, $nan);
-should_pass('uint', 0, 1, 12, $int_umax);
-should_fail('uint', -1, $int_umax + 1000, $inf, $nan);
-should_pass('ushort', 0, 1, 12, $short_umax);
-should_fail('ushort', -1, $short_umax + 1, $inf, $nan);
-should_pass('ulong', 0, 1, 12, $long_umax);
-should_fail('ulong', -1, $long_umax + 8000, $inf, $nan);
-should_pass('uchar', 0, 1, 12, $char_umax);
-should_fail('uchar', -1, $char_umax + 1, $inf, $nan);
-should_pass('schar', $char_min, -1, 0, 1, 12, $char_max);
-should_fail('schar', $char_min - 1, $char_max + 1, $inf, $nan);
-should_pass('float', -1, 0, 1, $nan);
-TODO: {
-  local $TODO = "typemaps don't allow float infinity";
-  should_pass('float', -$inf, $inf);
+{
+	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);
 }
-should_pass('double', -$inf, -1, 0, 1, $inf, $nan);
-should_pass('longlong', -1, 0, 1, 12);
-should_fail('longlong', $inf, $nan);
-should_pass('ulonglong', 0, 1, 12);
-should_fail('ulonglong', -1, $inf, $nan);
+batch('longlong', -1, 0, 1, 12);
+batch('ulonglong', 0, 1, 12);
 SKIP: {
-  my $llong_min  = eval { pad 'q>', "\x80", "\x00" };
-  my $llong_max  = eval { pad 'q>', "\x7f", "\xff" };
-  my $llong_umax = eval { pad 'Q>', "\xff", "\xff" };
-
-  skip 'not a 64 bit perl', 6 * 6 unless defined $llong_min;
-
-  should_pass('longlong', $llong_min, $llong_max);
-  should_fail('longlong', $llong_min - 8000, $llong_max + 8000);
-  should_pass('ulonglong', $llong_umax);
-  should_fail('ulonglong', $llong_umax + 8000);
+  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);
@@ -104,3 +79,4 @@ is($int, 20);
 my($a, $b) = li_typemaps::inoutr_int2(13, 31);
 is($a, 13);
 is($b, 31);
+
diff --git a/Lib/perl5/perlprimtypes.swg b/Lib/perl5/perlprimtypes.swg
index 9420a2f41..15e8feef3 100644
--- a/Lib/perl5/perlprimtypes.swg
+++ b/Lib/perl5/perlprimtypes.swg
@@ -23,7 +23,7 @@ SWIG_AsVal_dec(bool)(SV *obj, bool* val)
     if (val) *val = false;
     return SWIG_OK;
   } else {
-    if (val) *val = SvTRUE(obj);
+    if (val) *val = (bool)(SvTRUE(obj));
     return SWIG_AddCast(SWIG_OK);    
   }
 }
@@ -171,7 +171,7 @@ SWIG_From_dec(long long)(long long value)
 {
   SV *sv;
   if (value >= IV_MIN && value <= IV_MAX)
-    sv = newSViv(value);
+    sv = newSViv((IV)(value));
   else {
     //sv = newSVpvf("%lld", value); doesn't work in non 64bit Perl
     char temp[256];
@@ -248,7 +248,7 @@ SWIG_From_dec(unsigned long long)(unsigned long long value)
 {
   SV *sv;
   if (value <= UV_MAX)
-    sv = newSVuv(value);
+    sv = newSVuv((UV)(value));
   else {
     //sv = newSVpvf("%llu", value); doesn't work in non 64bit Perl
     char temp[256];