This is an automated email from the git hooks/post-receive script. ppm-guest pushed a commit to annotated tag v0.36 in repository libmath-prime-util-perl.
commit 0e33406acc2346ad6f455801f2fcfdbec68d01e9 Author: Dana Jacobsen <d...@acm.org> Date: Wed Jan 1 00:44:48 2014 -0800 Input validation --- MANIFEST | 1 + XS.xs | 20 ++++++++-------- lehmer.c | 8 +++---- lib/Math/Prime/Util.pm | 1 + t/04-inputvalidation.t | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 79 insertions(+), 13 deletions(-) diff --git a/MANIFEST b/MANIFEST index 7f91dd8..25c23c4 100644 --- a/MANIFEST +++ b/MANIFEST @@ -70,6 +70,7 @@ bin/factor.pl t/01-load.t t/02-can.t t/03-init.t +t/04-inputvalidation.t t/10-isprime.t t/11-primes.t t/12-nextprime.t diff --git a/XS.xs b/XS.xs index 6a1c40c..3ce3d02 100644 --- a/XS.xs +++ b/XS.xs @@ -95,23 +95,25 @@ static int _validate_int(pTHX_ SV* n, int negok) if (SvIOK(n)) { /* If defined as number, use that */ if (SvIsUV(n) || SvIV(n) >= 0) return 1; if (negok) return -1; - else croak("Parameter '" SVf "' must be a positive integer", n); + else croak("Parameter '%" SVf "' must be a positive integer", n); } if (SvROK(n) && !sv_isa(n, "Math::BigInt")) return 0; ptr = SvPV(n, len); /* Includes stringifying bigints */ - if (len == 0 || ptr == 0) croak("Parameter '" SVf "' must be a positive integer", n); - if (ptr[0] == '-') { /* Read negative sign */ - if (negok) { isneg = 1; ptr++; len--; } - else croak("Parameter '" SVf "' must be a positive integer", n); + if (len == 0 || ptr == 0) croak("Parameter must be a positive integer"); + if (ptr[0] == '-' && negok) { + isneg = 1; ptr++; len--; /* Read negative sign */ + } else if (ptr[0] == '+') { + ptr++; len--; /* Allow a single plus sign */ } - if (ptr[0] == '+') { ptr++; len--; } /* Allow a single plus sign */ + if (len == 0 || !isDIGIT(ptr[0])) + croak("Parameter '%" SVf "' must be a positive integer", n); while (len > 0 && *ptr == '0') /* Strip all leading zeros */ { ptr++; len--; } if (len > uvmax_maxlen) /* Huge number, don't even look at it */ return 0; for (i = 0; i < len; i++) /* Ensure all characters are digits */ if (!isDIGIT(ptr[i])) - croak("Parameter '" SVf "' must be a positive integer", n); + croak("Parameter '%" SVf "' must be a positive integer", n); if (isneg == 1) /* Negative number (ignore overflow) */ return -1; ret = isneg ? -1 : 1; @@ -484,7 +486,7 @@ factor(IN SV* svn) UV ndivisors; UV* divs = _divisor_list(n, &ndivisors); EXTEND(SP, ndivisors); - for (i = 0; i < ndivisors; i++) + for (i = 0; (UV)i < ndivisors; i++) PUSHs(sv_2mortal(newSVuv( divs[i] ))); Safefree(divs); } @@ -613,7 +615,7 @@ euler_phi(IN SV* svlo, ...) UV n = (lostatus == -1) ? 0 : my_svuv(svlo); XSRETURN_UV(totient(n)); } else { - IV n = (lostatus == -1) ? -(my_sviv(svlo)) : my_svuv(svlo); + UV n = (lostatus == -1) ? (UV)(-(my_sviv(svlo))) : my_svuv(svlo); XSRETURN_IV(moebius(n)); } } else if (items == 2 && lostatus == 1 && histatus == 1) { diff --git a/lehmer.c b/lehmer.c index 45ba036..47e9443 100644 --- a/lehmer.c +++ b/lehmer.c @@ -884,9 +884,9 @@ int main(int argc, char *argv[]) #else #include "lehmer.h" -UV _XS_LMOS_pi(UV n) { croak("Not compiled with Lehmer support"); } -UV _XS_lehmer_pi(UV n) { croak("Not compiled with Lehmer support"); } -UV _XS_meissel_pi(UV n) { croak("Not compiled with Lehmer support"); } -UV _XS_legendre_pi(UV n) { croak("Not compiled with Lehmer support"); } +UV _XS_LMOS_pi(UV n) { n=0; croak("Not compiled with Lehmer support"); } +UV _XS_lehmer_pi(UV n) { n=0; croak("Not compiled with Lehmer support"); } +UV _XS_meissel_pi(UV n) { n=0; croak("Not compiled with Lehmer support"); } +UV _XS_legendre_pi(UV n) { n=0; croak("Not compiled with Lehmer support"); } #endif diff --git a/lib/Math/Prime/Util.pm b/lib/Math/Prime/Util.pm index 9480b2d..2c23256 100644 --- a/lib/Math/Prime/Util.pm +++ b/lib/Math/Prime/Util.pm @@ -236,6 +236,7 @@ sub _validate_positive_integer { croak "Parameter '$n' must be <= $max" if defined $max && $n > $max; $_[0] = Math::BigInt->new("$_[0]") unless ref($_[0]) eq 'Math::BigInt'; + croak "Parameter '$_[0]' must be a positive integer" unless $_[0]->is_int(); if ($_[0]->bacmp(''.~0) <= 0 && $] >= 5.008) { $_[0] = int($_[0]->bstr); } else { diff --git a/t/04-inputvalidation.t b/t/04-inputvalidation.t new file mode 100644 index 0000000..e4c9b17 --- /dev/null +++ b/t/04-inputvalidation.t @@ -0,0 +1,62 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use Test::More; +use Math::Prime::Util qw/next_prime/; + +plan tests => 22; + +eval { next_prime(undef); }; +like($@, qr/^Parameter must be defined/, "next_prime(undef)"); +eval { next_prime(""); }; +like($@, qr/^Parameter must be a positive integer/, "next_prime('')"); +eval { next_prime(-4); }; +like($@, qr/^Parameter '-4' must be a positive integer/, "next_prime(-4)"); +eval { next_prime("-"); }; +like($@, qr/^Parameter '-' must be a positive integer/, "next_prime('-')"); +eval { next_prime("+"); }; +like($@, qr/^Parameter '\+' must be a positive integer/, "next_prime('+')"); + +# +4 is fine +is(next_prime("+4"), 5, "next_prime('+4') works"); +# ++4 does not +eval { next_prime("++4"); }; +like($@, qr/^Parameter '\+\+4' must be a positive integer/, "next_prime('++4')"); +eval { next_prime("+-4"); }; +like($@, qr/^Parameter '\+\-4' must be a positive integer/, "next_prime('+-4')"); + +# Test leading zeros +is(next_prime("0004"), 5, "next_prime('0004') works"); +is(next_prime("+0004"), 5, "next_prime('+0004') works"); +eval { next_prime("-0004"); }; +like($@, qr/^Parameter '\-0004' must be a positive integer/, "next_prime('-0004')"); + +eval { next_prime("a"); }; +like($@, qr/^Parameter 'a' must be a positive integer/, "next_prime('a')"); +eval { next_prime(5.6); }; +like($@, qr/^Parameter '5.6' must be a positive integer/, "next_prime('5.6')"); + +# 5.0 should be ok. +is(next_prime(5.0), 7, "next_prime(5.0) works"); +eval { next_prime("4e"); }; +like($@, qr/^Parameter '4e' must be a positive integer/, "next_prime('4e')"); +eval { next_prime("1.1e12"); }; +like($@, qr/^Parameter '1.1e12' must be a positive integer/, "next_prime('1.1e12')"); + +# 1e8 as a string will fail, as a number will work. +eval { next_prime("1e8"); }; +like($@, qr/^Parameter '1e8' must be a positive integer/, "next_prime('1e8')"); +is(next_prime(1e8), 100000007, "next_prime(1e8) works"); + +eval { next_prime("NaN"); }; +like($@, qr/^Parameter 'NaN' must be a positive integer/, "next_prime('NaN')"); + +# The actual strings can be implementation specific +eval { next_prime(0+'inf'); }; +like($@, qr/must be a positive integer/, "next_prime(0+'inf')"); +eval { next_prime(20**20**20); }; +like($@, qr/must be a positive integer/, "next_prime(20**20**20)"); + +eval { next_prime("11111111111111111111111111111111111111111x"); }; +like($@, qr/must be a positive integer/, "next_prime('111...111x')"); -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmath-prime-util-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits