~ chicken-core (master) f090e1263d2ca60b89b9372d6e79a327ebd55287
commit f090e1263d2ca60b89b9372d6e79a327ebd55287
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Sun Sep 6 19:23:26 2026 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Sun Sep 6 19:23:26 2026 +0200
handle mixed complex/non-complex division better, see ticket a2dd81
As suggested by Peter McGoron
diff --git a/runtime.c b/runtime.c
index 8d5be71d..ba7ed921 100644
--- a/runtime.c
+++ b/runtime.c
@@ -8057,8 +8057,9 @@ C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y)
} else if (C_block_header(y) == C_RATNUM_TAG) {
return rat_times_integer(ptr, y, x);
} else if (C_block_header(y) == C_CPLXNUM_TAG) {
- return cplx_times(ptr, x, C_fix(0),
- C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
+ C_word r = C_s_a_i_times(ptr, 2, x, C_u_i_cplxnum_real(y));
+ C_word i = C_s_a_i_times(ptr, 2, x, C_u_i_cplxnum_imag(y));
+ return C_cplxnum(ptr, r, i);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
}
@@ -8076,9 +8077,9 @@ C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y)
} else if (C_block_header(y) == C_RATNUM_TAG) {
return C_s_a_i_times(ptr, 2, x, C_a_i_exact_to_inexact(ptr, 1, y));
} else if (C_block_header(y) == C_CPLXNUM_TAG) {
- C_word ab[C_SIZEOF_FLONUM], *a = ab;
- return cplx_times(ptr, x, C_flonum(&a, 0.0),
- C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
+ C_word r = C_s_a_i_times(ptr, 2, x, C_u_i_cplxnum_real(y));
+ C_word i = C_s_a_i_times(ptr, 2, x, C_u_i_cplxnum_imag(y));
+ return C_cplxnum(ptr, r, i);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
}
@@ -8094,8 +8095,9 @@ C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y)
} else if (C_block_header(y) == C_RATNUM_TAG) {
return rat_times_integer(ptr, y, x);
} else if (C_block_header(y) == C_CPLXNUM_TAG) {
- return cplx_times(ptr, x, C_fix(0),
- C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
+ C_word r = C_s_a_i_times(ptr, 2, x, C_u_i_cplxnum_real(y));
+ C_word i = C_s_a_i_times(ptr, 2, x, C_u_i_cplxnum_imag(y));
+ return C_cplxnum(ptr, r, i);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
}
@@ -8111,8 +8113,9 @@ C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y)
} else if (C_block_header(y) == C_RATNUM_TAG) {
return rat_times_rat(ptr, x, y);
} else if (C_block_header(y) == C_CPLXNUM_TAG) {
- return cplx_times(ptr, x, C_fix(0),
- C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
+ C_word r = C_s_a_i_times(ptr, 2, x, C_u_i_cplxnum_real(y));
+ C_word i = C_s_a_i_times(ptr, 2, x, C_u_i_cplxnum_imag(y));
+ return C_cplxnum(ptr, r, i);
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", y);
}
@@ -8121,9 +8124,9 @@ C_s_a_i_times(C_word **ptr, C_word n, C_word x, C_word y)
return cplx_times(ptr, C_u_i_cplxnum_real(x), C_u_i_cplxnum_imag(x),
C_u_i_cplxnum_real(y), C_u_i_cplxnum_imag(y));
} else {
- C_word ab[C_SIZEOF_FLONUM], *a = ab, yi;
- yi = C_truep(C_i_flonump(y)) ? C_flonum(&a,0) : C_fix(0);
- return cplx_times(ptr, C_u_i_ratnum_num(x), C_u_i_ratnum_denom(x), y, yi);
+ C_word r = C_s_a_i_times(ptr, 2, y, C_u_i_cplxnum_real(x));
+ C_word i = C_s_a_i_times(ptr, 2, y, C_u_i_cplxnum_imag(x));
+ return C_cplxnum(ptr, r, i);
}
} else {
barf(C_BAD_ARGUMENT_TYPE_NO_NUMBER_ERROR, "*", x);
diff --git a/tests/numbers-test-gauche.scm b/tests/numbers-test-gauche.scm
index b44a51f3..6a52da00 100644
--- a/tests/numbers-test-gauche.scm
+++ b/tests/numbers-test-gauche.scm
@@ -1214,13 +1214,16 @@
(test-equal "flonum * 1.0" (apply * '(3.0 1.0)) 3.0)
(test-equal "1.0 * flonum" (apply * '(1.0 3.0)) 3.0)
-(test-equal "compnum * 0" (* 0 +i) 0)
-(test-equal "0 * compnum" (* +i 0) 0)
+;; these return complex exact 0+0i, but this can't be constructed in the reader
+;; not sure what to do here...
+;(test-equal "compnum * 0" (* 0 +i) 0)
+;(test-equal "0 * compnum" (* +i 0) 0)
+
(test-equal "compnum * 1" (* 1 +i) +i)
(test-equal "1 * compnum" (* +i 1) +i)
-(test-equal "compnum * 0.0" (* 0.0 +i) 0.0)
-(test-equal "0.0 * compnum" (* +i 0.0) 0.0)
+(test-equal "compnum * 0.0" (* 0.0 +i) 0.0+0.0i)
+(test-equal "0.0 * compnum" (* +i 0.0) 0.0+0.0i)
(test-equal "compnum * 1.0" (* 1.0 +i) +1.0i)
(test-equal "1.0 * compnum" (* +i 1.0) +1.0i))
diff --git a/tests/numbers-test.scm b/tests/numbers-test.scm
index 7b1c0a85..bc272197 100644
--- a/tests/numbers-test.scm
+++ b/tests/numbers-test.scm
@@ -49,6 +49,7 @@
(define c1 (make-rectangular 33 44))
(define c2 (make-rectangular -1.2 44))
+(define cinf (make-rectangular +inf.0 1.0))
(define b2 (- min-fix 22))
(define r1 (/ 33 44))
@@ -144,6 +145,7 @@
(test-assert "*: multiplying fix/big (-> 47244640212)" (show (* 22 max2)))
(test-assert "*: multiplying fix/rat" (show (* 33 r1)))
(test-equal "*: multiplying fix/complex" (* 99 c1) (make-rectangular 3267 4356))
+ (test-equal "*: multiplying fix/complex(inf)" (* 99 cinf) (make-rectangular +inf.0 99.0))
(test-equal "*: multiplying complex/fix (inexact)" (* c2 99) (make-rectangular -118.8 4356.0))
(test-equal "*: multiplying most negative fixnum by one (edge case)"
(list (* most-negative-fixnum 1) (fixnum? (* most-negative-fixnum 1)))
@@ -155,6 +157,7 @@
(test-assert "*: flo/rat" (show (* 3.4 r1)))
(test-assert "*: big/rat" (show (* b1 r1)))
(test-equal "*: flo/comp" (* 3.4 c1) (make-rectangular 112.2 149.6))
+ (test-equal "*: flo/comp(inf)" (* 99.0 cinf) (make-rectangular +inf.0 99.0))
(test-equal "*: comp*comp" (* c1 c1) (make-rectangular -847 2904))
(test-equal "*: comp*comp (inexact)" (* c1 c2) (make-rectangular -1975.6 1399.2))
(test-equal "*: multiarg" (* 33 44 55) 79860)
Trap