diff options
author | William S Fulton <wsf@fultondesigns.co.uk> | 2015-08-09 21:55:30 +0100 |
---|---|---|
committer | William S Fulton <wsf@fultondesigns.co.uk> | 2015-08-09 21:55:30 +0100 |
commit | ac3284f78c3af61027ffe4765ba50161670d929e (patch) | |
tree | 18196c9d30be5055b76f719329ed490013deb9de | |
parent | 01edfef3b8bd63ad9041b8da9525e0dfb6b2101a (diff) | |
parent | 96e282b791ffbf9b9d6d3a1740945f14438f42cd (diff) | |
download | swig-ac3284f78c3af61027ffe4765ba50161670d929e.tar.gz |
Merge branch 'talby--surgical-perlprimtypes-fix'
* talby--surgical-perlprimtypes-fix:
update CHANGES.current
check ranges in perlprimtype.swg more carefully to avoid clang warnings
capture the current behavior of perlprimtypes.swg is more detail
-rw-r--r-- | CHANGES.current | 3 | ||||
-rw-r--r-- | Examples/test-suite/perl5/overload_simple_runme.pl | 39 | ||||
-rw-r--r-- | Examples/test-suite/perl5/wrapmacro_runme.pl | 43 | ||||
-rw-r--r-- | Lib/perl5/perlprimtypes.swg | 31 |
4 files changed, 101 insertions, 15 deletions
diff --git a/CHANGES.current b/CHANGES.current index 49d59891c..8c269f295 100644 --- a/CHANGES.current +++ b/CHANGES.current @@ -5,6 +5,9 @@ See the RELEASENOTES file for a summary of changes in each release. Version 3.0.8 (in progress) =========================== +2015-08-07: talby + [Perl] tidy -Wtautological-constant-out-of-range-compare warnings when building generated code under clang + 2015-08-07: xantares [Python] pep257 & numpydoc conforming docstrings: - Mono-line module docsstring diff --git a/Examples/test-suite/perl5/overload_simple_runme.pl b/Examples/test-suite/perl5/overload_simple_runme.pl index 624d428c6..57a585a22 100644 --- a/Examples/test-suite/perl5/overload_simple_runme.pl +++ b/Examples/test-suite/perl5/overload_simple_runme.pl @@ -2,7 +2,7 @@ use overload_simple; use vars qw/$DOWARN/; use strict; -use Test::More tests => 75; +use Test::More tests => 97; pass("loaded"); @@ -196,3 +196,40 @@ is(overload_simple::int_object(1), 1, "int_object(1)"); is(overload_simple::int_object(0), 0, "int_object(0)"); is(overload_simple::int_object(undef), 999, "int_object(Spam*)"); is(overload_simple::int_object($s), 999, "int_object(Spam*)"); + +# some of this section is duplication of above tests, but I want to see +# parity with the coverage in wrapmacro_runme.pl. + +sub check { + my($args, $want) = @_; + my($s, $rslt) = defined $want ? ($want, "bar:$want") : ('*boom*', undef); + is(eval("overload_simple::Spam::bar($args)"), $rslt, "bar($args) => $s"); +} + +# normal use patterns +check("11", 'int'); +check("11.0", 'double'); +check("'11'", 'char *'); +check("'11.0'", 'char *'); +check("-13", 'int'); +check("-13.0", 'double'); +check("'-13'", 'char *'); +check("'-13.0'", 'char *'); + +check("' '", 'char *'); +check("' 11 '", 'char *'); +# TypeError explosions +check("\\*STDIN", undef); +check("[]", undef); +check("{}", undef); +check("sub {}", undef); + +# regression cases +check("''", 'char *'); +check("' 11'", 'char *'); +check("' 11.0'", 'char *'); +check("' -11.0'", 'char *'); +check("\"11\x{0}\"", 'char *'); +check("\"\x{0}\"", 'char *'); +check("\"\x{9}11\x{0}this is not eleven.\"", 'char *'); +check("\"\x{9}11.0\x{0}this is also not eleven.\"", 'char *'); diff --git a/Examples/test-suite/perl5/wrapmacro_runme.pl b/Examples/test-suite/perl5/wrapmacro_runme.pl index 8e0154057..f2478b51b 100644 --- a/Examples/test-suite/perl5/wrapmacro_runme.pl +++ b/Examples/test-suite/perl5/wrapmacro_runme.pl @@ -1,7 +1,7 @@ #!/usr/bin/perl use strict; use warnings; -use Test::More tests => 5; +use Test::More tests => 27; BEGIN { use_ok('wrapmacro') } require_ok('wrapmacro'); @@ -12,3 +12,44 @@ my $b = -1; is(wrapmacro::maximum($a,$b), 2); is(wrapmacro::maximum($a/7.0, -$b*256), 256); is(wrapmacro::GUINT16_SWAP_LE_BE_CONSTANT(1), 256); + +# some of this section is duplication of above tests, but I want to see +# parity with the coverage in overload_simple_runme.pl. + +sub check { + my($args, $rslt) = @_; + my $s = defined $rslt ? $rslt : '*boom*'; + is(eval("wrapmacro::maximum($args)"), $rslt, "max($args) => $s"); +} + +# normal use patterns +check("0, 11", 11); +check("0, 11.0", 11); +check("0, '11'", 11); +check("0, '11.0'", 11); +check("11, -13", 11); +check("11, -13.0", 11); +{ local $TODO = 'strtoull() handles /^\s*-\d+$/ amusingly'; +check("11, '-13'", 11); +} +check("11, '-13.0'", 11); + +# TypeError explosions +check("0, ' '", undef); +check("0, ' 11 '", undef); +check("0, \\*STDIN", undef); +check("0, []", undef); +check("0, {}", undef); +check("0, sub {}", undef); + +# regression cases +{ local $TODO = 'strtol() and friends have edge cases we should guard against'; +check("-11, ''", undef); +check("0, ' 11'", undef); +check("0, ' 11.0'", undef); +check("-13, ' -11.0'", undef); +check("0, \"11\x{0}\"", undef); +check("0, \"\x{0}\"", undef); +check("0, \"\x{9}11\x{0}this is not eleven.\"", undef); +check("0, \"\x{9}11.0\x{0}this is also not eleven.\"", undef); +} diff --git a/Lib/perl5/perlprimtypes.swg b/Lib/perl5/perlprimtypes.swg index d7ac6f94e..6dd18b61f 100644 --- a/Lib/perl5/perlprimtypes.swg +++ b/Lib/perl5/perlprimtypes.swg @@ -37,7 +37,7 @@ SWIGINTERNINLINE SV * SWIG_From_dec(long)(long value) { SV *sv; - if (value >= IV_MIN && value <= IV_MAX) + if (IVSIZE >= sizeof(value) || (value >= IV_MIN && value <= IV_MAX)) sv = newSViv(value); else sv = newSVpvf("%ld", value); @@ -46,20 +46,22 @@ SWIG_From_dec(long)(long value) } %fragment(SWIG_AsVal_frag(long),"header", + fragment="<limits.h>", + fragment="<stdlib.h>", fragment="SWIG_CanCastAsInteger") { SWIGINTERN int SWIG_AsVal_dec(long)(SV *obj, long* val) { if (SvUOK(obj)) { UV v = SvUV(obj); - if (v <= LONG_MAX) { + if (UVSIZE < sizeof(*val) || 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 (IVSIZE <= sizeof(*val) || (v >= LONG_MIN && v <= LONG_MAX)) { if(val) *val = v; return SWIG_OK; } @@ -102,7 +104,7 @@ SWIGINTERNINLINE SV * SWIG_From_dec(unsigned long)(unsigned long value) { SV *sv; - if (value <= UV_MAX) + if (UVSIZE >= sizeof(value) || value <= UV_MAX) sv = newSVuv(value); else sv = newSVpvf("%lu", value); @@ -111,20 +113,22 @@ SWIG_From_dec(unsigned long)(unsigned long value) } %fragment(SWIG_AsVal_frag(unsigned long),"header", + fragment="<limits.h>", + fragment="<stdlib.h>", fragment="SWIG_CanCastAsInteger") { SWIGINTERN int SWIG_AsVal_dec(unsigned long)(SV *obj, unsigned long *val) { if (SvUOK(obj)) { UV v = SvUV(obj); - if (v <= ULONG_MAX) { + if (UVSIZE <= sizeof(*val) || v <= ULONG_MAX) { if (val) *val = v; return SWIG_OK; } return SWIG_OverflowError; } else if (SvIOK(obj)) { IV v = SvIV(obj); - if (v >= 0 && v <= ULONG_MAX) { + if (v >= 0 && (IVSIZE <= sizeof(*val) || v <= ULONG_MAX)) { if (val) *val = v; return SWIG_OK; } @@ -164,13 +168,12 @@ SWIG_AsVal_dec(unsigned long)(SV *obj, unsigned long *val) %fragment(SWIG_From_frag(long long),"header", fragment=SWIG_From_frag(long), - fragment="<limits.h>", fragment="<stdio.h>") { SWIGINTERNINLINE SV * SWIG_From_dec(long long)(long long value) { SV *sv; - if (value >= IV_MIN && value <= IV_MAX) + if (IVSIZE >= sizeof(value) || (value >= IV_MIN && value <= IV_MAX)) sv = newSViv((IV)(value)); else { //sv = newSVpvf("%lld", value); doesn't work in non 64bit Perl @@ -192,14 +195,15 @@ SWIG_AsVal_dec(long long)(SV *obj, long long *val) { if (SvUOK(obj)) { UV v = SvUV(obj); - if (v < LLONG_MAX) { + /* pretty sure this could allow v == LLONG MAX */ + if (UVSIZE < sizeof(*val) || 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 (IVSIZE <= sizeof(*val) || (v >= LLONG_MIN && v <= LLONG_MAX)) { if (val) *val = v; return SWIG_OK; } @@ -241,13 +245,12 @@ SWIG_AsVal_dec(long long)(SV *obj, long long *val) %fragment(SWIG_From_frag(unsigned long long),"header", fragment=SWIG_From_frag(long long), - fragment="<limits.h>", fragment="<stdio.h>") { SWIGINTERNINLINE SV * SWIG_From_dec(unsigned long long)(unsigned long long value) { SV *sv; - if (value <= UV_MAX) + if (UVSIZE >= sizeof(value) || value <= UV_MAX) sv = newSVuv((UV)(value)); else { //sv = newSVpvf("%llu", value); doesn't work in non 64bit Perl @@ -267,11 +270,13 @@ SWIGINTERN int SWIG_AsVal_dec(unsigned long long)(SV *obj, unsigned long long *val) { if (SvUOK(obj)) { + /* pretty sure this should be conditional on + * (UVSIZE <= sizeof(*val) || v <= ULLONG_MAX) */ if (val) *val = SvUV(obj); return SWIG_OK; } else if (SvIOK(obj)) { IV v = SvIV(obj); - if (v >= 0 && v <= ULLONG_MAX) { + if (v >= 0 && (IVSIZE <= sizeof(*val) || v <= ULLONG_MAX)) { if (val) *val = v; return SWIG_OK; } else { |