suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix gcd & lcm on single negative argument (PR 9330)

Browse Source 
svn: r9543
This commit is contained in:
Matthew Flatt 2008-04-30 12:26:09 +00:00
parent e04ef5b12b
commit 95aca3e86a
4 changed files with 26 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/tests/mzscheme/number.ss
View File

@ -1108,6 +1108,8 @@
(test 4 gcd 0 4)
(test 4 gcd -4 0)
(test 4 gcd 4)
(test 4 gcd -4)
(test 4 gcd 32 -36)
(test 2 gcd 6 10 14)
(test 0 gcd)
@ -1115,11 +1117,15 @@
(test 5.0 gcd 5.0 10)
(test 5.0 gcd -5.0 10)
(test 5.0 gcd 5.0 -10)
(test 5.0 gcd 5.0)
(test 5.0 gcd -5.0)
(err/rt-test (gcd 5.0+0.0i 10))
(err/rt-test (gcd 5.0 10+0.0i))
(test (expt 3 37) gcd (expt 9 35) (expt 6 37))
(test (expt 3 37) gcd (- (expt 9 35)) (expt 6 37))
(test (expt 3 37) gcd (expt 9 35) (- (expt 6 37)))
(test (expt 3 75) gcd (expt 3 75))
(test (expt 3 75) gcd (- (expt 3 75)))
(test 201 gcd (* 67 (expt 3 20)) (* 67 3))
(test 201 gcd (* 67 3) (* 67 (expt 3 20)))
(test 6 gcd (* 3 (expt 2 100)) 66)
@ -1132,8 +1138,11 @@
(test 12 lcm 2 3 4)
(test 1 lcm)
(test 5 lcm 5)
(test 5 lcm -5)
(test 0 lcm 123 0)
(test 30.0 lcm 5 6.0)
(test 6.0 lcm 6.0)
(test 6.0 lcm -6.0)
(err/rt-test (lcm 5 6.0+0.0i))
(err/rt-test (lcm 5+0.0i 6.0))
(test 0.0 lcm 123 0.0)

4
src/mzscheme/src/numarith.c
View File

@ -254,8 +254,8 @@ GEN_BIN_OP(scheme_bin_minus, "-", SUBTRACT, F_SUBTRACT, FS_SUBTRACT, scheme_bign
GEN_BIN_OP(scheme_bin_mult, "*", MULTIPLY, F_MULTIPLY, FS_MULTIPLY, scheme_bignum_multiply, scheme_rational_multiply, scheme_complex_multiply, GEN_RETURN_0, GEN_RETURN_0, NO_NAN_CHECK, NO_NAN_CHECK)
GEN_BIN_DIV_OP(scheme_bin_div, "/", DIVIDE, F_DIVIDE, FS_DIVIDE, scheme_make_rational, scheme_rational_divide, scheme_complex_divide)
GEN_NARY_OP(static, plus, "+", scheme_bin_plus, 0, SCHEME_NUMBERP, "number")
GEN_NARY_OP(static, mult, "*", scheme_bin_mult, 1, SCHEME_NUMBERP, "number")
GEN_NARY_OP(static, plus, "+", scheme_bin_plus, 0, SCHEME_NUMBERP, "number", GEN_IDENT)
GEN_NARY_OP(static, mult, "*", scheme_bin_mult, 1, SCHEME_NUMBERP, "number", GEN_IDENT)
static MZ_INLINE Scheme_Object *
minus_slow (Scheme_Object *ret, int argc, Scheme_Object *argv[])

18
src/mzscheme/src/number.c
View File

@ -964,8 +964,16 @@ even_p (int argc, Scheme_Object *argv[])
static Scheme_Object *bin_lcm (Scheme_Object *n1, Scheme_Object *n2);
GEN_NARY_OP(static, gcd, "gcd", scheme_bin_gcd, 0, scheme_is_integer, "integer")
GEN_NARY_OP(static, lcm, "lcm", bin_lcm, 1, scheme_is_integer, "integer")
static Scheme_Object *int_abs(Scheme_Object *v)
{
if (scheme_is_negative(v))
return scheme_bin_minus(scheme_make_integer(0), v);
else
return v;
}
GEN_NARY_OP(static, gcd, "gcd", scheme_bin_gcd, 0, scheme_is_integer, "integer", int_abs)
GEN_NARY_OP(static, lcm, "lcm", bin_lcm, 1, scheme_is_integer, "integer", int_abs)
Scheme_Object *
scheme_bin_gcd (const Scheme_Object *n1, const Scheme_Object *n2)
@ -2401,9 +2409,9 @@ GEN_BIN_INT_OP(bin_bitwise_xor, "bitwise-xor", ^, scheme_bignum_xor)
#define MZ_PUBLIC /**/
GEN_NARY_OP(MZ_PUBLIC, scheme_bitwise_and, "bitwise-and", bin_bitwise_and, -1, SCHEME_EXACT_INTEGERP, "exact integer")
GEN_NARY_OP(static, bitwise_or, "bitwise-ior", bin_bitwise_or, 0, SCHEME_EXACT_INTEGERP, "exact integer")
GEN_NARY_OP(static, bitwise_xor, "bitwise-xor", bin_bitwise_xor, 0, SCHEME_EXACT_INTEGERP, "exact integer")
GEN_NARY_OP(MZ_PUBLIC, scheme_bitwise_and, "bitwise-and", bin_bitwise_and, -1, SCHEME_EXACT_INTEGERP, "exact integer", GEN_IDENT)
GEN_NARY_OP(static, bitwise_or, "bitwise-ior", bin_bitwise_or, 0, SCHEME_EXACT_INTEGERP, "exact integer", GEN_IDENT)
GEN_NARY_OP(static, bitwise_xor, "bitwise-xor", bin_bitwise_xor, 0, SCHEME_EXACT_INTEGERP, "exact integer", GEN_IDENT)
static Scheme_Object *
bitwise_not(int argc, Scheme_Object *argv[])

3
src/mzscheme/src/nummacs.h
View File

@ -589,7 +589,7 @@ name (const Scheme_Object *n1, const Scheme_Object *n2) \
return name ## __wrong_type(n2); \
}
#define GEN_NARY_OP(stat, name, scheme_name, bin_name, ident, TYPEP, type) \
#define GEN_NARY_OP(stat, name, scheme_name, bin_name, ident, TYPEP, type, single) \
stat Scheme_Object *name (int argc, Scheme_Object *argv[]); \
static MZ_INLINE Scheme_Object * \
name ## __slow (Scheme_Object *ret, int argc, Scheme_Object *argv[]) \
@ -616,6 +616,7 @@ name (int argc, Scheme_Object *argv[]) \
if (!TYPEP(b)) { scheme_wrong_type(scheme_name, type, 1, argc, argv); return NULL; } \
return bin_name(ret, b); \
} \
if (argc == 1) { return single(ret); } \
return name ## __slow(ret, argc, argv); \
}