~ chicken-r7rs (master) c302f25ced0a527f58279a84a1305c3c98a30f9c
commit c302f25ced0a527f58279a84a1305c3c98a30f9c
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sun Aug 18 18:43:32 2013 +0000
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Sun Aug 18 18:43:32 2013 +0000
import and export the quotient/remainder division procedures. Update numbers dependency version to 2.9
diff --git a/r7rs.meta b/r7rs.meta
index 5854b1b..93a34d7 100644
--- a/r7rs.meta
+++ b/r7rs.meta
@@ -2,6 +2,6 @@
(author "The Chicken Team")
(category lang-exts)
(license "BSD")
- (depends matchable make numbers)
+ (depends matchable make (numbers "2.9"))
(test-depends test)
(foreign-depends))
diff --git a/scheme.base-interface.scm b/scheme.base-interface.scm
index d1062cc..bed6bbf 100644
--- a/scheme.base-interface.scm
+++ b/scheme.base-interface.scm
@@ -75,8 +75,10 @@
|#
file-error?
#|
- floor floor-quotient floor-remainder
- floor/
+ floor
+ |#
+ floor/ floor-quotient floor-remainder
+ #|
flush-output-port
for-each
gcd lcm
@@ -143,8 +145,8 @@
procedure?
quasiquote
quote
- quotient remainder
|#
+ quotient remainder
raise raise-continuable
#|
rational?
@@ -190,8 +192,9 @@
#|
textual-port?
truncate
- truncate-quotient truncate-remainder
- truncate/
+ |#
+ truncate/ truncate-quotient truncate-remainder
+ #|
u8-ready?
unless
unquote unquote-splicing
diff --git a/scheme.base.scm b/scheme.base.scm
index 393b0d6..eecb4ab 100644
--- a/scheme.base.scm
+++ b/scheme.base.scm
@@ -1,7 +1,8 @@
(module scheme.base ()
(import (except scheme syntax-rules cond-expand member))
-(import (except chicken with-exception-handler raise))
+(import (except chicken with-exception-handler raise quotient remainder modulo))
+(import numbers)
(include "scheme.base-interface.scm")
diff --git a/tests/run.scm b/tests/run.scm
index b16e054..a111879 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -10,6 +10,63 @@
(test-begin "r7rs tests")
+(test-group "6.2.6: numerical operations"
+ (test-group "floor/...truncate-remainder"
+ (test '(2 1) (receive (floor/ 5 2)))
+ (test 2 (floor-quotient 5 2))
+ (test 1 (floor-remainder 5 2))
+ (test '(-3 1) (receive (floor/ -5 2)))
+ (test -3 (floor-quotient -5 2))
+ (test 1 (floor-remainder -5 2))
+ (test '(-3 -1) (receive (floor/ 5 -2)))
+ (test -3 (floor-quotient 5 -2))
+ (test -1 (floor-remainder 5 -2))
+ (test '(2 -1) (receive (floor/ -5 -2)))
+ (test 2 (floor-quotient -5 -2))
+ (test -1 (floor-remainder -5 -2))
+ (test '(2.0 -1.0) (receive (floor/ -5 -2.0)))
+ ;; From the Guile manual
+ (test 12 (floor-quotient 123 10))
+ (test 3 (floor-remainder 123 10))
+ (test '(12 3) (receive (floor/ 123 10)))
+ (test '(-13 -7) (receive (floor/ 123 -10)))
+ (test '(-13 7) (receive (floor/ -123 10)))
+ (test '(12 -3) (receive (floor/ -123 -10)))
+
+ (test '(2 1) (receive (truncate/ 5 2)))
+ (test 2 (truncate-quotient 5 2))
+ (test 1 (truncate-remainder 5 2))
+ (test '(-2 -1) (receive (truncate/ -5 2)))
+ (test -2 (truncate-quotient -5 2))
+ (test -1 (truncate-remainder -5 2))
+ (test '(-2 1) (receive (truncate/ 5 -2)))
+ (test -2 (truncate-quotient 5 -2))
+ (test 1 (truncate-remainder 5 -2))
+ (test '(2 -1) (receive (truncate/ -5 -2)))
+ (test 2 (truncate-quotient -5 -2))
+ (test -1 (truncate-remainder -5 -2))
+ (test '(2.0 -1.0) (receive (truncate/ -5.0 -2)))
+ (test 2.0 (truncate-quotient -5.0 -2))
+ (test -1.0 (truncate-remainder -5.0 -2))
+ ;; From the Guile manual
+ (test 12 (truncate-quotient 123 10))
+ (test 3 (truncate-remainder 123 10))
+ (test '(12 3) (receive (truncate/ 123 10)))
+ (test '(-12 3) (receive (truncate/ 123 -10)))
+ (test '(-12 -3) (receive (truncate/ -123 10)))
+ (test '(12 -3) (receive (truncate/ -123 -10))))
+
+ (test-group "quotient, remainder and modulo"
+ (test 1 (modulo 13 4))
+ (test 1 (remainder 13 4))
+ (test 3 (modulo -13 4))
+ (test -1 (remainder -13 4))
+ (test -3 (modulo 13 -4))
+ (test 1 (remainder 13 -4))
+ (test -1 (modulo -13 -4))
+ (test -1 (remainder -13 -4))
+ (test -1.0 (remainder -13 -4.0))))
+
(test-group "6.3: booleans"
;; How silly...
(test-group "not"
Trap