Fix for SF bug #1481958.

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

CHANGES.current

@@ -4,6 +4,10 @@ See the RELEASENOTES file for a summary of changes in each release.
 
 Version 2.0.5 (in progress)
 ===========================
+2011-09-10: talby
+            [perl5] SF bug #1481958 - Improve range checking for integer types.
+            Enhance li_typemaps_runme.pl
+
 2011-09-08: wsfulton
             Fix %extend on typedef classes in a namespace using the typedef name, for example:
             namespace Space {

Examples/test-suite/perl5/li_typemaps_runme.pl

@@ -1,74 +1,99 @@
 #!/usr/bin/perl
 use strict;
 use warnings;
-use Test::More tests => 415;
+use Test::More tests => 631;
 BEGIN { use_ok('li_typemaps') }
 require_ok('li_typemaps');
 
-sub batch { my($type, @values) = @_;
+my @tests = qw(
-  # this is a little ugly because I'm trying to be clever and save my
+  in inr
-  # wrists from hammering out all these tests.
+  out outr
-  for my $val (@values) {
+  inout inoutr
-    for my $tst (qw(
+);
-      in inr
+
-      out outr
+sub should_pass { my($type, @values) = @_;
-      inout inoutr
+  # verify that each value passes cleanly
-    )) {
+  for my $test (@tests) {
-      my $func = $tst . '_' . $type;
+    my $name = "${test}_${type}";
-      is(eval { li_typemaps->can($func)->($val) }, $val, "$func $val");
+    my $func = li_typemaps->can($name);
-      if($@) {
+    for my $val (@values) {
-        my $err = $@;
+      my $rv = eval { $func->($val) };
-        $err =~ s/^/#\$\@# /mg;
+      is($rv, $val, "$name $val");
-        print $err;
-      }
     }
   }
 }
 
-batch('bool', '', 1);
+sub should_fail { my($type, @values) = @_;
-# let's assume we're at least on a 32 bit machine
+  # verify that all values trigger runtime errors
-batch('int', -0x80000000, -1, 0, 1, 12, 0x7fffffff);
+  for my $test (@tests) {
-# long could be bigger, but it's at least this big
+    my $name = "${test}_${type}";
-batch('long', -0x80000000, -1, 0, 1, 12, 0x7fffffff);
+    my $func = li_typemaps->can($name);
-batch('short', -0x8000, -1, 0, 1, 12, 0x7fff);
+    for my $val (@values) {
-batch('uint', 0, 1, 12, 0xffffffff);
+      my $rv = eval { $func->($val) };
-batch('ushort', 0, 1, 12, 0xffff);
+      like($@, qr/\b(?:Overflow|Type)Error\b/, "overflow $name $val");
-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);
+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";
+
+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);
+}
+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);
 SKIP: {
-  my $a = "8000000000000000";
+  my $llong_min  = eval { pad 'q>', "\x80", "\x00" };
-  my $b = "7fffffffffffffff";
+  my $llong_max  = eval { pad 'q>', "\x7f", "\xff" };
-  my $c = "ffffffffffffffff";
+  my $llong_umax = eval { pad 'Q>', "\xff", "\xff" };
-  skip "not a 64bit Perl", 18 unless eval { pack 'q', 1 };
+
-  batch('longlong', -hex($a), hex($b));
+  skip 'not a 64 bit perl', 6 * 6 unless defined $llong_min;
-  batch('ulonglong', hex($c));
+
+  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($foo, $int) = li_typemaps::out_foo(10);
@@ -79,4 +104,3 @@ is($int, 20);
 my($a, $b) = li_typemaps::inoutr_int2(13, 31);
 is($a, 13);
 is($b, 31);
-

Lib/perl5/perlprimtypes.swg

@@ -8,18 +8,11 @@
 SWIGINTERNINLINE SV *
 SWIG_From_dec(bool)(bool value)
 {
-  SV *obj = sv_newmortal();
+  return boolSV(value);
-  if (value) {
-    sv_setsv(obj, &PL_sv_yes);
-  } else {
-    sv_setsv(obj, &PL_sv_no); 
-  }
-  return obj;
 }
 }
 
-%fragment(SWIG_AsVal_frag(bool),"header",
+%fragment(SWIG_AsVal_frag(bool),"header") {
-	  fragment="SWIG_CanCastAsInteger") {
 SWIGINTERN int
 SWIG_AsVal_dec(bool)(SV *obj, bool* val)
 {
@@ -30,10 +23,9 @@ SWIG_AsVal_dec(bool)(SV *obj, bool* val)
     if (val) *val = false;
     return SWIG_OK;
   } else {
-    if (val) *val = SvTRUE(obj) ? true: false;
+    if (val) *val = SvTRUE(obj);
     return SWIG_AddCast(SWIG_OK);    
   }
-  return SWIG_TypeError;
 }
 }
 
@@ -44,9 +36,12 @@ SWIG_AsVal_dec(bool)(SV *obj, bool* val)
 SWIGINTERNINLINE SV *
 SWIG_From_dec(long)(long value)
 {
-  SV *obj = sv_newmortal();
+  SV *sv;
-  sv_setiv(obj, (IV) value);
+  if (value >= IV_MIN && value <= IV_MAX)
-  return obj;
+    sv = newSViv(value);
+  else
+    sv = newSVpvf("%ld", value);
+  return sv_2mortal(sv);
 }
 }
 
@@ -55,9 +50,20 @@ SWIG_From_dec(long)(long value)
 SWIGINTERN int
 SWIG_AsVal_dec(long)(SV *obj, long* val)
 {
-  if (SvIOK(obj)) {
+  if (SvUOK(obj)) {
-    if (val) *val = SvIV(obj);
+    UV v = SvUV(obj);
-    return SWIG_OK;
+    if (v <= LONG_MAX) {
+      if (val) *val = v;
+      return SWIG_OK;
+    }
+    return SWIG_OverflowError;
+  } else if (SvIOK(obj)) {
+    IV v = SvIV(obj);
+    if (v >= LONG_MIN && v <= LONG_MAX) {
+      if(val) *val = v;
+      return SWIG_OK;
+    }
+    return SWIG_OverflowError;
   } else {
     int dispatch = 0;
     const char *nptr = SvPV_nolen(obj);
@@ -91,14 +97,16 @@ SWIG_AsVal_dec(long)(SV *obj, long* val)
 
 /* unsigned long */
 
-%fragment(SWIG_From_frag(unsigned long),"header",
+%fragment(SWIG_From_frag(unsigned long),"header") {
-	  fragment=SWIG_AsVal_frag(double)) {
 SWIGINTERNINLINE SV *
 SWIG_From_dec(unsigned long)(unsigned long value)
 {
-  SV *obj = sv_newmortal();
+  SV *sv;
-  sv_setuv(obj, (UV) value);
+  if (value <= UV_MAX)
-  return obj;
+    sv = newSVuv(value);
+  else
+    sv = newSVpvf("%lu", value);
+  return sv_2mortal(sv);
 }
 }
 
@@ -108,16 +116,19 @@ SWIGINTERN int
 SWIG_AsVal_dec(unsigned long)(SV *obj, unsigned long *val) 
 {
   if (SvUOK(obj)) {
-    if (val) *val = SvUV(obj);
+    UV v = SvUV(obj);
-    return SWIG_OK;
+    if (v <= ULONG_MAX) {
-  } else  if (SvIOK(obj)) {
-    long v = SvIV(obj);
-    if (v >= 0) {
       if (val) *val = v;
       return SWIG_OK;
-    } else {
-      return SWIG_OverflowError;
     }
+    return SWIG_OverflowError;
+  } else if (SvIOK(obj)) {
+    IV v = SvIV(obj);
+    if (v >= 0 && v <= ULONG_MAX) {
+      if (val) *val = v;
+      return SWIG_OK;
+    }
+    return SWIG_OverflowError;
   } else {
     int dispatch = 0;
     const char *nptr = SvPV_nolen(obj);
@@ -158,15 +169,12 @@ SWIG_AsVal_dec(unsigned long)(SV *obj, unsigned long *val)
 SWIGINTERNINLINE SV *
 SWIG_From_dec(long long)(long long value)
 {
-  if (((long long) LONG_MIN <= value) && (value <= (long long) LONG_MAX)) {
+  SV *sv;
-    return SWIG_From(long)(%numeric_cast(value,long));
+  if (value >= IV_MIN && value <= IV_MAX)
-  } else {    
+    sv = newSViv(value);
-    char temp[256]; 
+  else
-    SV *obj = sv_newmortal();
+    sv = newSVpvf("%lld", value);
-    sprintf(temp, "%lld", value);
+  return sv_2mortal(sv);
-    sv_setpv(obj, temp);
-    return obj;
-  }
 }
 }
 
@@ -178,9 +186,20 @@ SWIG_From_dec(long long)(long long value)
 SWIGINTERN int
 SWIG_AsVal_dec(long long)(SV *obj, long long *val)
 {
-  if (SvIOK(obj)) {
+  if (SvUOK(obj)) {
-    if (val) *val = SvIV(obj);
+    UV v = SvUV(obj);
-    return SWIG_OK;
+    if (v < LLONG_MAX) {
+      if (val) *val = v;
+      return SWIG_OK;
+    }
+    return SWIG_OverflowError;
+  } else if (SvIOK(obj)) {
+    IV v = SvIV(obj);
+    if (v >= LLONG_MIN && v <= LLONG_MAX) {
+      if (val) *val = v;
+      return SWIG_OK;
+    }
+    return SWIG_OverflowError;
   } else {
     int dispatch = 0;
     const char *nptr = SvPV_nolen(obj);
@@ -223,15 +242,12 @@ SWIG_AsVal_dec(long long)(SV *obj, long long *val)
 SWIGINTERNINLINE SV *
 SWIG_From_dec(unsigned long long)(unsigned long long value)
 {
-  if (value < (unsigned long long) LONG_MAX) {
+  SV *sv;
-    return SWIG_From(long long)(%numeric_cast(value, long long));
+  if (value <= UV_MAX)
-  } else {
+    sv = newSVuv(value);
-    char temp[256]; 
+  else
-    SV *obj = sv_newmortal();
+    sv = newSVpvf("%llu", value);
-    sprintf(temp, "%llu", value);
+  return sv_2mortal(sv);
-    sv_setpv(obj, temp);
-    return obj;
-  }
 }
 }
 
@@ -246,8 +262,8 @@ SWIG_AsVal_dec(unsigned long long)(SV *obj, unsigned long long *val)
     if (val) *val = SvUV(obj);
     return SWIG_OK;
   } else  if (SvIOK(obj)) {
-    long v = SvIV(obj);
+    IV v = SvIV(obj);
-    if (v >= 0) {
+    if (v >= 0 && v <= ULLONG_MAX) {
       if (val) *val = v;
       return SWIG_OK;
     } else {
@@ -291,9 +307,7 @@ SWIG_AsVal_dec(unsigned long long)(SV *obj, unsigned long long *val)
 SWIGINTERNINLINE SV *
 SWIG_From_dec(double)(double value)
 {
-  SV *obj = sv_newmortal();
+  return sv_2mortal(newSVnv(value));
-  sv_setnv(obj, value);
-  return obj;
 }
 }