Hi Guilers! It looks like there was a subtle but significant regression introduced to the behavior of `bitwise-copy-bit' in `(rnrs arithmetic bitwise)' back in 93da406f33.
R6RS says [0] that function (with arguments EI1, EI2, EI3) should transfer the EI2th bit from EI3 to EI1, but Guile's implementation was always reading the 0th bit from EI3. This patch brings the implementation back in line with the standard. `fxcopy-bit' in `(rnrs artihmetic fixnum)' gets touched as well, since it was relying on `bitwise-copy-bit'. Its behavior per R6RS is a little different [1] in that its third argument _is_ the bit to be set, so it's just easier to use SRFI-60's `copy-bit' to take its value. Any questions? Let me know. Regards, Julian [0] - http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-12.html#node_sec_11.4 [1] - http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-12.html#node_sec_11.2
From 7a207740ffc344c7cd70411bba6c16beaea10818 Mon Sep 17 00:00:00 2001 From: Julian Graham <jool...@undecidable.net> Date: Sat, 16 Sep 2017 20:09:32 -0400 Subject: [PATCH] Bring `bitwise-copy-bit' behavior back in line with R6RS. A regression in 93da406f33 had this function copying the lowest ("0th") bit from its "source" argument, whereas per R6RS it should be copying the same bit from the source as it is setting in the "destination" argument. * module/rnrs/arithmetic/bitwise.scm (bitwise-copy-bit): Read the EI2th bit from EI3. * module/rnrs/arithmetic/fixnums.scm (fxcopy-bit): Use `copy-bit' to read the 0th bit from FX3. * test-suite/test/r6rs-arithmetic-bitwise.test (bitwise-copy-bit): Update expected value in test case. --- module/rnrs/arithmetic/bitwise.scm | 4 ++-- module/rnrs/arithmetic/fixnums.scm | 7 ++++--- test-suite/tests/r6rs-arithmetic-bitwise.test | 2 +- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/module/rnrs/arithmetic/bitwise.scm b/module/rnrs/arithmetic/bitwise.scm index 5f66cf1c1..a8ed2bc69 100644 --- a/module/rnrs/arithmetic/bitwise.scm +++ b/module/rnrs/arithmetic/bitwise.scm @@ -1,6 +1,6 @@ ;;; bitwise.scm --- The R6RS bitwise arithmetic operations library -;; Copyright (C) 2010, 2013 Free Software Foundation, Inc. +;; Copyright (C) 2010, 2013, 2017 Free Software Foundation, Inc. ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -79,7 +79,7 @@ ;; However, other values have been tolerated by both Guile 2.0.x and ;; the sample implementation given the R6RS library document, so for ;; backward compatibility we continue to permit it. - (copy-bit ei2 ei1 (logbit? 0 ei3))) + (copy-bit ei2 ei1 (logbit? ei2 ei3))) (define (bitwise-copy-bit-field ei1 ei2 ei3 ei4) (copy-bit-field ei1 ei4 ei2 ei3)) diff --git a/module/rnrs/arithmetic/fixnums.scm b/module/rnrs/arithmetic/fixnums.scm index 4ec1cae0c..6daee0e39 100644 --- a/module/rnrs/arithmetic/fixnums.scm +++ b/module/rnrs/arithmetic/fixnums.scm @@ -1,6 +1,6 @@ ;;; fixnums.scm --- The R6RS fixnums arithmetic library -;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc. +;; Copyright (C) 2010, 2011, 2013, 2017 Free Software Foundation, Inc. ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -93,7 +93,8 @@ (rnrs arithmetic bitwise (6)) (rnrs conditions (6)) (rnrs exceptions (6)) - (rnrs lists (6))) + (rnrs lists (6)) + (only (srfi srfi-60) copy-bit)) (define fixnum-width (let ((w (do ((i 0 (+ 1 i)) @@ -244,7 +245,7 @@ (assert-fixnum fx1 fx2 fx3) (unless (and (<= 0 fx2) (< fx2 (fixnum-width))) (raise (make-assertion-violation))) - (bitwise-copy-bit fx1 fx2 fx3)) + (copy-bit fx2 fx1 (logbit? 0 fx3))) (define (fxbit-field fx1 fx2 fx3) (assert-fixnum fx1 fx2 fx3) diff --git a/test-suite/tests/r6rs-arithmetic-bitwise.test b/test-suite/tests/r6rs-arithmetic-bitwise.test index 3e23d81f0..0492efd31 100644 --- a/test-suite/tests/r6rs-arithmetic-bitwise.test +++ b/test-suite/tests/r6rs-arithmetic-bitwise.test @@ -62,7 +62,7 @@ (with-test-prefix "bitwise-copy-bit" (pass-if "bitwise-copy-bit simple" - (eqv? (bitwise-copy-bit #b010 2 1) #b110))) + (eqv? (bitwise-copy-bit #b010 2 4) #b110))) (with-test-prefix "bitwise-bit-field" (pass-if "bitwise-bit-field simple" -- 2.11.0