[libmath-prime-util-perl] 90/181: Input validation
Partha P. Mukherjee
ppm-guest at moszumanska.debian.org
Thu May 21 18:51:10 UTC 2015
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 <dana at 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
More information about the Pkg-perl-cvs-commits
mailing list