diff options
-rw-r--r-- | module/rnrs/base.scm | 9 | ||||
-rw-r--r-- | test-suite/tests/r6rs-base.test | 16 |
2 files changed, 25 insertions, 0 deletions
diff --git a/module/rnrs/base.scm b/module/rnrs/base.scm index b9dddab0b..b867929fe 100644 --- a/module/rnrs/base.scm +++ b/module/rnrs/base.scm @@ -74,6 +74,7 @@ syntax-rules identifier-syntax) (import (rename (except (guile) error raise) + (log log-internal) (euclidean-quotient div) (euclidean-remainder mod) (euclidean/ div-and-mod) @@ -85,6 +86,14 @@ (inexact->exact exact)) (srfi srfi-11)) + (define log + (case-lambda + ((n) + (log-internal n)) + ((n base) + (/ (log n) + (log base))))) + (define (boolean=? . bools) (define (boolean=?-internal lst last) (or (null? lst) diff --git a/test-suite/tests/r6rs-base.test b/test-suite/tests/r6rs-base.test index 1509b04ed..dfddf7c34 100644 --- a/test-suite/tests/r6rs-base.test +++ b/test-suite/tests/r6rs-base.test @@ -21,6 +21,22 @@ :use-module ((rnrs base) :version (6)) :use-module (test-suite lib)) + +;; numbers are considered =? if their difference is less than a set +;; tolerance +(define (=? alpha beta) + (< (abs (- alpha beta)) 1e-10)) + +(with-test-prefix "log (2nd arg)" + (pass-if "log positive-base" (=? (log 8 2) 3)) + (pass-if "log negative-base" (=? (real-part (log 256 -4)) + 0.6519359443)) + (pass-if "log base-one" (= (log 10 1) +inf.0)) + (pass-if "log base-zero" + (catch #t + (lambda () (log 10 0) #f) + (lambda args #t)))) + (with-test-prefix "boolean=?" (pass-if "boolean=? null" (boolean=?)) (pass-if "boolean=? unary" (boolean=? #f)) |