klisp

commit 40fed32579f512c2b58d5fcc7521790589953674
parent 4c0eff00acffd49acfb12a4b70dcb10f6a524c7c
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Wed, 19 Oct 2011 13:47:27 -0300

Bugfixes: Added type check for primary value in finite?, positive?, negative? and zero?.

Diffstat:
M
src/kgnumbers.c
 | 
20
++++++++++----------
M
src/tests/numbers.k
 | 
13
++++++++-----

2 files changed, 18 insertions(+), 15 deletions(-)
diff --git a/src/kgnumbers.c b/src/kgnumbers.c
@@ -35,9 +35,9 @@
 
 /* Helpers for typed predicates */
 bool knumberp(TValue obj) { return ttisnumber(obj); }
-/* TEMP used in =? for type predicate (XXX it's not actually a type
-   error, but it's close enough and otherwise should define a 
-   new bpredp for numeric predicates...) */
+/* TEMP used (as a type predicate) in all predicates that need a primary value
+   (XXX it's not actually a type error, but it's close enough and otherwise 
+   should define new predp & bpredp for numeric predicates...) */
 bool knumber_wpvp(TValue obj) 
 { 
     return ttisnumber(obj) && !ttisrwnpv(obj) && !ttisundef(obj); 
@@ -52,9 +52,9 @@ bool kintegerp(TValue obj) { return ttisinteger(obj); }
 bool keintegerp(TValue obj) { return ttiseinteger(obj); }
 bool krationalp(TValue obj) { return ttisrational(obj); }
 bool krealp(TValue obj) { return ttisreal(obj); }
-/* TEMP used in <? & co for type predicate (XXX it's not actually a type
-   error, but it's close enough and otherwise should define a 
-   new bpredp for numeric predicates...) */
+/* TEMP used (as a type predicate) in all predicates that need a real with 
+   primary value (XXX it's not actually a type error, but it's close enough 
+   and otherwise should define new predp & bpredp for numeric predicates...) */
 bool kreal_wpvp(TValue obj) { return ttisreal(obj) && !ttisrwnpv(obj); }
 
 bool kexactp(TValue obj) { return ttisexact(obj); }
@@ -2226,7 +2226,7 @@ void kinit_numbers_ground_env(klisp_State *K)
     add_applicative(K, ground_env, "number?", ftypep, 2, symbol, 
 		    p2tv(knumberp));
     add_applicative(K, ground_env, "finite?", ftyped_predp, 3, symbol, 
-		    p2tv(knumberp), p2tv(kfinitep));
+		    p2tv(knumber_wpvp), p2tv(kfinitep));
     add_applicative(K, ground_env, "integer?", ftypep, 2, symbol, 
 		    p2tv(kintegerp));
     /* 12.5.2 =? */
@@ -2249,7 +2249,7 @@ void kinit_numbers_ground_env(klisp_State *K)
     add_applicative(K, ground_env, "-", kminus, 0);
     /* 12.5.7 zero? */
     add_applicative(K, ground_env, "zero?", ftyped_predp, 3, symbol, 
-		    p2tv(knumberp), p2tv(kzerop));
+		    p2tv(knumber_wpvp), p2tv(kzerop));
     /* 12.5.8 div, mod, div-and-mod */
     add_applicative(K, ground_env, "div", kdiv_mod, 2, symbol, 
 		    i2tv(FDIV_DIV));
@@ -2266,9 +2266,9 @@ void kinit_numbers_ground_env(klisp_State *K)
 		    i2tv(FDIV_ZERO | FDIV_DIV | FDIV_MOD));
     /* 12.5.10 positive?, negative? */
     add_applicative(K, ground_env, "positive?", ftyped_predp, 3, symbol, 
-		    p2tv(krealp), p2tv(kpositivep));
+		    p2tv(kreal_wpvp), p2tv(kpositivep));
     add_applicative(K, ground_env, "negative?", ftyped_predp, 3, symbol, 
-		    p2tv(krealp), p2tv(knegativep));
+		    p2tv(kreal_wpvp), p2tv(knegativep));
     /* 12.5.11 odd?, even? */
     add_applicative(K, ground_env, "odd?", ftyped_predp, 3, symbol, 
 		    p2tv(kintegerp), p2tv(koddp));
diff --git a/src/tests/numbers.k b/src/tests/numbers.k
@@ -52,8 +52,8 @@
 ($check-not-predicate (finite? #e+infinity))
 ($check-not-predicate (finite? #e-infinity))
 
-($check-error (finite? #real))                        ; FAIL
-($check-error (finite? #undefined))                   ; FAIL
+($check-error (finite? #real))
+($check-error (finite? #undefined))
 
 ($check-predicate (integer? 0 8/2 -12/6 1.0 -1.25e2))
 ($check-not-predicate (integer? #e+infinity))
@@ -123,7 +123,8 @@
 ($check-not-predicate (zero? -0.0001))
 ($check-not-predicate (zero? #e+infinity))
 ($check-not-predicate (zero? #e-infinity))
-($check-error (zero? #real))                           ; FAIL
+($check-error (zero? #real))
+($check-error (zero? #undefined))
 
 ;; 12.5.8 div, mod, div-and-mod
 
@@ -165,12 +166,14 @@
 ($check-predicate (positive? 1 1.0 1/1 999999999999 #e+infinity))
 ($check-not-predicate (positive? 0))                          ; FAIL
 ($check-not-predicate (positive? #e-infinity))                ; FAIL
-($check-error (positive? #real))                              ; FAIL
+($check-error (positive? #real))
+($check-error (positive? #undefined))
 
 ($check-predicate (negative? -1 -1.0 -1/1 -999999999999 #e-infinity)) ; FAIL
 ($check-not-predicate (negative? 0))
 ($check-not-predicate (negative? #e+infinity))
-($check-error (negative? #real))                            ; FAIL
+($check-error (negative? #real))
+($check-error (negative? #undefined))
 
 ;; 12.5.11 even? odd?