ref: 2bb1c980e25fce857906ad619986a9f001889fcf
parent: db4982b0ed1344608625a91b576a632d89c64ff2
author: Doug Currie <[email protected]>
date: Wed Aug 9 10:21:29 EDT 2017
Fix * and + to return inexact when given inexact args.
--- a/cvalues.c
+++ b/cvalues.c
@@ -1048,6 +1048,7 @@
uint64_t Uaccum=0;
int64_t Saccum = carryIn;
double Faccum=0;
+ int32_t inexact = 0;
uint32_t i;
value_t arg=NIL;
@@ -1075,8 +1076,8 @@
Saccum += i64;
break;
case T_UINT64: Uaccum += *(uint64_t*)a; break;
- case T_FLOAT: Faccum += *(float*)a; break;
- case T_DOUBLE: Faccum += *(double*)a; break;
+ case T_FLOAT: Faccum += *(float*)a; inexact = 1; break;
+ case T_DOUBLE: Faccum += *(double*)a; inexact = 1; break;
default:
goto add_type_error;
}
@@ -1085,7 +1086,7 @@
add_type_error:
type_error("+", "number", arg);}
- if (Faccum != 0) {+ if (inexact) {Faccum += Uaccum;
Faccum += Saccum;
return mk_double(Faccum);
@@ -1159,6 +1160,7 @@
{uint64_t Uaccum=1;
double Faccum=1;
+ int32_t inexact = 0;
uint32_t i;
value_t arg=NIL;
@@ -1186,8 +1188,8 @@
Saccum *= i64;
break;
case T_UINT64: Uaccum *= *(uint64_t*)a; break;
- case T_FLOAT: Faccum *= *(float*)a; break;
- case T_DOUBLE: Faccum *= *(double*)a; break;
+ case T_FLOAT: Faccum *= *(float*)a; inexact = 1; break;
+ case T_DOUBLE: Faccum *= *(double*)a; inexact = 1; break;
default:
goto mul_type_error;
}
@@ -1196,7 +1198,7 @@
mul_type_error:
type_error("*", "number", arg);}
- if (Faccum != 1) {+ if (inexact) {Faccum *= Uaccum;
Faccum *= Saccum;
return mk_double(Faccum);
--- a/tests/unittest.lsp
+++ b/tests/unittest.lsp
@@ -287,5 +287,9 @@
(assert (let ((ts (time.string (time.now))))
(eqv? ts (time.string (time.fromstring ts))))))
+(assert (equal? 0.0 (+ 0.0 0))) ; tests that + no longer does inexact->exact
+
+(assert (equal? 1.0 (* 1.0 1))) ; tests that * no longer does inexact->exact
+
(princ "all tests pass\n")
#t