From 7833bfdd94cb7b5afbbc1b18e75e664482f529d5 Mon Sep 17 00:00:00 2001
From: Peter John Acklam <pjacklam@online.no>
Date: Mon, 7 Mar 2011 11:45:38 +0100
Subject: [PATCH] Add sign function bsgn() as a complement to babs().

This is the standard mathematical signum function. It sets the
invocand to -1, 0, or 1, if it is real, and NaN otherwise.

Documentation and tests are included.
---
 dist/Math-BigInt/lib/Math/BigInt.pm | 13 +++++++++++++
 dist/Math-BigInt/t/bare_mbi.t       |  2 +-
 dist/Math-BigInt/t/bigintpm.inc     |  9 ++++++++-
 dist/Math-BigInt/t/bigintpm.t       |  2 +-
 dist/Math-BigInt/t/sub_mbi.t        |  2 +-
 5 files changed, 24 insertions(+), 4 deletions(-)

diff --git a/dist/Math-BigInt/lib/Math/BigInt.pm b/dist/Math-BigInt/lib/Math/BigInt.pm
index 62c021e..796b75a 100644
--- a/dist/Math-BigInt/lib/Math/BigInt.pm
+++ b/dist/Math-BigInt/lib/Math/BigInt.pm
@@ -1013,6 +1013,18 @@ sub babs
   $x;
   }
 
+sub bsgn {
+    # Signum function.
+
+    my $self = shift;
+
+    return $self if $self->modify('bsgn');
+
+    return $self -> bone("+") if $self -> is_pos();
+    return $self -> bone("-") if $self -> is_neg();
+    return $self;               # zero or NaN
+}
+
 sub bneg 
   { 
   # (BINT or num_str) return BINT
@@ -3310,6 +3322,7 @@ Math::BigInt - Arbitrary size integer/float math package
 
   $x->bneg();		# negation
   $x->babs();		# absolute value
+  $x->bsgn();		# sign function (-1, 0, 1, or NaN)
   $x->bnorm();		# normalize (no-op in BigInt)
   $x->bnot();		# two's complement (bit wise not)
   $x->binc();		# increment $x by 1
diff --git a/dist/Math-BigInt/t/bare_mbi.t b/dist/Math-BigInt/t/bare_mbi.t
index d7139dd..9f2198b 100644
--- a/dist/Math-BigInt/t/bare_mbi.t
+++ b/dist/Math-BigInt/t/bare_mbi.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 3623;
+use Test::More tests => 3635;
 
 BEGIN { unshift @INC, 't'; }
 
diff --git a/dist/Math-BigInt/t/bigintpm.inc b/dist/Math-BigInt/t/bigintpm.inc
index e52a271..478584b 100644
--- a/dist/Math-BigInt/t/bigintpm.inc
+++ b/dist/Math-BigInt/t/bigintpm.inc
@@ -73,7 +73,7 @@ while (<DATA>)
    } elsif ($f eq "bone") {
     $try .= "\$x->bone('$args[1]');";
   # some unary ops
-   } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt|fac)$/) {
+   } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|sgn|inc|dec|not|sqrt|fac)$/) {
     $try .= "\$x->$f();";
    } elsif ($f =~ /^(numify|length|stringify|as_hex|as_bin)$/) {
     $try .= "\$x->$f();";
@@ -1222,6 +1222,13 @@ babsNaN:NaN
 -1:1
 +123456789:123456789
 -123456789:123456789
+&bsgn
+NaN:NaN
++inf:1
+-inf:-1
+0:0
++123456789:1
+-123456789:-1
 &bcmp
 bcmpNaN:bcmpNaN:
 bcmpNaN:0:
diff --git a/dist/Math-BigInt/t/bigintpm.t b/dist/Math-BigInt/t/bigintpm.t
index cacdb8e..6ee3eff 100644
--- a/dist/Math-BigInt/t/bigintpm.t
+++ b/dist/Math-BigInt/t/bigintpm.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 3623 + 6;
+use Test::More tests => 3635 + 6;
 
 use Math::BigInt lib => 'Calc';
 
diff --git a/dist/Math-BigInt/t/sub_mbi.t b/dist/Math-BigInt/t/sub_mbi.t
index 668fd19..6a3cecc 100644
--- a/dist/Math-BigInt/t/sub_mbi.t
+++ b/dist/Math-BigInt/t/sub_mbi.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 use strict;
-use Test::More tests => 3623
+use Test::More tests => 3635
     + 5;	# +5 own tests
 
 BEGIN { unshift @INC, 't'; }
-- 
2.7.4