commit 0bf961b8ffadfa0f53c32fc222f2355b0c1c0a0f
parent 0d5eff2c98f48e483cc1326c7f47674e520f20fe
Author: Oto Havle <havleoto@gmail.com>
Date: Thu, 20 Oct 2011 15:00:36 +0200
Merged recent fixes from the original project.
Diffstat:
4 files changed, 33 insertions(+), 21 deletions(-)
diff --git a/src/kgc.c b/src/kgc.c
@@ -584,6 +584,7 @@ static void markroot (klisp_State *K) {
markvalue(K, K->kd_in_port_key);
markvalue(K, K->kd_out_port_key);
markvalue(K, K->kd_error_port_key);
+ markvalue(K, K->kd_strict_arith_key);
markvalue(K, K->empty_string);
markvalue(K, K->empty_blob);
diff --git a/src/krational.c b/src/krational.c
@@ -492,14 +492,16 @@ TValue kbigrat_to_integer(klisp_State *K, TValue tv_bigrat, kround_mode mode)
if (mp_rat_compare_zero(n) < 0 && mp_int_compare_zero(rest) != 0)
UNUSED(mp_int_sub_value(K, quot, 1, quot));
break;
- case K_ROUND_EVEN:
+ case K_ROUND_EVEN: {
UNUSED(mp_int_mul_pow2(K, rest, 1, rest));
- if (mp_int_compare(rest, MP_DENOM_P(n)) == 0 &&
- mp_int_is_odd(quot))
+ int cmp = mp_int_compare(rest, MP_DENOM_P(n));
+ if (cmp > 0 || (cmp == 0 && mp_int_is_odd(quot))) {
UNUSED(mp_int_add_value(K, quot, mp_rat_compare_zero(n) < 0?
-1 : 1, quot));
+ }
break;
}
+ }
krooted_tvs_pop(K);
krooted_tvs_pop(K);
diff --git a/src/kreal.c b/src/kreal.c
@@ -731,6 +731,7 @@ TValue kdouble_to_integer(klisp_State *K, TValue tv_double, kround_mode mode)
int res = fesetround(FE_TONEAREST); /* REFACTOR: should be done once only... */
klisp_assert(res == 0);
d = nearbyint(d);
+ break;
}
}
/* ASK John: we currently return inexact if given inexact is this ok?
diff --git a/src/tests/numbers.k b/src/tests/numbers.k
@@ -10,14 +10,13 @@
;; Shutt for clarification (but I warn you that while he is very cooperative
;; with this kind of things he sometimes takes a while to answer).
;;
-;; The operations that throw an error instead of returning #real do so because
-;; the strict-arithmetic flag is true which apparently is caused by a bug, as
-;; it starts as false when the interpreter starts but is true after running the
-;; test (Which is a thing that shouldn't be possible, the flag is a dynamic
-;; variable). I'm on it.
-;;
-;; The round thing is obviously a bug too, but (round 1.1) doesn't hang so
-;; I'm inclined to think that it's related to the previous bug, I'm on it.
+;; The round thing is actually a bug in dtoa (kreal.c) the function that
+;; converts doubles to strings and has nothing to do with rounding.
+;; When the error msg was being generated the interpreter entered an infinite
+;; loop in dtoa.
+;; You can test this easily just entering 1.1 in the interpreter.
+;; I'll have to work on this one. I'll have to reread the paper and work on it
+;; with gdb.
;;
;; Andres Navarro
;;
@@ -117,19 +116,19 @@
($check equal? (+ . #0=(0 . #0#)) 0)
($check equal? (+ . #0=(1 . #0#)) #e+infinity)
($check equal? (+ . #0=(-1 . #0#)) #e-infinity)
-;---- ($check equal? (+ . #0=(1 -1 . #0#)) #real) ; FAIL
+($check equal? (+ . #0=(1 -1 . #0#)) #real)
;; 12.5.5 *
($check equal? (* 2 3) 6)
($check equal? (*) 1)
-;---- ($check equal? (* 0 #e+infinity) #real) ; FAIL
-;---- ($check equal? (* 0 #e-infinity) #real) ; FAIL
+($check equal? (* 0 #e+infinity) #real)
+($check equal? (* 0 #e-infinity) #real)
($check equal? (* . #0=(1 . #0#)) 1)
($check equal? (* . #0=(2 . #0#)) #e+infinity)
($check equal? (* . #0=(1/2 . #0#)) 0)
-;---- ($check equal? (* . #0=(1/2 2 . #0#)) #real) ; FAIL
-;---- ($check equal? (* . #0=(-1 . #0#)) #real) ; FAIL
+($check equal? (* . #0=(1/2 2 . #0#)) #real)
+($check equal? (* . #0=(-1 . #0#)) #real)
;; 12.5.5 -
@@ -163,6 +162,11 @@
;; If real2 is negative, then such integer n does not exist.
;; interpretation : result shall be #undefined
;;
+;; I followed Scheme r6rs and r7rs draft here. The definition in the
+;; Kernel report didn't make much sense to me. I'm still waiting the
+;; next installement of the report to see if this is changed.
+;;
+;; Andres Navarro
;--- ($check equal? (div 10 -7) #undefined) ; FAIL
;--- ($check equal? (div -10 -7) #undefined) ; FAIL
@@ -249,7 +253,7 @@
;; negative infinity (...)"
;;
;; Andres Navarro
-;; ($check-predicate (robust? 3.14)) ; FAIL
+;; was ($check-predicate (robust? 3.14)) ; FAIL
($check-not-predicate (robust? #real))
($check-not-predicate (robust? #undefined))
@@ -348,13 +352,17 @@
($check equal? (round 0) 0)
($check equal? (round 1/2) 0)
-;-- ($check equal? (round 1.1) 1) ; FREEZES INTERPRETER
+($check equal? (round #e1.1) 1)
+($check =? (round 1.1) 1)
($check equal? (round 3/2) 2)
-;--($check equal? (round 1.9) 2)
+($check equal? (round #e1.9) 2)
+($check =? (round 1.9) 2)
($check equal? (round -1/2) 0)
-;-- ($check equal? (round -1.1) -1) ; FREEZES INTERPRETER
+($check =? (round #e-1.1) -1)
+($check equal? (round #e-1.1) -1)
($check equal? (round -3/2) -2)
-;--($check equal? (round -1.9) -2)
+($check equal? (round #e-1.9) -2)
+($check =? (round -1.9) -2)
;; 12.8.5 rationalize simplest-rational
