[libmath-prime-util-perl] 18/181: first round of changes for factor(1)

[Partha P. Mukherjee]

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 68a087726071095569ed870a5d33df3a4951fb20
Author: Dana Jacobsen <dana at acm.org>
Date:   Tue Dec 17 13:59:04 2013 -0800

    first round of changes for factor(1)
---
 TODO                   |  2 ++
 XS.xs                  | 10 +++++++---
 factor.c               |  2 +-
 lib/Math/Prime/Util.pm |  2 ++
 t/50-factoring.t       |  8 ++++----
 5 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/TODO b/TODO
index 0be771d..793d840 100644
--- a/TODO
+++ b/TODO
@@ -67,3 +67,5 @@
 - Add fordivisors as XS.
 
 - Make divisors() an alias for all_factors().
+
+- Document changes to factor(1)
diff --git a/XS.xs b/XS.xs
index cb98997..0bdcc17 100644
--- a/XS.xs
+++ b/XS.xs
@@ -362,7 +362,8 @@ erat_primes(IN UV low, IN UV high)
 
 #define SIMPLE_FACTOR(func, n, arg1) \
     if (n <= 1) { \
-      XPUSHs(sv_2mortal(newSVuv( n ))); \
+      if (n == 0) \
+        XPUSHs(sv_2mortal(newSVuv( n ))); \
     } else { \
       while ( (n% 2) == 0 ) {  n /=  2;  XPUSHs(sv_2mortal(newSVuv( 2 ))); } \
       while ( (n% 3) == 0 ) {  n /=  3;  XPUSHs(sv_2mortal(newSVuv( 3 ))); } \
@@ -381,7 +382,8 @@ erat_primes(IN UV low, IN UV high)
 #define SIMPLE_FACTOR_2ARG(func, n, arg1, arg2) \
     /* Stupid MSVC won't bring its C compiler out of the 1980s. */ \
     if (n <= 1) { \
-      XPUSHs(sv_2mortal(newSVuv( n ))); \
+      if (n == 0) \
+        XPUSHs(sv_2mortal(newSVuv( n ))); \
     } else { \
       while ( (n% 2) == 0 ) {  n /=  2;  XPUSHs(sv_2mortal(newSVuv( 2 ))); } \
       while ( (n% 3) == 0 ) {  n /=  3;  XPUSHs(sv_2mortal(newSVuv( 3 ))); } \
@@ -418,18 +420,20 @@ void
 _XS_factor_exp(IN UV n)
   PREINIT:
     UV factors[MPU_MAX_FACTORS+1];
+    UV exponents[MPU_MAX_FACTORS+1];
     int i, j, nfactors;
   PPCODE:
     nfactors = factor(n, factors);
     if (GIMME_V == G_SCALAR) {
       /* Count unique prime factors and return the scalar */
+      if (n == 1)  XSRETURN_UV(0);
       for (i = 1, j = 1; i < nfactors; i++)
         if (factors[i] != factors[i-1])
           j++;
       PUSHs(sv_2mortal(newSVuv(j)));
     } else {
       /* Return ( [p1,e1], [p2,e2], [p3,e3], ... ) */
-      UV exponents[MPU_MAX_FACTORS+1];
+      if (n == 1)  XSRETURN_EMPTY;
       exponents[0] = 1;
       for (i = 1, j = 1; i < nfactors; i++) {
         if (factors[i] != factors[i-1]) {
diff --git a/factor.c b/factor.c
index 0af17bd..d2a6ba3 100644
--- a/factor.c
+++ b/factor.c
@@ -163,7 +163,7 @@ int trial_factor(UV n, UV *factors, UV maxtrial)
   /* Cover the cases 0/1/2/3 now */
   if (n < 4 || maxtrial < 2) {
     factors[0] = n;
-    return 1;
+    return (n == 1) ? 0 : 1;
   }
   /* Trial division for 2, 3, 5, 7, and see if we're done */
   while ( (n & 1) == 0 ) { factors[nfactors++] = 2; n /= 2; }
diff --git a/lib/Math/Prime/Util.pm b/lib/Math/Prime/Util.pm
index 7c84a53..8956d5b 100644
--- a/lib/Math/Prime/Util.pm
+++ b/lib/Math/Prime/Util.pm
@@ -1227,6 +1227,7 @@ sub all_factors {
 
   _validate_num($n) || _validate_positive_integer($n);
 
+  return () if $n == 1;
   return _XS_divisors($n) if $n <= $_XS_MAXVAL;
 
   my %all_factors;
@@ -1832,6 +1833,7 @@ sub factor {
   my($n) = @_;
   _validate_num($n) || _validate_positive_integer($n);
 
+  return () if $n == 1;
   return _XS_factor($n) if $n <= $_XS_MAXVAL;
 
   if ($_HAVE_GMP) {
diff --git a/t/50-factoring.t b/t/50-factoring.t
index 4cc339d..c9cab00 100644
--- a/t/50-factoring.t
+++ b/t/50-factoring.t
@@ -79,7 +79,7 @@ my %all_factors = (
       4 => [1,2,4],
       3 => [1,3],
       2 => [1,2],
-      1 => [1],
+      1 => [],
       0 => [],
 );
 
@@ -95,7 +95,7 @@ foreach my $n (@testn) {
 
   # Are they all prime?
   my $isprime = 1; $isprime *= is_prime($_) for @f;
-  if ($n < 2) {
+  if ($n < 1) {
     ok( !$isprime, "   each factor is not prime" );
   } else {
     ok(  $isprime, "   each factor is prime" );
@@ -127,7 +127,7 @@ sub extra_factor_test {
   my $fname = shift;
   my $fsub = shift;
 
-  is_deeply( [ sort {$a<=>$b} $fsub->(1)   ], [1],       "$fname(1)" );
+  is_deeply( [ sort {$a<=>$b} $fsub->(1)   ], [],        "$fname(1)" );
   is_deeply( [ sort {$a<=>$b} $fsub->(4)   ], [2, 2],    "$fname(4)" );
   is_deeply( [ sort {$a<=>$b} $fsub->(9)   ], [3, 3],    "$fname(9)" );
   is_deeply( [ sort {$a<=>$b} $fsub->(11)  ], [11],      "$fname(11)" );
@@ -141,7 +141,7 @@ sub extra_factor_test {
 
 # Factor in scalar context
 is( scalar factor(0), 1, "scalar factor(0) should be 1" );
-is( scalar factor(1), 1, "scalar factor(1) should be 1" );
+is( scalar factor(1), 0, "scalar factor(1) should be 0" );
 is( scalar factor(3), 1, "scalar factor(3) should be 1" );
 is( scalar factor(4), 2, "scalar factor(4) should be 2" );
 is( scalar factor(5), 1, "scalar factor(5) should be 1" );

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmath-prime-util-perl.git